From 8807b9c9a13aa527cccbfc06439355e577ee49ff Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 6 Jul 2023 21:30:18 -0400 Subject: [PATCH 001/380] added Brown Oscar to the toolchair using mfc.sh load --- mfc.sh | 3 ++- toolchain/modules | 4 ++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/mfc.sh b/mfc.sh index 4a8d0bbc31..17578150a9 100755 --- a/mfc.sh +++ b/mfc.sh @@ -47,7 +47,8 @@ if [ "$1" == 'load' ]; then log "$C""ACCESS$W: Bridges2 (b) | Expanse (e) | Delta (d)" log "$Y""GaTech$W: Phoenix (p)" log "$R""CALTECH$W: Richardson (r)" - log_n "($G""a$W/$G""c$W/$G""s$W/$G""w$W/$C""b$W/$C""e$CR/$C""d$CR/$Y""p$CR/$R""r$CR): " + log "$R""BROWN$W: Oscar (o)" + log_n "($G""a$W/$G""c$W/$G""s$W/$G""w$W/$C""b$W/$C""e$CR/$C""d$CR/$Y""p$CR/$R""r$CR/$R""o$CR): " read u_c log fi diff --git a/toolchain/modules b/toolchain/modules index a4275d61a8..d45d3c7505 100644 --- a/toolchain/modules +++ b/toolchain/modules @@ -47,3 +47,7 @@ c-all ninja/1.10.2 cray-mpich/8.1.23 c-cpu c-gpu rocm/5.1.0 craype-accel-amd-gfx90a +o Brown +o-all python/3.9.0 cmake/3.20.0 +o-cpu gcc/10.2 mpi/openmpi_4.1.1_gcc_10.2_slurm22 hdf5/1.10.0 + From 55eb60c240e8bdb042374bfe672854759926c7cd Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 24 Oct 2023 20:12:38 -0400 Subject: [PATCH 002/380] Anvil specific mfc.sh --- mfc.sh | 4 ++-- submit_job.sh | 11 +++++++++++ toolchain/templates/slurm.sh | 4 ++-- 3 files changed, 15 insertions(+), 4 deletions(-) create mode 100755 submit_job.sh diff --git a/mfc.sh b/mfc.sh index cd1401abe5..23731c5116 100755 --- a/mfc.sh +++ b/mfc.sh @@ -464,7 +464,7 @@ fi # Activate the Python venv -source "$(pwd)/build/venv/bin/activate" +#source "$(pwd)/build/venv/bin/activate" ok "(venv) Entered the$MAGENTA Python$COLOR_RESET virtual environment." @@ -498,7 +498,7 @@ code=$? # Deactivate the Python virtualenv in case the user "source"'d this script log "(venv) Exiting the$MAGENTA Python$COLOR_RESET virtual environment." -deactivate +#deactivate # Exit proper exit code diff --git a/submit_job.sh b/submit_job.sh new file mode 100755 index 0000000000..f44caa3e75 --- /dev/null +++ b/submit_job.sh @@ -0,0 +1,11 @@ +#!/bin/bash + +#./mfc.sh run /anvil/projects/x-mch220010/undex/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t pre_process -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/rc/input.py -e batch -p wholenode -w 01:00:00 -# rc -N 2 -n 128 -t pre_process -b mpirun + +#./mfc.sh run /anvil/projects/x-mch220010/undex/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t simulation -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/rc/input.py -e batch -p wholenode -w 04:00:00 -# rc -N 2 -n 128 -t simulation -b mpirun + +./mfc.sh run /anvil/projects/x-mch220010/undex/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t post_process -b mpirun +./mfc.sh run /anvil/projects/x-mch220010/rc/input.py -e batch -p wholenode -w 04:00:00 -# rc -N 2 -n 128 -t post_process -b mpirun + diff --git a/toolchain/templates/slurm.sh b/toolchain/templates/slurm.sh index 11982cb408..f7fae22077 100644 --- a/toolchain/templates/slurm.sh +++ b/toolchain/templates/slurm.sh @@ -30,8 +30,8 @@ #SBATCH --nodes={nodes} #SBATCH --ntasks-per-node={tasks_per_node} #SBATCH --cpus-per-task=1 -#SBATCH --gpu-bind=verbose,closest -#SBATCH --gpus=v100-16:{(1 if gpu else 0)*tasks_per_node*nodes} +#>SBATCH --gpu-bind=verbose,closest +#>SBATCH --gpus=v100-16:{(1 if gpu else 0)*tasks_per_node*nodes} #SBATCH --time={walltime} #SBATCH --partition="{partition}" #SBATCH --output="{name}.out" From e1ea122ae5c03a05bad4d5246fc698f6b4cf7414 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 26 Oct 2023 15:42:21 -0400 Subject: [PATCH 003/380] preparing to compare the codes --- submit_job.sh | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/submit_job.sh b/submit_job.sh index f44caa3e75..ae25b3fb30 100755 --- a/submit_job.sh +++ b/submit_job.sh @@ -6,6 +6,13 @@ #./mfc.sh run /anvil/projects/x-mch220010/undex/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t simulation -b mpirun #./mfc.sh run /anvil/projects/x-mch220010/rc/input.py -e batch -p wholenode -w 04:00:00 -# rc -N 2 -n 128 -t simulation -b mpirun -./mfc.sh run /anvil/projects/x-mch220010/undex/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t post_process -b mpirun -./mfc.sh run /anvil/projects/x-mch220010/rc/input.py -e batch -p wholenode -w 04:00:00 -# rc -N 2 -n 128 -t post_process -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/undex/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t post_process -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/rc/input.py -e batch -p wholenode -w 04:00:00 -# rc -N 2 -n 128 -t post_process -b mpirun + +#./mfc.sh run /anvil/projects/x-mch220010/dfd2023/base/case_mfc.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t pre_process -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/dfd2023/base/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t simulation -b mpirun + +#./mfc.sh run ~/../../anvil/projects/x-mch220010/dfd2023/base_test/input.py -e batch -p wholenode -w 01:00:00 -# base -N 2 -n 128 -t pre_process -b mpirun + +./mfc.sh run ~/../../anvil/projects/x-mch220010/test/input_sawyer.py -e batch -p wholenode -w 01:00:00 -# base -N 2 -n 128 -t pre_process -b mpirun From b48993184016a0d08ba454fe0f39222ec69869e5 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 26 Oct 2023 17:48:28 -0400 Subject: [PATCH 004/380] submit file change --- submit_job.sh | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/submit_job.sh b/submit_job.sh index ae25b3fb30..26ef66192c 100755 --- a/submit_job.sh +++ b/submit_job.sh @@ -10,9 +10,7 @@ #./mfc.sh run /anvil/projects/x-mch220010/rc/input.py -e batch -p wholenode -w 04:00:00 -# rc -N 2 -n 128 -t post_process -b mpirun #./mfc.sh run /anvil/projects/x-mch220010/dfd2023/base/case_mfc.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t pre_process -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/dfd2023/base/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t simulation -b mpirun +./mfc.sh run /anvil/projects/x-mch220010/dfd2023/base/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t post_process -b mpirun -#./mfc.sh run ~/../../anvil/projects/x-mch220010/dfd2023/base_test/input.py -e batch -p wholenode -w 01:00:00 -# base -N 2 -n 128 -t pre_process -b mpirun -./mfc.sh run ~/../../anvil/projects/x-mch220010/test/input_sawyer.py -e batch -p wholenode -w 01:00:00 -# base -N 2 -n 128 -t pre_process -b mpirun From d1d74bf995ca136b27de66fcc68c5e87f51ccfdc Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 29 Oct 2023 09:56:16 -0400 Subject: [PATCH 005/380] fixed the mfc run engine issue on Anvil --- submit_job.sh | 11 ++--------- toolchain/mfc/run/engines.py | 4 ++-- 2 files changed, 4 insertions(+), 11 deletions(-) diff --git a/submit_job.sh b/submit_job.sh index 26ef66192c..d8689bded2 100755 --- a/submit_job.sh +++ b/submit_job.sh @@ -3,14 +3,7 @@ #./mfc.sh run /anvil/projects/x-mch220010/undex/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t pre_process -b mpirun #./mfc.sh run /anvil/projects/x-mch220010/rc/input.py -e batch -p wholenode -w 01:00:00 -# rc -N 2 -n 128 -t pre_process -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/undex/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t simulation -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/rc/input.py -e batch -p wholenode -w 04:00:00 -# rc -N 2 -n 128 -t simulation -b mpirun - -#./mfc.sh run /anvil/projects/x-mch220010/undex/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t post_process -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/rc/input.py -e batch -p wholenode -w 04:00:00 -# rc -N 2 -n 128 -t post_process -b mpirun - -#./mfc.sh run /anvil/projects/x-mch220010/dfd2023/base/case_mfc.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t pre_process -b mpirun -./mfc.sh run /anvil/projects/x-mch220010/dfd2023/base/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t post_process -b mpirun - +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/test/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t pre_process -b mpirun +./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/test/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t simulation -b mpirun diff --git a/toolchain/mfc/run/engines.py b/toolchain/mfc/run/engines.py index b8c45f772f..53f9f9ebe7 100644 --- a/toolchain/mfc/run/engines.py +++ b/toolchain/mfc/run/engines.py @@ -307,11 +307,11 @@ def __create_batch_file(self, system: queues.QueueSystem, targets: typing.List[M cons.print("> Writing batch file...") file_write(filepath, content) - def __execute_batch_file(self, system: queues.QueueSystem): + def __execute_batch_file(self, queue: queues.QueueSystem): # We CD to the case directory before executing the batch file so that # any files the queue system generates (like .err and .out) are created # in the correct directory. - cmd = system.gen_submit_cmd(self.__get_batch_filename()) + cmd = queue.gen_submit_cmd(self.__get_batch_filename()) if system(cmd, cwd=self.__get_batch_dirpath()) != 0: raise MFCException(f"Submitting batch file for {system.name} failed. It can be found here: {self.__get_batch_filepath()}. Please check the file for errors.") From ef89a312c9f6620cc6459d6aaa3dfec3bc5917ce Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 3 Nov 2023 01:18:05 -0400 Subject: [PATCH 006/380] updated submit job script --- submit_job.sh | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/submit_job.sh b/submit_job.sh index d8689bded2..65f576c034 100755 --- a/submit_job.sh +++ b/submit_job.sh @@ -3,7 +3,8 @@ #./mfc.sh run /anvil/projects/x-mch220010/undex/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t pre_process -b mpirun #./mfc.sh run /anvil/projects/x-mch220010/rc/input.py -e batch -p wholenode -w 01:00:00 -# rc -N 2 -n 128 -t pre_process -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/test/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t pre_process -b mpirun -./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/test/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t simulation -b mpirun +./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/test/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t pre_process -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/test/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t simulation -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/test/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t post_process -b mpirun From 43f45ea4b4a032f1cefadb63df610d93b5098433 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 12 Nov 2023 09:57:27 -0500 Subject: [PATCH 007/380] added center of mass calculation for all of the fluids --- src/simulation/m_data_output.fpp | 202 +++++++++++++++++++------ src/simulation/m_derived_variables.f90 | 160 +++++++++++++++++++- submit3D.sh | 12 ++ submit_job.sh | 4 +- 4 files changed, 329 insertions(+), 49 deletions(-) create mode 100755 submit3D.sh diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 6229daacf9..7194a2ad35 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -32,13 +32,16 @@ module m_data_output private; public :: s_initialize_data_output_module, & s_open_run_time_information_file, & + s_open_com_files, & s_open_probe_files, & s_write_run_time_information, & s_write_data_files, & s_write_serial_data_files, & s_write_parallel_data_files, & + s_write_com_files, & s_write_probe_files, & s_close_run_time_information_file, & + s_close_com_files, & s_close_probe_files, & s_finalize_data_output_module @@ -53,13 +56,13 @@ module m_data_output type(scalar_field), & dimension(sys_size), & - intent(IN) :: q_cons_vf + intent(in) :: q_cons_vf type(scalar_field), & dimension(sys_size), & - intent(INOUT) :: q_prim_vf + intent(inOUT) :: q_prim_vf - integer, intent(IN) :: t_step + integer, intent(in) :: t_step end subroutine s_write_abstract_data_files ! ------------------- end interface ! ======================================================== @@ -155,6 +158,44 @@ contains end if end subroutine s_open_run_time_information_file ! ---------------------- + + !> This opens a formatted data file where the root processor + !! can write out the CoM information + subroutine s_open_com_files() ! ---------------------------------------- + character(len = path_len + 3*name_len) :: file_path !< + !! Relative path to the CoM file in the case directory + integer :: i !< Generic loop iterator + do i = 1, num_fluids + ! Generating the relative path to the CoM data file + write(file_path,'(A,I0,A)') '/fluid',i,'_com.dat' + file_path = trim(case_dir) // trim(file_path) + ! Creating the formatted data file and setting up its + ! structure + open(i+10, file = trim(file_path), & + form = 'formatted', & + position = 'append', & + status = 'unknown') + if (n == 0) then + write(i+10,'(A)') '=== Non-Dimensional Time ' // & + '=== Total Mass ' // & + '=== x-loc ' // & + '=== Total Volume ===' + elseif (p == 0) then + write(i+10,'(A)') '=== Non-Dimensional Time ' // & + '=== Total Mass ' // & + '=== x-loc ' // & + '=== y-loc ' // & + '=== Total Volume ===' + else + write(i+10,'(A)') '=== Non-Dimensional Time ' // & + '=== Total Mass ' // & + '=== x-loc ' // & + '=== y-loc ' // & + '=== z-loc ' // & + '=== Total Volume ===' + end if + end do + end subroutine s_open_com_files ! -------------------------------------- !> This opens a formatted data file where the root processor !! can write out flow probe information @@ -176,12 +217,12 @@ contains FORM='formatted', & STATUS='unknown') ! POSITION = 'append', & - !WRITE(i+30,'(A,I0,A)') 'Probe ',i, ' located at:' - !WRITE(i+30,'(A,F10.6)') 'x = ',probe(i)%x - !WRITE(i+30,'(A,F10.6)') 'y = ',probe(i)%y - !WRITE(i+30,'(A,F10.6)') 'z = ',probe(i)%z - !WRITE(i+30, *) - !WRITE(i+30,'(A)') '=== Non-Dimensional Time ' // & + !write(i+30,'(A,I0,A)') 'Probe ',i, ' located at:' + !write(i+30,'(A,F10.6)') 'x = ',probe(i)%x + !write(i+30,'(A,F10.6)') 'y = ',probe(i)%y + !write(i+30,'(A,F10.6)') 'z = ',probe(i)%z + !write(i+30, *) + !write(i+30,'(A)') '=== Non-Dimensional Time ' // & ! '=== Density ' // & ! '=== Velocity ' // & ! '=== Pressure ' // & @@ -214,8 +255,8 @@ contains !! @param t_step Current time step subroutine s_write_run_time_information(q_prim_vf, t_step) ! ----------- - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - integer, intent(IN) :: t_step + type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + integer, intent(in) :: t_step real(kind(0d0)), dimension(num_fluids) :: alpha_rho !< Cell-avg. partial density real(kind(0d0)) :: rho !< Cell-avg. density @@ -355,7 +396,7 @@ contains end do end do end do - ! END: Computing Stability Criteria at Current Time-step =========== + ! end: Computing Stability Criteria at Current Time-step =========== ! Determining local stability criteria extrema at current time-step @@ -433,10 +474,10 @@ contains !! @param t_step Current time-step subroutine s_write_serial_data_files(q_cons_vf, q_prim_vf, t_step) ! --------------------- - type(scalar_field), dimension(sys_size), intent(IN) :: q_cons_vf - type(scalar_field), dimension(sys_size), intent(INOUT) :: q_prim_vf + type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf + type(scalar_field), dimension(sys_size), intent(inOUT) :: q_prim_vf - integer, intent(IN) :: t_step + integer, intent(in) :: t_step character(LEN=path_len + 2*name_len) :: t_step_dir !< !! Relative path to the current time-step directory @@ -794,23 +835,23 @@ contains type(scalar_field), & dimension(sys_size), & - intent(IN) :: q_cons_vf + intent(in) :: q_cons_vf type(scalar_field), & dimension(sys_size), & - intent(INOUT) :: q_prim_vf + intent(inOUT) :: q_prim_vf - integer, intent(IN) :: t_step + integer, intent(in) :: t_step #ifdef MFC_MPI integer :: ifile, ierr, data_size integer, dimension(MPI_STATUS_SIZE) :: status - integer(KIND=MPI_OFFSET_KIND) :: disp - integer(KIND=MPI_OFFSET_KIND) :: m_MOK, n_MOK, p_MOK - integer(KIND=MPI_OFFSET_KIND) :: WP_MOK, var_MOK, str_MOK - integer(KIND=MPI_OFFSET_KIND) :: NVARS_MOK - integer(KIND=MPI_OFFSET_KIND) :: MOK + integer(kind=MPI_OFFSET_kind) :: disp + integer(kind=MPI_OFFSET_kind) :: m_MOK, n_MOK, p_MOK + integer(kind=MPI_OFFSET_kind) :: WP_MOK, var_MOK, str_MOK + integer(kind=MPI_OFFSET_kind) :: NVARS_MOK + integer(kind=MPI_OFFSET_kind) :: MOK character(LEN=path_len + 2*name_len) :: file_loc logical :: file_exist @@ -835,52 +876,52 @@ contains data_size = (m + 1)*(n + 1)*(p + 1) ! Resize some integers so MPI can write even the biggest files - m_MOK = int(m_glb + 1, MPI_OFFSET_KIND) - n_MOK = int(n_glb + 1, MPI_OFFSET_KIND) - p_MOK = int(p_glb + 1, MPI_OFFSET_KIND) - WP_MOK = int(8d0, MPI_OFFSET_KIND) - MOK = int(1d0, MPI_OFFSET_KIND) - str_MOK = int(name_len, MPI_OFFSET_KIND) - NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) + m_MOK = int(m_glb + 1, MPI_OFFSET_kind) + n_MOK = int(n_glb + 1, MPI_OFFSET_kind) + p_MOK = int(p_glb + 1, MPI_OFFSET_kind) + WP_MOK = int(8d0, MPI_OFFSET_kind) + MOK = int(1d0, MPI_OFFSET_kind) + str_MOK = int(name_len, MPI_OFFSET_kind) + NVARS_MOK = int(sys_size, MPI_OFFSET_kind) if (bubbles) then ! Write the data for each variable do i = 1, sys_size - var_MOK = int(i, MPI_OFFSET_KIND) + var_MOK = int(i, MPI_OFFSET_kind) ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, MPI_doUBLE_PRECISION, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + call MPI_FILE_write_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & + MPI_doUBLE_PRECISION, status, ierr) end do !Write pb and mv for non-polytropic qbmm if(qbmm .and. .not. polytropic) then do i = sys_size + 1, sys_size + 2*nb*nnode - var_MOK = int(i, MPI_OFFSET_KIND) + var_MOK = int(i, MPI_OFFSET_kind) ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, MPI_doUBLE_PRECISION, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + call MPI_FILE_write_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & + MPI_doUBLE_PRECISION, status, ierr) end do end if else - do i = 1, sys_size !TODO: check if correct (sys_size - var_MOK = int(i, MPI_OFFSET_KIND) + do i = 1, sys_size !TOdo: check if correct (sys_size + var_MOK = int(i, MPI_OFFSET_kind) ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, MPI_doUBLE_PRECISION, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + call MPI_FILE_write_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & + MPI_doUBLE_PRECISION, status, ierr) end do end if @@ -890,6 +931,64 @@ contains end subroutine s_write_parallel_data_files ! --------------------------- + !> This writes a formatted data file where the root processor + !! can write out the CoM information + !! @param t_step Current time-step + !! @param q_com Center of mass information + !! @param moments Higher moment information + subroutine s_write_com_files(t_step,q_com) ! ------------------- + + integer, intent(in) :: t_step + real(kind(0d0)), dimension(num_fluids,11), intent(in) :: q_com + + integer :: i !< Generic loop iterator + real(kind(0d0)) :: nondim_time !< Non-dimensional time + + ! Non-dimensional time calculation + if (t_step_old /= dflt_int) then + nondim_time = real(t_step + t_step_old,kind(0d0))*dt + else + nondim_time = real(t_step,kind(0d0))*dt + end if + + if (n == 0) then ! 1D simulation + do i = 1, num_fluids ! Loop through fluids + if (proc_rank == 0) then + write(i+10, '(6X,F12.6,F24.8,F24.8,F24.8)') & + nondim_time, & + q_com(i,1), & + q_com(i,2), & + q_com(i,5) + end if + end do + elseif (p == 0) then ! 2D simulation + do i = 1, num_fluids ! Loop through fluids + if (proc_rank == 0) then + write(i+10, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8)') & + nondim_time, & + q_com(i,1), & + q_com(i,2), & + q_com(i,3), & + q_com(i,5) + end if + end do + else ! 3D simulation + do i = 1, num_fluids ! Loop through fluids + if (proc_rank == 0) then + write(i+10, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,F24.8)') & + nondim_time, & + q_com(i,1), & + q_com(i,2), & + q_com(i,3), & + q_com(i,4), & + q_com(i,5) + end if + end do + end if + + end subroutine s_write_com_files ! ------------------------------------- + + !> This writes a formatted data file for the flow probe information !! @param t_step Current time-step @@ -897,9 +996,9 @@ contains !! @param accel_mag Acceleration magnitude information subroutine s_write_probe_files(t_step, q_cons_vf, accel_mag) ! ----------- - integer, intent(IN) :: t_step - type(scalar_field), dimension(sys_size), intent(IN) :: q_cons_vf - real(kind(0d0)), dimension(0:m, 0:n, 0:p), intent(IN) :: accel_mag + integer, intent(in) :: t_step + type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf + real(kind(0d0)), dimension(0:m, 0:n, 0:p), intent(in) :: accel_mag real(kind(0d0)), dimension(-1:m) :: distx real(kind(0d0)), dimension(-1:n) :: disty @@ -1516,6 +1615,17 @@ contains end subroutine s_close_run_time_information_file ! --------------------- + !> Closes communication files + subroutine s_close_com_files() ! --------------------------------------- + + integer :: i !< Generic loop iterator + + do i = 1, num_fluids + close(i+10) + end do + + end subroutine s_close_com_files ! ------------------------------------- + !> Closes probe files subroutine s_close_probe_files() ! ------------------------------------- diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index 8e02c49f11..5d71a5adbd 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -43,6 +43,7 @@ module m_derived_variables ! @name Variables for computing acceleration !> @{ + real(KIND(0d0)), public, allocatable, dimension(:,:) :: q_com real(kind(0d0)), public, allocatable, dimension(:, :, :) :: accel_mag real(kind(0d0)), public, allocatable, dimension(:, :, :) :: x_accel, y_accel, z_accel !> @} @@ -61,6 +62,9 @@ subroutine s_initialize_derived_variables_module() ! ---------------------- ! these coefficients will have to be implemented in the subroutine ! s_compute_finite_difference_coefficients. + call s_open_com_files() + allocate(q_com(num_fluids,5)) + ! Allocating centered finite-difference coefficients if (probe_wrt) then allocate (fd_coeff_x(-fd_number:fd_number, 0:m)) @@ -80,7 +84,7 @@ subroutine s_initialize_derived_variables_module() ! ---------------------- end if end if end if - + end subroutine s_initialize_derived_variables_module ! -------------------- !> Allocate and open derived variables. Computing FD coefficients. @@ -117,6 +121,9 @@ subroutine s_compute_derived_variables(t_step) ! ----------------------- integer, intent(IN) :: t_step integer :: i, j, k !< Generic loop iterators + + call s_derive_center_of_mass(q_prim_ts(0)%vf, q_com) + call s_write_com_files(t_step, q_com) if (probe_wrt) then call s_derive_acceleration_component(1, q_prim_ts(0)%vf, & @@ -316,10 +323,161 @@ subroutine s_derive_acceleration_component(i, q_prim_vf0, q_prim_vf1, & end subroutine s_derive_acceleration_component ! -------------------------- + !> This subroutine is used together with the volume fraction + !! model and when called upon, it computes the location of + !! of the center of mass for each fluid from the inputted + !! primitive variables, q_prim_vf. The computed location + !! is then written to a formatted data file by the root process. + !! @param q_prim_vf Primitive variables + !! @param q_com Mass,x-location,y-location,z-location,x-velocity,y-velocity,z-velocity, + !! x-acceleration, y-acceleration, z-acceleration, weighted + subroutine s_derive_center_of_mass(q_prim_vf,q_com) + + type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + real(kind(0d0)), dimension(num_fluids,5), intent(inout) :: q_com + + real(kind(0d0)) :: xbeg,xend,ybeg,yend,zbeg,zend !< + !! Maximum and minimum values of cell boundaries in each direction used in check for + !! reflective BC in computation of center of mass + + integer :: i,j,k,l !< Generic loop iterators + real(kind(0d0)) :: tmp !< Temporary variable to store quantity for mpi_allreduce + real(kind(0d0)) :: dV !< Discrete cell volume + + if (n == 0) then !1D simulation + do i = 1,num_fluids !Loop over individual fluids + q_com(i,:) = 0d0 + do l = 0, p !Loop over grid + do k = 0, n + do j = 0, m + dV = dx(j) + ! Mass + q_com(i,1) = q_com(i,1) + q_prim_vf(i)%sf(j,k,l)*dV + ! x-location weighted + q_com(i,2) = q_com(i,2) + q_prim_vf(i)%sf(j,k,l)*dV*x_cc(j) + ! Volume fraction + q_com(i,5) = q_com(i,5) + q_prim_vf(i+adv_idx%beg-1)%sf(j,k,l)*dV + end do + end do + end do + ! Sum all components across all processors using MPI_ALLREDUCE + if (num_procs > 1) then + tmp = q_com(i,1) + call s_mpi_allreduce_sum(tmp,q_com(i,1)) + tmp = q_com(i,2) + call s_mpi_allreduce_sum(tmp,q_com(i,2)) + tmp = q_com(i,5) + call s_mpi_allreduce_sum(tmp,q_com(i,5)) + end if + ! Compute quotients + q_com(i,2) = q_com(i,2)/q_com(i,1) + end do + elseif (p == 0) then !2D simulation + do i = 1,num_fluids !Loop over individual fluids + q_com(i,:) = 0d0 + do l = 0, p !Loop over grid + do k = 0, n + do j = 0, m + dV = dx(j)*dy(k) + ! Mass + q_com(i,1) = q_com(i,1) + q_prim_vf(i)%sf(j,k,l)*dV + ! x-location weighted + q_com(i,2) = q_com(i,2) + q_prim_vf(i)%sf(j,k,l)*dV*x_cc(j) + ! y-location weighted + q_com(i,3) = q_com(i,3) + q_prim_vf(i)%sf(j,k,l)*dV*y_cc(k) + ! Volume fraction + q_com(i,5) = q_com(i,5) + q_prim_vf(i+adv_idx%beg-1)%sf(j,k,l)*dV + end do + end do + end do + ! Sum all components across all processors using MPI_ALLREDUCE + if (num_procs > 1) then + tmp = q_com(i,1) + call s_mpi_allreduce_sum(tmp,q_com(i,1)) + tmp = q_com(i,2) + call s_mpi_allreduce_sum(tmp,q_com(i,2)) + tmp = q_com(i,3) + call s_mpi_allreduce_sum(tmp,q_com(i,3)) + tmp = q_com(i,5) + call s_mpi_allreduce_sum(tmp,q_com(i,5)) + end if + ! Compute quotients + q_com(i,2) = q_com(i,2)/q_com(i,1) + q_com(i,3) = q_com(i,3)/q_com(i,1) + end do + else !3D simulation + do i = 1,num_fluids !Loop over individual fluids + q_com(i,:) = 0d0 + do l = 0, p !Loop over grid + do k = 0, n + do j = 0, m + dV = dx(j)*dy(k)*dz(l) + ! Mass + q_com(i,1) = q_com(i,1) + q_prim_vf(i)%sf(j,k,l)*dV + ! x-location weighted + q_com(i,2) = q_com(i,2) + q_prim_vf(i)%sf(j,k,l)*dV*x_cc(j) + ! y-location weighted + q_com(i,3) = q_com(i,3) + q_prim_vf(i)%sf(j,k,l)*dV*y_cc(k) + ! z-location weighted + q_com(i,4) = q_com(i,4) + q_prim_vf(i)%sf(j,k,l)*dV*z_cc(l) + ! Volume fraction + q_com(i,5) = q_com(i,5) + q_prim_vf(i+adv_idx%beg-1)%sf(j,k,l)*dV + end do + end do + end do + ! Sum all components across all processors using MPI_ALLREDUCE + if (num_procs > 1) then + tmp = q_com(i,1) + call s_mpi_allreduce_sum(tmp,q_com(i,1)) + tmp = q_com(i,2) + call s_mpi_allreduce_sum(tmp,q_com(i,2)) + tmp = q_com(i,3) + call s_mpi_allreduce_sum(tmp,q_com(i,3)) + tmp = q_com(i,4) + call s_mpi_allreduce_sum(tmp,q_com(i,4)) + tmp = q_com(i,5) + call s_mpi_allreduce_sum(tmp,q_com(i,5)) + end if + ! Compute quotients + q_com(i,2) = q_com(i,2)/q_com(i,1) + q_com(i,3) = q_com(i,3)/q_com(i,1) + q_com(i,4) = q_com(i,4)/q_com(i,1) + q_com(i,5) = q_com(i,5) + end do + end if + ! Find computational domain boundaries + if (num_procs > 1) then + call s_mpi_allreduce_min(minval(x_cb(-1:m)),xbeg) + call s_mpi_allreduce_max(maxval(x_cb(-1:m)),xend) + if (n > 0) then + call s_mpi_allreduce_min(minval(y_cb(-1:n)),ybeg) + call s_mpi_allreduce_max(maxval(y_cb(-1:n)),yend) + if (p > 0) then + call s_mpi_allreduce_min(minval(z_cb(-1:p)),zbeg) + call s_mpi_allreduce_max(maxval(z_cb(-1:p)),zend) + end if + end if + else + xbeg = minval(x_cb(-1:m)) + xend = maxval(x_cb(-1:m)) + if (n > 0) then + ybeg = minval(y_cb(-1:n)) + yend = maxval(y_cb(-1:n)) + if (p > 0) then + zbeg = minval(z_cb(-1:p)) + zend = maxval(z_cb(-1:p)) + end if + end if + end if + + end subroutine s_derive_center_of_mass ! ---------------------------------- !> Deallocation procedures for the module subroutine s_finalize_derived_variables_module() ! ------------------- + call s_close_com_files() + deallocate(q_com) + ! Closing CoM and flow probe files if (proc_rank == 0) then if (probe_wrt) then diff --git a/submit3D.sh b/submit3D.sh new file mode 100755 index 0000000000..1757450269 --- /dev/null +++ b/submit3D.sh @@ -0,0 +1,12 @@ +#!/bin/bash + + +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/3Gbl_base/input.py -e batch -p wholenode -w 01:00:00 -# 3Dmfc -N 6 -n 128 -t pre_process -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/3Gbl_base/input.py -e batch -p wholenode -w 06:00:00 -# 3Dmfc -N 6 -n 128 -t simulation -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/3Gbl_base/input.py -e batch -p wholenode -w 00:30:00 -# 3Dmfc -N 6 -n 128 -t post_process -b mpirun + +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/3Gbg_base/input.py -e batch -p wholenode -w 01:00:00 -# 3Dmfc -N 6 -n 128 -t pre_process -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/3Gbg_base/input.py -e batch -p wholenode -w 06:00:00 -# 3Dmfc -N 6 -n 128 -t simulation -b mpirun +./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/3Gbg_base/input.py -e batch -p wholenode -w 00:30:00 -# 3Dmfc -N 6 -n 128 -t post_process -b mpirun + + diff --git a/submit_job.sh b/submit_job.sh index 65f576c034..6582294ab4 100755 --- a/submit_job.sh +++ b/submit_job.sh @@ -4,7 +4,7 @@ #./mfc.sh run /anvil/projects/x-mch220010/rc/input.py -e batch -p wholenode -w 01:00:00 -# rc -N 2 -n 128 -t pre_process -b mpirun -./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/test/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t pre_process -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/test/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t pre_process -b mpirun #./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/test/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t simulation -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/test/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t post_process -b mpirun +./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/test/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t post_process -b mpirun From afd5fad48951212a69a015e43e5983d42aa01863 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 16 Nov 2023 22:38:16 -0500 Subject: [PATCH 008/380] APS DFD 2023 code --- src/simulation/m_data_output.fpp | 192 ++++++++++--------- src/simulation/m_derived_variables.f90 | 245 +++++++++++-------------- src/simulation/m_qbmm.fpp | 8 +- src/simulation/m_start_up.fpp | 1 - submit3D.sh | 12 -- submit_job.sh | 10 - submitjob.sh | 22 +++ 7 files changed, 230 insertions(+), 260 deletions(-) delete mode 100755 submit3D.sh delete mode 100755 submit_job.sh create mode 100755 submitjob.sh diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 7194a2ad35..03d122af16 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -31,19 +31,19 @@ module m_data_output implicit none private; public :: s_initialize_data_output_module, & - s_open_run_time_information_file, & - s_open_com_files, & - s_open_probe_files, & - s_write_run_time_information, & - s_write_data_files, & - s_write_serial_data_files, & - s_write_parallel_data_files, & - s_write_com_files, & - s_write_probe_files, & - s_close_run_time_information_file, & - s_close_com_files, & - s_close_probe_files, & - s_finalize_data_output_module + s_open_run_time_information_file, & + s_open_com_files, & + s_open_probe_files, & + s_write_run_time_information, & + s_write_data_files, & + s_write_serial_data_files, & + s_write_parallel_data_files, & + s_write_com_files, & + s_write_probe_files, & + s_close_run_time_information_file, & + s_close_com_files, & + s_close_probe_files, & + s_finalize_data_output_module abstract interface ! =================================================== @@ -65,12 +65,14 @@ module m_data_output integer, intent(in) :: t_step end subroutine s_write_abstract_data_files ! ------------------- + end interface ! ======================================================== real(kind(0d0)), allocatable, dimension(:, :, :) :: icfl_sf !< ICFL stability criterion real(kind(0d0)), allocatable, dimension(:, :, :) :: vcfl_sf !< VCFL stability criterion real(kind(0d0)), allocatable, dimension(:, :, :) :: ccfl_sf !< CCFL stability criterion real(kind(0d0)), allocatable, dimension(:, :, :) :: Rc_sf !< Rc stability criterion + real(kind(0d0)), public, allocatable, dimension(:, :) :: c_mass !$acc declare create(icfl_sf, vcfl_sf, ccfl_sf, Rc_sf) @@ -171,23 +173,23 @@ contains file_path = trim(case_dir) // trim(file_path) ! Creating the formatted data file and setting up its ! structure - open(i+10, file = trim(file_path), & + open(i+120, file = trim(file_path), & form = 'formatted', & position = 'append', & status = 'unknown') if (n == 0) then - write(i+10,'(A)') '=== Non-Dimensional Time ' // & + write(i+120,'(A)') '=== Non-Dimensional Time ' // & '=== Total Mass ' // & '=== x-loc ' // & '=== Total Volume ===' elseif (p == 0) then - write(i+10,'(A)') '=== Non-Dimensional Time ' // & + write(i+120,'(A)') '=== Non-Dimensional Time ' // & '=== Total Mass ' // & '=== x-loc ' // & '=== y-loc ' // & '=== Total Volume ===' else - write(i+10,'(A)') '=== Non-Dimensional Time ' // & + write(i+120,'(A)') '=== Non-Dimensional Time ' // & '=== Total Mass ' // & '=== x-loc ' // & '=== y-loc ' // & @@ -469,9 +471,9 @@ contains end subroutine s_write_run_time_information ! -------------------------- !> The goal of this subroutine is to output the grid and - !! conservative variables data files for given time-step. - !! @param q_cons_vf Cell-average conservative variables - !! @param t_step Current time-step + !! conservative variables data files for given time-step. + !! @param q_cons_vf Cell-average conservative variables + !! @param t_step Current time-step subroutine s_write_serial_data_files(q_cons_vf, q_prim_vf, t_step) ! --------------------- type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf @@ -892,10 +894,10 @@ contains ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_doUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) call MPI_FILE_write_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_doUBLE_PRECISION, status, ierr) + MPI_DOUBLE_PRECISION, status, ierr) end do !Write pb and mv for non-polytropic qbmm if(qbmm .and. .not. polytropic) then @@ -905,10 +907,10 @@ contains ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_doUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) call MPI_FILE_write_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_doUBLE_PRECISION, status, ierr) + MPI_DOUBLE_PRECISION, status, ierr) end do end if else @@ -918,10 +920,10 @@ contains ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_doUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) call MPI_FILE_write_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_doUBLE_PRECISION, status, ierr) + MPI_DOUBLE_PRECISION, status, ierr) end do end if @@ -931,64 +933,56 @@ contains end subroutine s_write_parallel_data_files ! --------------------------- - !> This writes a formatted data file where the root processor - !! can write out the CoM information - !! @param t_step Current time-step - !! @param q_com Center of mass information - !! @param moments Higher moment information - subroutine s_write_com_files(t_step,q_com) ! ------------------- - - integer, intent(in) :: t_step - real(kind(0d0)), dimension(num_fluids,11), intent(in) :: q_com - - integer :: i !< Generic loop iterator - real(kind(0d0)) :: nondim_time !< Non-dimensional time - - ! Non-dimensional time calculation - if (t_step_old /= dflt_int) then - nondim_time = real(t_step + t_step_old,kind(0d0))*dt - else - nondim_time = real(t_step,kind(0d0))*dt - end if - + !> This writes a formatted data file where the root processor + !! can write out the CoM information + !! @param t_step Current time-step + !! @param q_com Center of mass information + !! @param moments Higher moment information + subroutine s_write_com_files(t_step,c_mass) ! ------------------- + + integer, intent(in) :: t_step + real(kind(0d0)), dimension(num_fluids,5), intent(in) :: c_mass + integer :: i,j !< Generic loop iterator + real(kind(0d0)) :: nondim_time !< Non-dimensional time + + ! Non-dimensional time calculation + if (t_step_old /= dflt_int) then + nondim_time = real(t_step + t_step_old,kind(0d0))*dt + else + nondim_time = real(t_step,kind(0d0))*dt + end if + + if (proc_rank == 0) then if (n == 0) then ! 1D simulation - do i = 1, num_fluids ! Loop through fluids - if (proc_rank == 0) then - write(i+10, '(6X,F12.6,F24.8,F24.8,F24.8)') & - nondim_time, & - q_com(i,1), & - q_com(i,2), & - q_com(i,5) - end if - end do + do i = 1, num_fluids ! Loop through fluids + write(i+120, '(6X,4F24.12)') & + nondim_time, & + c_mass(i,1), & + c_mass(i,2), & + c_mass(i,5) + end do elseif (p == 0) then ! 2D simulation - do i = 1, num_fluids ! Loop through fluids - if (proc_rank == 0) then - write(i+10, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8)') & - nondim_time, & - q_com(i,1), & - q_com(i,2), & - q_com(i,3), & - q_com(i,5) - end if - end do + do i = 1, num_fluids ! Loop through fluids + write(i+120, '(6X,5F24.12)') & + nondim_time, & + c_mass(i,1), & + c_mass(i,2), & + c_mass(i,3), & + c_mass(i,5) + end do else ! 3D simulation - do i = 1, num_fluids ! Loop through fluids - if (proc_rank == 0) then - write(i+10, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,F24.8)') & - nondim_time, & - q_com(i,1), & - q_com(i,2), & - q_com(i,3), & - q_com(i,4), & - q_com(i,5) - end if - end do + do i = 1, num_fluids ! Loop through fluids + write(i+120, '(6X,6F24.12)') & + nondim_time, & + c_mass(i,1), & + c_mass(i,2), & + c_mass(i,3), & + c_mass(i,4), & + c_mass(i,5) + end do end if - - end subroutine s_write_com_files ! ------------------------------------- - - + end if + end subroutine s_write_com_files ! ------------------------------------- !> This writes a formatted data file for the flow probe information !! @param t_step Current time-step @@ -1332,7 +1326,7 @@ contains if (n == 0) then if (bubbles .and. (num_fluids <= 2)) then if (qbmm) then - write (i + 30, '(6x,f12.6,14f28.16)') & + write (i + 30, '(6x,f12.12,14f28.16)') & nondim_time, & rho, & vel(1), & @@ -1349,7 +1343,7 @@ contains M20, & M02 else - write (i + 30, '(6x,f12.6,8f24.8)') & + write (i + 30, '(6x,f12.12,8f24.8)') & nondim_time, & rho, & vel(1), & @@ -1363,7 +1357,7 @@ contains ! ptot end if else if (bubbles .and. (num_fluids == 3)) then - write (i + 30, '(6x,f12.6,f24.8,f24.8,f24.8,f24.8,f24.8,'// & + write (i + 30, '(6x,f12.12,f24.8,f24.8,f24.8,f24.8,f24.8,'// & 'f24.8,f24.8,f24.8,f24.8,f24.8, f24.8)') & nondim_time, & rho, & @@ -1378,7 +1372,7 @@ contains ptilde, & ptot else if (bubbles .and. num_fluids == 4) then - write (i + 30, '(6x,f12.6,f24.8,f24.8,f24.8,f24.8,'// & + write (i + 30, '(6x,f12.12,f24.8,f24.8,f24.8,f24.8,'// & 'f24.8,f24.8,f24.8,f24.8,f24.8,f24.8,f24.8,f24.8,f24.8)') & nondim_time, & q_cons_vf(1)%sf(j - 2, 0, 0), & @@ -1395,7 +1389,7 @@ contains R(1), & Rdot(1) else - write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8)') & + write (i + 30, '(6X,F12.12,F24.8,F24.8,F24.8)') & nondim_time, & rho, & vel(1), & @@ -1415,7 +1409,7 @@ contains R(1), & Rdot(1) else if (hypoelasticity) then - write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,'// & + write (i + 30, '(6X,F12.12,F24.8,F24.8,F24.8,F24.8,'// & 'F24.8,F24.8,F24.8)') & nondim_time, & rho, & @@ -1426,14 +1420,14 @@ contains tau_e(2), & tau_e(3) else - write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8)') & + write (i + 30, '(6X,F12.12,F24.8,F24.8,F24.8)') & nondim_time, & rho, & vel(1), & pres end if else - write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,'// & + write (i + 30, '(6X,F12.12,F24.8,F24.8,F24.8,F24.8,'// & 'F24.8,F24.8,F24.8,F24.8,'// & 'F24.8)') & nondim_time, & @@ -1493,7 +1487,7 @@ contains if (proc_rank == 0) then if (bubbles .and. (num_fluids <= 2)) then - write (i + 70, '(6x,f12.6,f24.8)') & + write (i + 70, '(6x,f12.12,f24.8)') & nondim_time, int_pres end if end if @@ -1575,7 +1569,7 @@ contains if (proc_rank == 0) then if (bubbles .and. (num_fluids <= 2)) then - write (i + 70, '(6x,f12.6,f24.8,f24.8)') & + write (i + 70, '(6x,f12.12,f24.8,f24.8)') & nondim_time, int_pres, max_pres end if end if @@ -1615,16 +1609,15 @@ contains end subroutine s_close_run_time_information_file ! --------------------- - !> Closes communication files - subroutine s_close_com_files() ! --------------------------------------- - - integer :: i !< Generic loop iterator + !> Closes communication files + subroutine s_close_com_files() ! --------------------------------------- - do i = 1, num_fluids - close(i+10) - end do + integer :: i !< Generic loop iterator + do i = 1, num_fluids + close(i+120) + end do - end subroutine s_close_com_files ! ------------------------------------- + end subroutine s_close_com_files ! ------------------------------------- !> Closes probe files subroutine s_close_probe_files() ! ------------------------------------- @@ -1646,6 +1639,7 @@ contains integer :: i !< Generic loop iterator + allocate(c_mass(1:num_fluids,1:5)) ! Allocating/initializing ICFL, VCFL, CCFL and Rc stability criteria @:ALLOCATE(icfl_sf(0:m, 0:n, 0:p)) @@ -1685,6 +1679,8 @@ contains subroutine s_finalize_data_output_module() ! --------------------------- integer :: i !< Generic loop iterator + + deallocate(c_mass) ! Deallocating the ICFL, VCFL, CCFL, and Rc stability criteria @:DEALLOCATE(icfl_sf) diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index 5d71a5adbd..e53d11f49c 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -20,15 +20,17 @@ module m_derived_variables use m_time_steppers !< Time-stepping algorithms + use m_compile_specific + use m_helper ! ========================================================================== implicit none private; public :: s_initialize_derived_variables_module, & - s_initialize_derived_variables, & - s_compute_derived_variables, & - s_finalize_derived_variables_module + s_initialize_derived_variables, & + s_compute_derived_variables, & + s_finalize_derived_variables_module !> @name Finite-difference coefficients !! Finite-difference (fd) coefficients in x-, y- and z-coordinate directions. @@ -43,7 +45,6 @@ module m_derived_variables ! @name Variables for computing acceleration !> @{ - real(KIND(0d0)), public, allocatable, dimension(:,:) :: q_com real(kind(0d0)), public, allocatable, dimension(:, :, :) :: accel_mag real(kind(0d0)), public, allocatable, dimension(:, :, :) :: x_accel, y_accel, z_accel !> @} @@ -62,9 +63,6 @@ subroutine s_initialize_derived_variables_module() ! ---------------------- ! these coefficients will have to be implemented in the subroutine ! s_compute_finite_difference_coefficients. - call s_open_com_files() - allocate(q_com(num_fluids,5)) - ! Allocating centered finite-difference coefficients if (probe_wrt) then allocate (fd_coeff_x(-fd_number:fd_number, 0:m)) @@ -94,22 +92,20 @@ subroutine s_initialize_derived_variables() ! ----------------------------- ! Opening and writing header of flow probe files if (proc_rank == 0) then call s_open_probe_files() + call s_open_com_files() end if ! Computing centered finite difference coefficients call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & fd_number, fd_order) - if (n > 0) then call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & fd_number, fd_order) end if - if (p > 0) then call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & fd_number, fd_order) end if - end if end subroutine s_initialize_derived_variables ! ----------------------------- @@ -119,19 +115,14 @@ end subroutine s_initialize_derived_variables ! ----------------------------- subroutine s_compute_derived_variables(t_step) ! ----------------------- integer, intent(IN) :: t_step - integer :: i, j, k !< Generic loop iterators - - call s_derive_center_of_mass(q_prim_ts(0)%vf, q_com) - call s_write_com_files(t_step, q_com) - + if (probe_wrt) then call s_derive_acceleration_component(1, q_prim_ts(0)%vf, & q_prim_ts(1)%vf, & q_prim_ts(2)%vf, & q_prim_ts(3)%vf, & x_accel) - if (n > 0) then call s_derive_acceleration_component(2, q_prim_ts(0)%vf, & q_prim_ts(1)%vf, & @@ -139,7 +130,6 @@ subroutine s_compute_derived_variables(t_step) ! ----------------------- q_prim_ts(3)%vf, & y_accel) end if - if (p > 0) then call s_derive_acceleration_component(3, q_prim_ts(0)%vf, & q_prim_ts(1)%vf, & @@ -147,7 +137,6 @@ subroutine s_compute_derived_variables(t_step) ! ----------------------- q_prim_ts(3)%vf, & z_accel) end if - do k = 0, p do j = 0, n do i = 0, m @@ -164,8 +153,10 @@ subroutine s_compute_derived_variables(t_step) ! ----------------------- end do end do end do + call s_derive_center_of_mass(q_prim_ts(3)%vf,c_mass) call s_write_probe_files(t_step, q_cons_ts(1)%vf, accel_mag) + call s_write_com_files(t_step,c_mass) end if end subroutine s_compute_derived_variables ! --------------------------- @@ -186,14 +177,11 @@ subroutine s_derive_acceleration_component(i, q_prim_vf0, q_prim_vf1, & q_prim_vf2, q_prim_vf3, q_sf) ! ---------- integer, intent(IN) :: i - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf0 type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf1 type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf2 type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf3 - real(kind(0d0)), dimension(0:m, 0:n, 0:p), intent(OUT) :: q_sf - integer :: j, k, l, r !< Generic loop iterators ! Computing the acceleration component in the x-coordinate direction @@ -201,7 +189,6 @@ subroutine s_derive_acceleration_component(i, q_prim_vf0, q_prim_vf1, & do l = 0, p do k = 0, n do j = 0, m - q_sf(j, k, l) = (11d0*q_prim_vf0(mom_idx%beg)%sf(j, k, l) & - 18d0*q_prim_vf1(mom_idx%beg)%sf(j, k, l) & + 9d0*q_prim_vf2(mom_idx%beg)%sf(j, k, l) & @@ -241,18 +228,15 @@ subroutine s_derive_acceleration_component(i, q_prim_vf0, q_prim_vf1, & end do end do end do - ! Computing the acceleration component in the y-coordinate direction elseif (i == 2) then do l = 0, p do k = 0, n do j = 0, m - q_sf(j, k, l) = (11d0*q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l) & - 18d0*q_prim_vf1(mom_idx%beg + 1)%sf(j, k, l) & + 9d0*q_prim_vf2(mom_idx%beg + 1)%sf(j, k, l) & - 2d0*q_prim_vf3(mom_idx%beg + 1)%sf(j, k, l))/(6d0*dt) - do r = -fd_number, fd_number if (p == 0) then ! 2D simulation q_sf(j, k, l) = q_sf(j, k, l) & @@ -284,7 +268,6 @@ subroutine s_derive_acceleration_component(i, q_prim_vf0, q_prim_vf1, & end do end do end do - ! Computing the acceleration component in the z-coordinate direction else do l = 0, p @@ -329,157 +312,149 @@ end subroutine s_derive_acceleration_component ! -------------------------- !! primitive variables, q_prim_vf. The computed location !! is then written to a formatted data file by the root process. !! @param q_prim_vf Primitive variables - !! @param q_com Mass,x-location,y-location,z-location,x-velocity,y-velocity,z-velocity, - !! x-acceleration, y-acceleration, z-acceleration, weighted - subroutine s_derive_center_of_mass(q_prim_vf,q_com) - - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - real(kind(0d0)), dimension(num_fluids,5), intent(inout) :: q_com - - real(kind(0d0)) :: xbeg,xend,ybeg,yend,zbeg,zend !< - !! Maximum and minimum values of cell boundaries in each direction used in check for - !! reflective BC in computation of center of mass - - integer :: i,j,k,l !< Generic loop iterators - real(kind(0d0)) :: tmp !< Temporary variable to store quantity for mpi_allreduce - real(kind(0d0)) :: dV !< Discrete cell volume - - if (n == 0) then !1D simulation + !! @param c_m Mass,x-location,y-location,z-location + subroutine s_derive_center_of_mass(q_vf,c_m) + type(scalar_field), dimension(sys_size), intent(IN) :: q_vf + real(kind(0d0)), dimension(1:num_fluids,1:5), intent(INOUT) :: c_m + integer :: i,j,k,l !< Generic loop iterators + real(kind(0d0)) :: tmp, tmp_out !< Temporary variable to store quantity for mpi_allreduce + real(kind(0d0)) :: dV !< Discrete cell volume + + do i = 1, num_fluids + do j = 1,5 + c_m(i,j) = 0.0d0 + end do + end do + + if (n == 0) then !1D simulation do i = 1,num_fluids !Loop over individual fluids - q_com(i,:) = 0d0 do l = 0, p !Loop over grid do k = 0, n do j = 0, m dV = dx(j) ! Mass - q_com(i,1) = q_com(i,1) + q_prim_vf(i)%sf(j,k,l)*dV + c_m(i,1) = c_m(i,1) + q_vf(i)%sf(j,k,l)*dV ! x-location weighted - q_com(i,2) = q_com(i,2) + q_prim_vf(i)%sf(j,k,l)*dV*x_cc(j) + c_m(i,2) = c_m(i,2) + q_vf(i)%sf(j,k,l)*dV*x_cc(j) ! Volume fraction - q_com(i,5) = q_com(i,5) + q_prim_vf(i+adv_idx%beg-1)%sf(j,k,l)*dV + c_m(i,5) = c_m(i,5) + q_vf(i+adv_idx%beg-1)%sf(j,k,l)*dV end do end do end do - ! Sum all components across all processors using MPI_ALLREDUCE - if (num_procs > 1) then - tmp = q_com(i,1) - call s_mpi_allreduce_sum(tmp,q_com(i,1)) - tmp = q_com(i,2) - call s_mpi_allreduce_sum(tmp,q_com(i,2)) - tmp = q_com(i,5) - call s_mpi_allreduce_sum(tmp,q_com(i,5)) - end if - ! Compute quotients - q_com(i,2) = q_com(i,2)/q_com(i,1) end do - elseif (p == 0) then !2D simulation + elseif (p == 0) then !2D simulation do i = 1,num_fluids !Loop over individual fluids - q_com(i,:) = 0d0 do l = 0, p !Loop over grid do k = 0, n do j = 0, m dV = dx(j)*dy(k) ! Mass - q_com(i,1) = q_com(i,1) + q_prim_vf(i)%sf(j,k,l)*dV + c_m(i,1) = c_m(i,1) + q_vf(i)%sf(j,k,l)*dV ! x-location weighted - q_com(i,2) = q_com(i,2) + q_prim_vf(i)%sf(j,k,l)*dV*x_cc(j) + c_m(i,2) = c_m(i,2) + q_vf(i)%sf(j,k,l)*dV*x_cc(j) ! y-location weighted - q_com(i,3) = q_com(i,3) + q_prim_vf(i)%sf(j,k,l)*dV*y_cc(k) + c_m(i,3) = c_m(i,3) + q_vf(i)%sf(j,k,l)*dV*y_cc(k) ! Volume fraction - q_com(i,5) = q_com(i,5) + q_prim_vf(i+adv_idx%beg-1)%sf(j,k,l)*dV + c_m(i,5) = c_m(i,5) + q_vf(i+adv_idx%beg-1)%sf(j,k,l)*dV end do end do end do + end do + else !3D simulation + do i = 1, num_fluids !Loop over individual fluids + do l = 0, p !Loop over grid + do k = 0, n + do j = 0, m + dV = dx(j)*dy(k)*dz(l) + ! Mass + c_m(i,1) = c_m(i,1) + q_vf(i)%sf(j,k,l)*dV + ! x-location weighted + c_m(i,2) = c_m(i,2) + q_vf(i)%sf(j,k,l)*dV*x_cc(j) + ! y-location weighted + c_m(i,3) = c_m(i,3) + q_vf(i)%sf(j,k,l)*dV*y_cc(k) + ! z-location weighted + c_m(i,4) = c_m(i,4) + q_vf(i)%sf(j,k,l)*dV*z_cc(l) + ! Volume fraction + c_m(i,5) = c_m(i,5) + q_vf(i+adv_idx%beg-1)%sf(j,k,l)*dV + end do + end do + end do + end do + end if + if (n == 0) then !1D simulation + do i = 1,num_fluids !Loop over individual fluids ! Sum all components across all processors using MPI_ALLREDUCE if (num_procs > 1) then - tmp = q_com(i,1) - call s_mpi_allreduce_sum(tmp,q_com(i,1)) - tmp = q_com(i,2) - call s_mpi_allreduce_sum(tmp,q_com(i,2)) - tmp = q_com(i,3) - call s_mpi_allreduce_sum(tmp,q_com(i,3)) - tmp = q_com(i,5) - call s_mpi_allreduce_sum(tmp,q_com(i,5)) + tmp = c_m(i,1) + call s_mpi_allreduce_sum(tmp,tmp_out) + c_m(i,1) = tmp_out + tmp = c_m(i,2) + call s_mpi_allreduce_sum(tmp,tmp_out) + c_m(i,2) = tmp_out + tmp = c_m(i,5) + call s_mpi_allreduce_sum(tmp,tmp_out) + c_m(i,5) = tmp_out end if ! Compute quotients - q_com(i,2) = q_com(i,2)/q_com(i,1) - q_com(i,3) = q_com(i,3)/q_com(i,1) + c_m(i,2) = c_m(i,2)/c_m(i,1) end do - else !3D simulation + elseif (p == 0) then !2D simulation do i = 1,num_fluids !Loop over individual fluids - q_com(i,:) = 0d0 - do l = 0, p !Loop over grid - do k = 0, n - do j = 0, m - dV = dx(j)*dy(k)*dz(l) - ! Mass - q_com(i,1) = q_com(i,1) + q_prim_vf(i)%sf(j,k,l)*dV - ! x-location weighted - q_com(i,2) = q_com(i,2) + q_prim_vf(i)%sf(j,k,l)*dV*x_cc(j) - ! y-location weighted - q_com(i,3) = q_com(i,3) + q_prim_vf(i)%sf(j,k,l)*dV*y_cc(k) - ! z-location weighted - q_com(i,4) = q_com(i,4) + q_prim_vf(i)%sf(j,k,l)*dV*z_cc(l) - ! Volume fraction - q_com(i,5) = q_com(i,5) + q_prim_vf(i+adv_idx%beg-1)%sf(j,k,l)*dV - end do - end do - end do ! Sum all components across all processors using MPI_ALLREDUCE if (num_procs > 1) then - tmp = q_com(i,1) - call s_mpi_allreduce_sum(tmp,q_com(i,1)) - tmp = q_com(i,2) - call s_mpi_allreduce_sum(tmp,q_com(i,2)) - tmp = q_com(i,3) - call s_mpi_allreduce_sum(tmp,q_com(i,3)) - tmp = q_com(i,4) - call s_mpi_allreduce_sum(tmp,q_com(i,4)) - tmp = q_com(i,5) - call s_mpi_allreduce_sum(tmp,q_com(i,5)) + tmp = c_m(i,1) + call s_mpi_allreduce_sum(tmp,tmp_out) + c_m(i,1) = tmp_out + tmp = c_m(i,2) + call s_mpi_allreduce_sum(tmp,tmp_out) + c_m(i,2) = tmp_out + tmp = c_m(i,3) + call s_mpi_allreduce_sum(tmp,tmp_out) + c_m(i,3) = tmp_out + tmp = c_m(i,5) + call s_mpi_allreduce_sum(tmp,tmp_out) + c_m(i,5) = tmp_out end if ! Compute quotients - q_com(i,2) = q_com(i,2)/q_com(i,1) - q_com(i,3) = q_com(i,3)/q_com(i,1) - q_com(i,4) = q_com(i,4)/q_com(i,1) - q_com(i,5) = q_com(i,5) + c_m(i,2) = c_m(i,2)/c_m(i,1) + c_m(i,3) = c_m(i,3)/c_m(i,1) end do - end if - ! Find computational domain boundaries - if (num_procs > 1) then - call s_mpi_allreduce_min(minval(x_cb(-1:m)),xbeg) - call s_mpi_allreduce_max(maxval(x_cb(-1:m)),xend) - if (n > 0) then - call s_mpi_allreduce_min(minval(y_cb(-1:n)),ybeg) - call s_mpi_allreduce_max(maxval(y_cb(-1:n)),yend) - if (p > 0) then - call s_mpi_allreduce_min(minval(z_cb(-1:p)),zbeg) - call s_mpi_allreduce_max(maxval(z_cb(-1:p)),zend) - end if - end if - else - xbeg = minval(x_cb(-1:m)) - xend = maxval(x_cb(-1:m)) - if (n > 0) then - ybeg = minval(y_cb(-1:n)) - yend = maxval(y_cb(-1:n)) - if (p > 0) then - zbeg = minval(z_cb(-1:p)) - zend = maxval(z_cb(-1:p)) - end if - end if - end if - + else !3D simulation + do i = 1, num_fluids !Loop over individual fluids + ! Sum all components across all processors using MPI_ALLREDUCE + if (num_procs > 1) then + tmp = c_m(i,1) + call s_mpi_allreduce_sum(tmp,tmp_out) + c_m(i,1) = tmp_out + tmp = c_m(i,2) + call s_mpi_allreduce_sum(tmp,tmp_out) + c_m(i,2) = tmp_out + tmp = c_m(i,3) + call s_mpi_allreduce_sum(tmp,tmp_out) + c_m(i,3) = tmp_out + tmp = c_m(i,4) + call s_mpi_allreduce_sum(tmp,tmp_out) + c_m(i,4) = tmp_out + tmp = c_m(i,5) + call s_mpi_allreduce_sum(tmp,tmp_out) + c_m(i,5) = tmp_out + end if + ! Compute quotients + c_m(i,2) = c_m(i,2)/c_m(i,1) + c_m(i,3) = c_m(i,3)/c_m(i,1) + c_m(i,4) = c_m(i,4)/c_m(i,1) + end do + end if + + end subroutine s_derive_center_of_mass ! ---------------------------------- !> Deallocation procedures for the module subroutine s_finalize_derived_variables_module() ! ------------------- - call s_close_com_files() - deallocate(q_com) - ! Closing CoM and flow probe files if (proc_rank == 0) then + call s_close_com_files() if (probe_wrt) then call s_close_probe_files() end if diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp index 8b88ca8e68..1effcc0f92 100644 --- a/src/simulation/m_qbmm.fpp +++ b/src/simulation/m_qbmm.fpp @@ -684,16 +684,16 @@ contains drdt = msum(2) if(moms(4) - moms(2)**2d0 > 0d0) then if(j == 1 .or. j == 2) then - drdt2 = (1d0 / (2d0 *DSQRT(moms(4) - moms(2)**2d0))) * -1d0 + drdt2 = -(1d0 / (2d0 *DSQRT(moms(4) - moms(2)**2d0))) else - drdt2 = (1d0 / (2d0 *DSQRT(moms(4) - moms(2)**2d0))) * 1d0 + drdt2 = (1d0 / (2d0 *DSQRT(moms(4) - moms(2)**2d0))) end if else !Edge case where variance < 0 if(j == 1 .or. j == 2) then - drdt2 = (1d0 / (2d0 *DSQRT(verysmall))) * -1d0 + drdt2 = -(1d0 / (2d0 *DSQRT(verysmall))) else - drdt2 = (1d0 / (2d0 *DSQRT(verysmall))) * 1d0 + drdt2 = (1d0 / (2d0 *DSQRT(verysmall))) end if end if drdt2 = drdt2 * (msum(3) - 2d0*moms(2) * msum(2)) diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index ca1f29208a..42f0f96209 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -1024,7 +1024,6 @@ contains #endif call s_initialize_cbc_module() - call s_initialize_derived_variables() end subroutine s_initialize_modules diff --git a/submit3D.sh b/submit3D.sh deleted file mode 100755 index 1757450269..0000000000 --- a/submit3D.sh +++ /dev/null @@ -1,12 +0,0 @@ -#!/bin/bash - - -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/3Gbl_base/input.py -e batch -p wholenode -w 01:00:00 -# 3Dmfc -N 6 -n 128 -t pre_process -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/3Gbl_base/input.py -e batch -p wholenode -w 06:00:00 -# 3Dmfc -N 6 -n 128 -t simulation -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/3Gbl_base/input.py -e batch -p wholenode -w 00:30:00 -# 3Dmfc -N 6 -n 128 -t post_process -b mpirun - -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/3Gbg_base/input.py -e batch -p wholenode -w 01:00:00 -# 3Dmfc -N 6 -n 128 -t pre_process -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/3Gbg_base/input.py -e batch -p wholenode -w 06:00:00 -# 3Dmfc -N 6 -n 128 -t simulation -b mpirun -./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/3Gbg_base/input.py -e batch -p wholenode -w 00:30:00 -# 3Dmfc -N 6 -n 128 -t post_process -b mpirun - - diff --git a/submit_job.sh b/submit_job.sh deleted file mode 100755 index 6582294ab4..0000000000 --- a/submit_job.sh +++ /dev/null @@ -1,10 +0,0 @@ -#!/bin/bash - -#./mfc.sh run /anvil/projects/x-mch220010/undex/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t pre_process -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/rc/input.py -e batch -p wholenode -w 01:00:00 -# rc -N 2 -n 128 -t pre_process -b mpirun - - -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/test/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t pre_process -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/test/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t simulation -b mpirun -./mfc.sh run /anvil/projects/x-mch220010/mrdz/mfcruns/test/input.py -e batch -p wholenode -w 01:00:00 -# undex -N 2 -n 128 -t post_process -b mpirun - diff --git a/submitjob.sh b/submitjob.sh new file mode 100755 index 0000000000..00a35f938f --- /dev/null +++ b/submitjob.sh @@ -0,0 +1,22 @@ +#!/bin/bash + +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/base/input.py -e batch -p wholenode -w 01:00:00 -# basepre -N 8 -n 128 -t pre_process -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s1/input.py -e batch -p wholenode -w 01:00:00 -# s1pre -N 8 -n 128 -t pre_process -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s2/input.py -e batch -p wholenode -w 01:00:00 -# s2pre -N 8 -n 128 -t pre_process -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s3/input.py -e batch -p wholenode -w 01:00:00 -# s3pre -N 8 -n 128 -t pre_process -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s4/input.py -e batch -p wholenode -w 01:00:00 -# s4pre -N 8 -n 128 -t pre_process -b mpirun + + +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/base/input.py -e batch -p wholenode -w 24:00:00 -# basesim -N 8 -n 128 -t simulation -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s1/input.py -e batch -p wholenode -w 24:00:00 -# s1sim -N 8 -n 128 -t simulation -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s2/input.py -e batch -p wholenode -w 24:00:00 -# s2sim -N 8 -n 128 -t simulation -b mpirun +./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s3/input.py -e batch -p wholenode -w 8:00:00 -# s3sim -N 8 -n 128 -t simulation -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s4/input.py -e batch -p wholenode -w 8:00:00 -# s4sim -N 8 -n 128 -t simulation -b mpirun + + +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/base/input.py -e batch -p wholenode -w 01:00:00 -# basepost -N 8 -n 128 -t post_process -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s1/input.py -e batch -p wholenode -w 01:00:00 -# s1post -N 8 -n 128 -t post_process -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s2/input.py -e batch -p wholenode -w 01:00:00 -# s2post -N 8 -n 128 -t post_process -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s3/input.py -e batch -p wholenode -w 02:00:00 -# s3post -N 8 -n 128 -t post_process -b mpirun +#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s4/input.py -e batch -p wholenode -w 02:00:00 -# s4post -N 8 -n 128 -t post_process -b mpirun + From d39eb3c77f88384574fa98b870698c1170f8c44a Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 31 Dec 2023 15:44:14 -0500 Subject: [PATCH 009/380] MFC for Bridges2 --- mfc.sh | 4 ++-- submitjob.sh | 30 +++++++++++++++--------------- toolchain/templates/slurm.sh | 4 ++-- 3 files changed, 19 insertions(+), 19 deletions(-) diff --git a/mfc.sh b/mfc.sh index 5746b5a53e..b8c7c647b5 100755 --- a/mfc.sh +++ b/mfc.sh @@ -411,7 +411,7 @@ fi # Activate the Python venv -#source "$(pwd)/build/venv/bin/activate" +source "$(pwd)/build/venv/bin/activate" ok "(venv) Entered the$MAGENTA Python$COLOR_RESET virtual environment." @@ -445,7 +445,7 @@ code=$? # Deactivate the Python virtualenv in case the user "source"'d this script log "(venv) Exiting the$MAGENTA Python$COLOR_RESET virtual environment." -#deactivate +deactivate # Exit proper exit code diff --git a/submitjob.sh b/submitjob.sh index 00a35f938f..15144cdc61 100755 --- a/submitjob.sh +++ b/submitjob.sh @@ -1,22 +1,22 @@ #!/bin/bash -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/base/input.py -e batch -p wholenode -w 01:00:00 -# basepre -N 8 -n 128 -t pre_process -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s1/input.py -e batch -p wholenode -w 01:00:00 -# s1pre -N 8 -n 128 -t pre_process -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s2/input.py -e batch -p wholenode -w 01:00:00 -# s2pre -N 8 -n 128 -t pre_process -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s3/input.py -e batch -p wholenode -w 01:00:00 -# s3pre -N 8 -n 128 -t pre_process -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s4/input.py -e batch -p wholenode -w 01:00:00 -# s4pre -N 8 -n 128 -t pre_process -b mpirun +#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/base/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 01:00:00 -# basepre -t pre_process -b mpirun +#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s1/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 01:00:00 -# s1pre -t pre_process -b mpirun +#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s2/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 01:00:00 -# s2pre -t pre_process -b mpirun +./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s3/input.py -e batch -p GPU-shared -N 1 -n 2 -g 1 -w 01:00:00 -# s3pre -t pre_process #-b mpirun +./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s4/input.py -e batch -p GPU-shared -N 1 -n 2 -g 1 -w 01:00:00 -# s4pre -t pre_process #-b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/base/input.py -e batch -p wholenode -w 24:00:00 -# basesim -N 8 -n 128 -t simulation -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s1/input.py -e batch -p wholenode -w 24:00:00 -# s1sim -N 8 -n 128 -t simulation -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s2/input.py -e batch -p wholenode -w 24:00:00 -# s2sim -N 8 -n 128 -t simulation -b mpirun -./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s3/input.py -e batch -p wholenode -w 8:00:00 -# s3sim -N 8 -n 128 -t simulation -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s4/input.py -e batch -p wholenode -w 8:00:00 -# s4sim -N 8 -n 128 -t simulation -b mpirun +#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/base/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 24:00:00 -# basesim -t simulation -b mpirun +#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s1/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 24:00:00 -# s1sim -t simulation -b mpirun +#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s2/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 24:00:00 -# s2sim -t simulation -b mpirun +#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s3/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 8:00:00 -# s3sim -t simulation -b mpirun +#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s4/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 8:00:00 -# s4sim -t simulation -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/base/input.py -e batch -p wholenode -w 01:00:00 -# basepost -N 8 -n 128 -t post_process -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s1/input.py -e batch -p wholenode -w 01:00:00 -# s1post -N 8 -n 128 -t post_process -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s2/input.py -e batch -p wholenode -w 01:00:00 -# s2post -N 8 -n 128 -t post_process -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s3/input.py -e batch -p wholenode -w 02:00:00 -# s3post -N 8 -n 128 -t post_process -b mpirun -#./mfc.sh run /anvil/projects/x-mch220010/mrdz/dfd2023/s4/input.py -e batch -p wholenode -w 02:00:00 -# s4post -N 8 -n 128 -t post_process -b mpirun +#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/base/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 01:00:00 -# basepost -t post_process -b mpirun +#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s1/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 01:00:00 -# s1post -t post_process -b mpirun +#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s2/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 01:00:00 -# s2post -t post_process -b mpirun +#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s3/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 02:00:00 -# s3post -t post_process -b mpirun +#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s4/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 02:00:00 -# s4post -t post_process -b mpirun diff --git a/toolchain/templates/slurm.sh b/toolchain/templates/slurm.sh index f7fae22077..e65d593ba0 100644 --- a/toolchain/templates/slurm.sh +++ b/toolchain/templates/slurm.sh @@ -30,8 +30,8 @@ #SBATCH --nodes={nodes} #SBATCH --ntasks-per-node={tasks_per_node} #SBATCH --cpus-per-task=1 -#>SBATCH --gpu-bind=verbose,closest -#>SBATCH --gpus=v100-16:{(1 if gpu else 0)*tasks_per_node*nodes} +#SBATCH --gpu-bind=verbose,closest +#SBATCH --gpus=v100-32:{(1 if gpu else 0)*tasks_per_node*nodes} #SBATCH --time={walltime} #SBATCH --partition="{partition}" #SBATCH --output="{name}.out" From 653e7eed66b73b07778d3c1a0cd27b669301a916 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 18 Jan 2024 17:42:37 -0500 Subject: [PATCH 010/380] added changes to SLURM --- submit.sh | 1 + submitjob.sh | 22 ---------------------- toolchain/templates/slurm.sh | 16 ++++++++-------- 3 files changed, 9 insertions(+), 30 deletions(-) create mode 120000 submit.sh delete mode 100755 submitjob.sh diff --git a/submit.sh b/submit.sh new file mode 120000 index 0000000000..d3511b96f8 --- /dev/null +++ b/submit.sh @@ -0,0 +1 @@ +../submit_gpu.sh \ No newline at end of file diff --git a/submitjob.sh b/submitjob.sh deleted file mode 100755 index 15144cdc61..0000000000 --- a/submitjob.sh +++ /dev/null @@ -1,22 +0,0 @@ -#!/bin/bash - -#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/base/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 01:00:00 -# basepre -t pre_process -b mpirun -#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s1/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 01:00:00 -# s1pre -t pre_process -b mpirun -#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s2/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 01:00:00 -# s2pre -t pre_process -b mpirun -./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s3/input.py -e batch -p GPU-shared -N 1 -n 2 -g 1 -w 01:00:00 -# s3pre -t pre_process #-b mpirun -./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s4/input.py -e batch -p GPU-shared -N 1 -n 2 -g 1 -w 01:00:00 -# s4pre -t pre_process #-b mpirun - - -#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/base/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 24:00:00 -# basesim -t simulation -b mpirun -#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s1/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 24:00:00 -# s1sim -t simulation -b mpirun -#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s2/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 24:00:00 -# s2sim -t simulation -b mpirun -#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s3/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 8:00:00 -# s3sim -t simulation -b mpirun -#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s4/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 8:00:00 -# s4sim -t simulation -b mpirun - - -#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/base/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 01:00:00 -# basepost -t post_process -b mpirun -#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s1/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 01:00:00 -# s1post -t post_process -b mpirun -#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s2/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 01:00:00 -# s2post -t post_process -b mpirun -#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s3/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 02:00:00 -# s3post -t post_process -b mpirun -#./mfc.sh run /ocean/projects/mch220006p/mrdz/dfd2023/s4/input.py -e batch -p GPU-shared -N 1 -n 4 -g 4 -w 02:00:00 -# s4post -t post_process -b mpirun - diff --git a/toolchain/templates/slurm.sh b/toolchain/templates/slurm.sh index e65d593ba0..1ec1c25c7f 100644 --- a/toolchain/templates/slurm.sh +++ b/toolchain/templates/slurm.sh @@ -31,7 +31,7 @@ #SBATCH --ntasks-per-node={tasks_per_node} #SBATCH --cpus-per-task=1 #SBATCH --gpu-bind=verbose,closest -#SBATCH --gpus=v100-32:{(1 if gpu else 0)*tasks_per_node*nodes} +#SBATCH --gres=gpu:v100-32:{(1 if gpu else 0)*tasks_per_node} #SBATCH --time={walltime} #SBATCH --partition="{partition}" #SBATCH --output="{name}.out" @@ -74,21 +74,21 @@ for binpath in {MFC::BINARIES}; do echo -e ":) Running $binpath:" - if command -v srun > /dev/null 2>&1; then - srun \ - --nodes {nodes} \ - --ntasks-per-node {tasks_per_node} \ - {MFC::PROFILER} "$binpath" +#> if command -v srun > /dev/null 2>&1; then +#> srun \ +#> --nodes {nodes} \ +#> --ntasks-per-node {tasks_per_node} \ +#> {MFC::PROFILER} "$binpath" #> #> srun --mpi=pmix \ #> {MFC::PROFILER} "$binpath" #> - else +#> else mpirun \ -np {nodes*tasks_per_node} \ {MFC::PROFILER} "$binpath" - fi +#> fi done From 201c949ae2749d023818ad6e8647d57e1813ba75 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 29 Jan 2024 18:02:35 -0600 Subject: [PATCH 011/380] added modules for NCSA Delta --- toolchain/modules | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/toolchain/modules b/toolchain/modules index 268a97aa32..c88d8afa36 100644 --- a/toolchain/modules +++ b/toolchain/modules @@ -51,4 +51,7 @@ o Brown o-all python/3.9.0 cmake/3.20.0 o-cpu gcc/10.2 mpi/openmpi_4.1.1_gcc_10.2_slurm22 hdf5/1.10.0 - +d Delta +d-all python/3.11.6 +d-cpu openmpi/5.0.1+cuda +d-gpu gcc-runtime/8.5.0 nvhpc/22.11 cuda/11.8.0 openmpi/4.1.5+cuda From a1dcb169f9956e4c052619e8c75c27df05f9778a Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 29 Jan 2024 19:08:36 -0600 Subject: [PATCH 012/380] adding NCSA Delta mako file for batch submission --- toolchain/templates/delta.mako | 58 ++++++++++++++++++++++++++++++++++ 1 file changed, 58 insertions(+) create mode 100644 toolchain/templates/delta.mako diff --git a/toolchain/templates/delta.mako b/toolchain/templates/delta.mako new file mode 100644 index 0000000000..f56b0366ae --- /dev/null +++ b/toolchain/templates/delta.mako @@ -0,0 +1,58 @@ +#!/usr/bin/env bash + +<%namespace name="helpers" file="helpers.mako"/> + +% if engine == 'batch': +#SBATCH --nodes=${nodes} +#SBATCH --ntasks-per-node=${tasks_per_node} +#SBATCH --cpus-per-task=1 +#SBATCH --job-name="${name}" +#SBATCH --time=${walltime} +% if partition: +#SBATCH --partition=${partition} +% endif +% if account: +#SBATCH --account="${account}" +% endif +% if gpu: +#SBATCH --gpus-per-node=4 +#SBATCH --gpu-bind=verbose,closest +#SBATCH --exclusive +#SBATCH --mem=208G +% endif +#SBATCH --constraint="scratch" +#SBATCH --output="${name}.out" +#SBATCH --error="${name}.err" +#SBATCH --export=ALL +% if email: +#SBATCH --mail-user=${email} +#SBATCH --mail-type="BEGIN, END, FAIL" +% endif +% endif + +${helpers.template_prologue()} + +ok ":) Loading modules:\n" +cd "${MFC_ROOTDIR}" +. ./mfc.sh load -c b -m ${'g' if gpu else 'c'} +cd - > /dev/null +echo + +% for target in targets: + ${helpers.run_prologue(target)} + + % if not mpi: + ${' '.join([f"'{x}'" for x in profiler ])} "${target.get_install_binpath()}" + % else: + ${' '.join([f"'{x}'" for x in profiler ])} \ + mpirun -np ${nodes*tasks_per_node} \ + ${' '.join([f"'{x}'" for x in ARG('--') ])} \ + "${target.get_install_binpath()}" + % endif + + ${helpers.run_epilogue(target)} + + echo +% endfor + +${helpers.template_epilogue()} From 27ecabe4a00552b0b290018646a1fbdc5b8e227f Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 29 Jan 2024 19:20:22 -0600 Subject: [PATCH 013/380] updated the Delta mako file --- toolchain/templates/delta.mako | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/toolchain/templates/delta.mako b/toolchain/templates/delta.mako index f56b0366ae..e7000cef71 100644 --- a/toolchain/templates/delta.mako +++ b/toolchain/templates/delta.mako @@ -34,7 +34,7 @@ ${helpers.template_prologue()} ok ":) Loading modules:\n" cd "${MFC_ROOTDIR}" -. ./mfc.sh load -c b -m ${'g' if gpu else 'c'} +. ./mfc.sh load -c d -m ${'g' if gpu else 'c'} cd - > /dev/null echo From 38b809105c5b8672b404c7a7a8d5082ba8a940ae Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 5 Feb 2024 15:53:31 -0500 Subject: [PATCH 014/380] made change to compile on Bridges2 --- toolchain/mfc/bench.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/toolchain/mfc/bench.py b/toolchain/mfc/bench.py index f2429e4c01..605d023bfc 100644 --- a/toolchain/mfc/bench.py +++ b/toolchain/mfc/bench.py @@ -13,7 +13,7 @@ class BenchCase: slug: str path: str - args: list[str] + #args: list[str] def bench(targets = None): From fa2c304ca42ae5b5cb3d31130bb465f36f735880 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Tue, 6 Feb 2024 13:39:50 -0500 Subject: [PATCH 015/380] Trying to merge spherical with master --- 2Dshinputsod1.5.py | 164 ++++++++++ 2Dshinputsod18.py | 164 ++++++++++ src/common/m_derived_types.fpp | 10 +- src/common/m_variables_conversion.fpp | 1 - src/pre_process/m_check_patches.fpp | 36 ++- src/pre_process/m_global_parameters.fpp | 15 +- src/pre_process/m_initial_condition.fpp | 4 + src/pre_process/m_mpi_proxy.fpp | 5 + src/pre_process/m_patches.fpp | 314 +++++++++++++------ src/simulation/m_checker.fpp | 1 - src/simulation/m_data_output.fpp | 399 +++++++++++++++++++++++- src/simulation/m_derived_variables.f90 | 20 +- src/simulation/m_global_parameters.fpp | 2 + src/simulation/m_mpi_proxy.fpp | 35 ++- src/simulation/m_rhs.fpp | 2 +- src/simulation/m_start_up.fpp | 6 +- src/simulation/m_time_steppers.fpp | 4 +- src/simulation/p_main.fpp | 5 +- toolchain/mfc/bench.py | 2 +- toolchain/mfc/run/case_dicts.py | 7 +- trial1.sh | 40 +++ 21 files changed, 1080 insertions(+), 156 deletions(-) create mode 100755 2Dshinputsod1.5.py create mode 100755 2Dshinputsod18.py create mode 100755 trial1.sh diff --git a/2Dshinputsod1.5.py b/2Dshinputsod1.5.py new file mode 100755 index 0000000000..c0747e9839 --- /dev/null +++ b/2Dshinputsod1.5.py @@ -0,0 +1,164 @@ +import math +import json + +Ri = 1.0E-01 +Rc = Ri +Rin = Ri/Rc +rhol = 1000 +rhog = 1 +rhoc = rhol +rholn = rhol/rhoc +rhogn = rhog/rhoc +Pb = 3550 +Pl = 5.0E+06 +delta_P = Pl-Pb +tc = 0.915*Ri*(rhol/delta_P)**(0.5) +mulc = 9E-04 +mubc = 1.0E-05 +uc = Ri/tc +Pc = rhoc*uc**(2) +Pln = Pl/Pc +Pbn = Pb/Pc +tcn = tc/tc +CFL = 0.2 +sod = 24/16 +leng = Rin*(3+sod) +PpBr = 256 +Nx = PpBr*leng +Ny = Nx +x_end = leng +y_end = leng +x_beg = 0.0 +y_beg = 0.0 +Pi_inf_l = 702.8E+06 +Pi_inf_b = 0.0E+00 +nl = 1.47 +nb = 1.19 +bl = 6.61E-04 +bb = 0.0E+00 +cl = (nl*(Pl+Pi_inf_l)/(rhol*(1-rhol*bl)))**(0.5) +clc = cl/uc +delta_x = leng/Nx +delta_t = CFL*delta_x/clc +Nt = int(1.255555*tcn/delta_t) +alpha1 = 1.0 +alpha2 = 1.0 +x_centroidl = (x_end-x_beg)/2.0 +y_centroidl = (y_end-y_beg)/2.0 +x_centroidb = sod +y_centroidb = 0.0E+00 +Rel = rhol*uc*2*Rin/mulc +Reb = rhog*uc*2*Rin/mubc + + +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================ + 'run_time_info' : 'T', + 'sim_data' : 'T', + # ========================================================== + + # Computational Domain Parameters ========================== + 'x_domain%beg' : x_beg, + 'x_domain%end' : x_end, + 'y_domain%beg' : y_beg, + 'y_domain%end' : y_end, + 'm' : int(Nx), + 'n' : int(Ny), + 'p' : 0, + 'cyl_coord' : 'T', + 'dt' : delta_t, + 't_step_start' : 0, + 't_step_stop' : Nt, + 't_step_save' : int(Nt/360), +# ========================================================== + + # Simulation Algorithm Parameters ========================== + 'num_patches' : 2, + 'model_eqns' : 2, + 'alt_soundspeed' : 'F', + 'num_fluids' : 2, + 'adv_alphan' : 'T', + 'mpp_lim' : 'F', + 'mixture_err' : 'F', + 'time_stepper' : 3, + 'weno_order' : 5, + 'weno_eps' : 1.E-32, + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'F', + 'weno_Re_flux' : 'F', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -5, + 'bc_x%end' : -6, + 'bc_y%beg' : -2, + 'bc_y%end' : -6, + # ========================================================== + + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'T', + 'fd_order' :'1', + 'probe_wrt' :'T', + 'num_probes' : 1, + 'probe(1)%x' : 0., + 'probe(1)%y' : 0., + # ========================================================== + + # Patch 1: Background ============================ + 'patch_icpp(1)%geometry' : 3, + 'patch_icpp(1)%x_centroid' : x_centroidl, + 'patch_icpp(1)%y_centroid' : y_centroidl, + 'patch_icpp(1)%length_x' : leng, + 'patch_icpp(1)%length_y' : leng, + 'patch_icpp(1)%vel(1)' : 0.E+00, + 'patch_icpp(1)%vel(2)' : 0.E+00, + 'patch_icpp(1)%pres' : Pln, + 'patch_icpp(1)%alpha_rho(1)' : alpha1*rholn, + 'patch_icpp(1)%alpha_rho(2)' : 0.0E+00, + 'patch_icpp(1)%alpha(1)' : alpha1, + 'patch_icpp(1)%alpha(2)' : 0.0E+00, + # ========================================================== + # Patch 2: Bubble ====================================== + 'patch_icpp(2)%geometry' : 14, + 'patch_icpp(2)%x_centroid' : x_centroidb, + 'patch_icpp(2)%y_centroid' : y_centroidb, + 'patch_icpp(2)%radius' : Rin, + 'patch_icpp(2)%non_axis_sym' : 'T', + 'patch_icpp(2)%a2' : 0.0, + 'patch_icpp(2)%a3' : 0.0, + 'patch_icpp(2)%a4' : 0.0, + 'patch_icpp(2)%a5' : 0.0, + 'patch_icpp(2)%a6' : 0.0, + 'patch_icpp(2)%a7' : 0.0, + 'patch_icpp(2)%a8' : 0.0, + 'patch_icpp(2)%a9' : 0.0, + 'patch_icpp(2)%a10' : 0.0, + 'patch_icpp(2)%a11' : 0.0, + 'patch_icpp(2)%a12' : 0.0, + 'patch_icpp(2)%alter_patch(1)' : 'T', + 'patch_icpp(2)%vel(1)' : 0.E+00, + 'patch_icpp(2)%vel(2)' : 0.E+00, + 'patch_icpp(2)%pres' : Pbn, + 'patch_icpp(2)%alpha_rho(1)' : 0.0E+00, + 'patch_icpp(2)%alpha_rho(2)' : alpha2*rhogn, + 'patch_icpp(2)%alpha(1)' : 0.0E+00, + 'patch_icpp(2)%alpha(2)' : alpha2, + # ========================================================== + + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : nl, + 'fluid_pp(1)%pi_inf' : Pi_inf_l/Pc, + 'fluid_pp(2)%gamma' : nb, + 'fluid_pp(2)%pi_inf' : Pi_inf_b/Pc, + 'fluid_pp(1)%Re(1)' : Rel, + 'fluid_pp(2)%Re(1)' : Reb, + # ========================================================== +})) + +# ============================================================================== + diff --git a/2Dshinputsod18.py b/2Dshinputsod18.py new file mode 100755 index 0000000000..040f464874 --- /dev/null +++ b/2Dshinputsod18.py @@ -0,0 +1,164 @@ +import math +import json + +Ri = 1.0E-01 +Rc = Ri +Rin = Ri/Rc +rhol = 1000 +rhog = 1 +rhoc = rhol +rholn = rhol/rhoc +rhogn = rhog/rhoc +Pb = 3550 +Pl = 5.0E+06 +delta_P = Pl-Pb +tc = 0.915*Ri*(rhol/delta_P)**(0.5) +mulc = 9E-04 +mubc = 1.0E-05 +uc = Ri/tc +Pc = rhoc*uc**(2) +Pln = Pl/Pc +Pbn = Pb/Pc +tcn = tc/tc +CFL = 0.2 +sod = 18/16 +leng = 4.5 +PpBr = 256 +Nx = PpBr*leng +Ny = Nx +x_end = leng +y_end = leng +x_beg = 0.0 +y_beg = 0.0 +Pi_inf_l = 702.8E+06 +Pi_inf_b = 0.0E+00 +nl = 1.47 +nb = 1.19 +bl = 6.61E-04 +bb = 0.0E+00 +cl = (nl*(Pl+Pi_inf_l)/(rhol*(1-rhol*bl)))**(0.5) +clc = cl/uc +delta_x = leng/Nx +delta_t = CFL*delta_x/clc +Nt = int(1.255555*tcn/delta_t) +alpha1 = 1.0 +alpha2 = 1.0 +x_centroidl = (x_end-x_beg)/2.0 +y_centroidl = (y_end-y_beg)/2.0 +x_centroidb = sod +y_centroidb = 0.0E+00 +Rel = rhol*uc*2*Rin/mulc +Reb = rhog*uc*2*Rin/mubc + + +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================ + 'run_time_info' : 'T', + 'sim_data' : 'T', + # ========================================================== + + # Computational Domain Parameters ========================== + 'x_domain%beg' : x_beg, + 'x_domain%end' : x_end, + 'y_domain%beg' : y_beg, + 'y_domain%end' : y_end, + 'm' : int(Nx), + 'n' : int(Ny), + 'p' : 0, + 'cyl_coord' : 'T', + 'dt' : delta_t, + 't_step_start' : 0, + 't_step_stop' : Nt, + 't_step_save' : int(Nt/360), +# ========================================================== + + # Simulation Algorithm Parameters ========================== + 'num_patches' : 2, + 'model_eqns' : 2, + 'alt_soundspeed' : 'F', + 'num_fluids' : 2, + 'adv_alphan' : 'T', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'time_stepper' : 3, + 'weno_order' : 5, + 'weno_eps' : 1.E-16, + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'F', + 'weno_Re_flux' : 'F', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -5, + 'bc_x%end' : -6, + 'bc_y%beg' : -2, + 'bc_y%end' : -6, + # ========================================================== + + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'T', + 'fd_order' :'1', + 'probe_wrt' :'T', + 'num_probes' : 1, + 'probe(1)%x' : 0., + 'probe(1)%y' : 0., + # ========================================================== + + # Patch 1: Background ============================ + 'patch_icpp(1)%geometry' : 3, + 'patch_icpp(1)%x_centroid' : x_centroidl, + 'patch_icpp(1)%y_centroid' : y_centroidl, + 'patch_icpp(1)%length_x' : leng, + 'patch_icpp(1)%length_y' : leng, + 'patch_icpp(1)%vel(1)' : 0.E+00, + 'patch_icpp(1)%vel(2)' : 0.E+00, + 'patch_icpp(1)%pres' : Pln, + 'patch_icpp(1)%alpha_rho(1)' : alpha1*rholn, + 'patch_icpp(1)%alpha_rho(2)' : 0.0E+00, + 'patch_icpp(1)%alpha(1)' : alpha1, + 'patch_icpp(1)%alpha(2)' : 0.0E+00, + # ========================================================== + # Patch 2: Bubble ====================================== + 'patch_icpp(2)%geometry' : 14, + 'patch_icpp(2)%x_centroid' : x_centroidb, + 'patch_icpp(2)%y_centroid' : y_centroidb, + 'patch_icpp(2)%radius' : Rin, + 'patch_icpp(2)%non_axis_sym' : 'T', + 'patch_icpp(2)%a2' : 0.0, + 'patch_icpp(2)%a3' : 0.0, + 'patch_icpp(2)%a4' : 0.0, + 'patch_icpp(2)%a5' : 0.0, + 'patch_icpp(2)%a6' : 0.0, + 'patch_icpp(2)%a7' : 0.0, + 'patch_icpp(2)%a8' : 0.0, + 'patch_icpp(2)%a9' : 0.0, + 'patch_icpp(2)%a10' : 0.0, + 'patch_icpp(2)%a11' : 0.0, + 'patch_icpp(2)%a12' : 0.0, + 'patch_icpp(2)%alter_patch(1)' : 'T', + 'patch_icpp(2)%vel(1)' : 0.E+00, + 'patch_icpp(2)%vel(2)' : 0.E+00, + 'patch_icpp(2)%pres' : Pbn, + 'patch_icpp(2)%alpha_rho(1)' : 0.0E+00, + 'patch_icpp(2)%alpha_rho(2)' : alpha2*rhogn, + 'patch_icpp(2)%alpha(1)' : 0.0E+00, + 'patch_icpp(2)%alpha(2)' : alpha2, + # ========================================================== + + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : nl, + 'fluid_pp(1)%pi_inf' : Pi_inf_l/Pc, + 'fluid_pp(2)%gamma' : nb, + 'fluid_pp(2)%pi_inf' : Pi_inf_b/Pc, + 'fluid_pp(1)%Re(1)' : Rel, + 'fluid_pp(2)%Re(1)' : Reb, + # ========================================================== +})) + +# ============================================================================== + diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index 29989b8608..d020eda803 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -123,8 +123,14 @@ module m_derived_types type(ic_model_parameters) :: model !< Model parameters real(kind(0d0)) :: epsilon, beta !< - !! The spherical harmonics eccentricity parameters. - + !! The isentropic vortex parameters administrating, respectively, both + !! the amplitude of the disturbance as well as its domain of influence. + + real(kind(0d0)) :: a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 !< + !! The parameters needed for the spherical harmonic patch + + logical :: non_axis_sym + real(kind(0d0)), dimension(3) :: normal !< !! Normal vector indicating the orientation of the patch. It is specified !! through its x-, y- and z-components, respectively. diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 62dedc9fbe..de4d7b57d9 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -410,7 +410,6 @@ contains pi_inf = pi_inf + alpha_K(i)*pi_infs(i) qv = qv + alpha_rho_K(i)*qvs(i) end do - #ifdef MFC_SIMULATION ! Computing the shear and bulk Reynolds numbers from species analogs do i = 1, 2 diff --git a/src/pre_process/m_check_patches.fpp b/src/pre_process/m_check_patches.fpp index 1a26d88306..dd8bda0597 100644 --- a/src/pre_process/m_check_patches.fpp +++ b/src/pre_process/m_check_patches.fpp @@ -419,26 +419,32 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the spherical harmonic patch - if (p == 0 & - .or. & - patch_icpp(patch_id)%radius <= 0d0 & - .or. & - patch_icpp(patch_id)%x_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%y_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%z_centroid == dflt_real & - .or. & - all(patch_icpp(patch_id)%epsilon /= (/1d0, 2d0, 3d0, 4d0, 5d0/)) & - .or. & - patch_icpp(patch_id)%beta < 0d0 & - .or. & - patch_icpp(patch_id)%beta > patch_icpp(patch_id)%epsilon) then + + if (p > 0) then + if (n == 0 .or. patch_icpp(patch_id)%radius <= 0d0 & + .or. & + patch_icpp(patch_id)%x_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%y_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%z_centroid == dflt_real) then call s_mpi_abort('Inconsistency(ies) detected in '// & 'geometric parameters of spherical '// & 'harmonic patch '//trim(iStr)//'. Exiting ...') + end if + else if (p == 0) then + if (n == 0 .or. p > 0 .or. patch_icpp(patch_id)%radius <= 0d0 & + .or. & + patch_icpp(patch_id)%x_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%y_centroid == dflt_real) then + + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'geometric parameters of spherical '// & + 'harmonic patch '//trim(iStr)//'. Exiting ...') + end if end if end subroutine s_check_spherical_harmonic_patch_geometry ! ------------- diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index ba58e21698..7a70e99d7a 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -22,7 +22,7 @@ module m_global_parameters integer :: num_procs !< Number of processors character(LEN=path_len) :: case_dir !< Case folder location logical :: old_grid !< Use existing grid data - logical :: old_ic !< Use existing IC data + logical :: old_ic, non_axis_sym !< Use existing IC data integer :: t_step_old, t_step_start !< Existing IC/grid folder ! ========================================================================== @@ -210,6 +210,7 @@ contains old_ic = .false. t_step_old = dflt_int t_step_start = dflt_int + ! Computational domain parameters m = dflt_int; n = 0; p = 0 @@ -304,6 +305,18 @@ contains patch_icpp(i)%qv = 0d0 patch_icpp(i)%qvp = 0d0 patch_icpp(i)%tau_e = 0d0 + patch_icpp(i)%a2 = dflt_real + patch_icpp(i)%a3 = dflt_real + patch_icpp(i)%a4 = dflt_real + patch_icpp(i)%a5 = dflt_real + patch_icpp(i)%a6 = dflt_real + patch_icpp(i)%a8 = dflt_real + patch_icpp(i)%a9 = dflt_real + patch_icpp(i)%a10 = dflt_real + patch_icpp(i)%a11 = dflt_real + patch_icpp(i)%a12 = dflt_real + patch_icpp(i)%non_axis_sym = .false. + !should get all of r0's and v0's patch_icpp(i)%r0 = dflt_real patch_icpp(i)%v0 = dflt_real diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp index 8c0063f6e4..941d0fc5d9 100644 --- a/src/pre_process/m_initial_condition.fpp +++ b/src/pre_process/m_initial_condition.fpp @@ -204,6 +204,10 @@ contains ! Analytical function patch for testing purposes elseif (patch_icpp(i)%geometry == 7) then call s_2D_analytical(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) ! Spiral patch elseif (patch_icpp(i)%geometry == 17) then diff --git a/src/pre_process/m_mpi_proxy.fpp b/src/pre_process/m_mpi_proxy.fpp index b0e9ff2253..8668152fe8 100644 --- a/src/pre_process/m_mpi_proxy.fpp +++ b/src/pre_process/m_mpi_proxy.fpp @@ -75,6 +75,7 @@ contains #:endfor call MPI_BCAST(patch_icpp(i)%smoothen, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(patch_icpp(i)%non_axis_sym, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) call MPI_BCAST(patch_icpp(i)%alter_patch(0), num_patches_max, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) #:for VAR in [ 'x_centroid', 'y_centroid', 'z_centroid', & @@ -84,6 +85,10 @@ contains call MPI_BCAST(patch_icpp(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) #:endfor + #:for VAR in [ 'a2', 'a3', 'a4', 'a5', 'a6', 'a7', 'a8', 'a9', 'a10', 'a11', 'a12'] + call MPI_BCAST(patch_icpp(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + #:endfor + call MPI_BCAST(patch_icpp(i)%model%filepath, len(patch_icpp(i)%model%filepath), MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr) #:for VAR in [ 'model%translate', 'model%scale', 'model%rotate', & diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index f3c924af26..53bab4cad1 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -65,7 +65,8 @@ module m_patches !! 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(kind(0d0)) :: cart_y, cart_z + real(kind(0d0)) :: r_cyl, theta_cyl, x_cart, y_cart, z_cart + real(kind(0d0)) :: cart_x, cart_y, cart_z real(kind(0d0)) :: sph_phi !< !! Variables to be used to hold cell locations in Cartesian coordinates if !! 3D simulation is using cylindrical coordinates @@ -413,7 +414,7 @@ contains ((y_cc(j) - y_centroid)/b)**2) & - 1d0))*(-0.5d0) + 0.5d0 end if - + PRINT *,"a :",a, "b :",b if ((((x_cc(i) - x_centroid)/a)**2 + & ((y_cc(j) - y_centroid)/b)**2 <= 1d0 & .and. & @@ -974,131 +975,238 @@ contains !! as a perturbation to a perfect sphere !! @param patch_id is the patch identifier 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) :: 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) :: q_prim_vf + real(kind(0d0)) :: r, x_p, P2, P3, P4, P5, P6, P7, P8, P9, P10, P11, P12, eps, phi + real(kind(0d0)) :: a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 + real(kind(0d0)) :: radius, x_centroid, y_centroid, z_centroid + logical :: non_axis_sym - real(kind(0d0)) :: epsilon, beta - real(kind(0d0)) :: radius + integer :: i, j, k !< generic loop iterators - integer :: i, j, k !< generic loop iterators - - complex(kind(0d0)) :: cmplx_i = (0d0, 1d0) - complex(kind(0d0)) :: H ! Transferring the patch's centroid and radius 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 radius = patch_icpp(patch_id)%radius - epsilon = patch_icpp(patch_id)%epsilon - beta = patch_icpp(patch_id)%beta + a2 = patch_icpp(patch_id)%a2 + a3 = patch_icpp(patch_id)%a3 + a4 = patch_icpp(patch_id)%a4 + a5 = patch_icpp(patch_id)%a5 + a6 = patch_icpp(patch_id)%a6 + a7 = patch_icpp(patch_id)%a7 + a8 = patch_icpp(patch_id)%a8 + a9 = patch_icpp(patch_id)%a9 + a10 = patch_icpp(patch_id)%a10 + a11 = patch_icpp(patch_id)%a11 + a12 = patch_icpp(patch_id)%a12 + non_axis_sym = 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 = 1d0 + eps = 1.d-32 + ! 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. - do k = 0, p + if (p > 0) 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 = dsqrt((x_cc(i)-x_centroid)**2+(cart_y-y_centroid)**2+(cart_z-z_centroid)**2)+eps + x_p = dabs(x_cc(i)-x_centroid+eps)/r + P2 = unassociated_legendre(x_p,2) + P3 = unassociated_legendre(x_p,3) + P4 = unassociated_legendre(x_p,4) + P5 = unassociated_legendre(x_p,5) + P6 = unassociated_legendre(x_p,6) + P7 = unassociated_legendre(x_p,7) + + + if (x_cc(i)-x_centroid >= 0 & + .and. & + r-a2*P2-a3*P3-a4*P4-a5*P5-a6*P6-a7*P7 <= radius & + .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) + + elseif (x_cc(i)-x_centroid < 0 & + .and. & + r-a2*P2+a3*P3-a4*P4+a5*P5-a6*P6+a7*P7 <= radius & + .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) + endif + end do + end do + end do - 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_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)))) & - then - - call s_convert_cylindrical_to_spherical_coord(x_cc(i), y_cc(j)) - - if (epsilon == 1d0) then - if (beta == 0d0) then - H = 5d-1*sqrt(3d0/pi)*cos(sph_phi) - elseif (beta == 1d0) then - H = -5d-1*sqrt(3d0/(2d0*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi) - end if - elseif (epsilon == 2d0) then - if (beta == 0d0) then - H = 25d-2*sqrt(5d0/pi)*(3d0*cos(sph_phi)**2 - 1d0) - elseif (beta == 1d0) then - H = -5d-1*sqrt(15d0/(2d0*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)*cos(sph_phi) - elseif (beta == 2d0) then - H = 25d-2*sqrt(15d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))*sin(sph_phi)**2 - end if - elseif (epsilon == 3d0) then - if (beta == 0d0) then - H = 25d-2*sqrt(7d0/pi)*(5d0*cos(sph_phi)**3d0 - 3d0*cos(sph_phi)) - elseif (beta == 1d0) then - H = -125d-3*sqrt(21d0/pi)*exp(cmplx_i*z_cc(k))*sin(sph_phi)* & - (5d0*cos(sph_phi)**2 - 1d0) - elseif (beta == 2d0) then - H = 25d-2*sqrt(105d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & - sin(sph_phi)**2*cos(sph_phi) - elseif (beta == 3d0) then - H = -125d-3*sqrt(35d0/pi)*exp(3d0*cmplx_i*z_cc(k))*sin(sph_phi)**3d0 - end if - elseif (epsilon == 4d0) then - if (beta == 0d0) then - H = 3d0/16d0*sqrt(1d0/pi)*(35d0*cos(sph_phi)**4d0 - & - 3d1*cos(sph_phi)**2 + 3d0) - elseif (beta == 1d0) then - H = -3d0/8d0*sqrt(5d0/pi)*exp(cmplx_i*z_cc(k))* & - sin(sph_phi)*(7d0*cos(sph_phi)**3d0 - 3d0*cos(sph_phi)) - elseif (beta == 2d0) then - H = 3d0/8d0*sqrt(5d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & - sin(sph_phi)**2*(7d0*cos(sph_phi)**2 - 1d0) - elseif (beta == 3d0) then - H = -3d0/8d0*sqrt(35d0/pi)*exp(3d0*cmplx_i*z_cc(k))* & - sin(sph_phi)**3d0*cos(sph_phi) - elseif (beta == 4d0) then - H = 3d0/16d0*sqrt(35d0/(2d0*pi))*exp(4d0*cmplx_i*z_cc(k))* & - sin(sph_phi)**4d0 - end if - elseif (epsilon == 5d0) then - if (beta == 0d0) then - H = 1d0/16d0*sqrt(11d0/pi)*(63d0*cos(sph_phi)**5d0 - & - 7d1*cos(sph_phi)**3d0 + 15d0*cos(sph_phi)) - elseif (beta == 1d0) then - H = -1d0/16d0*sqrt(165d0/(2d0*pi))*exp(cmplx_i*z_cc(k))* & - sin(sph_phi)*(21d0*cos(sph_phi)**4d0 - 14d0*cos(sph_phi)**2 + 1d0) - elseif (beta == 2d0) then - H = 125d-3*sqrt(1155d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & - sin(sph_phi)**2*(3d0*cos(sph_phi)**3d0 - cos(sph_phi)) - elseif (beta == 3d0) then - H = -1d0/32d0*sqrt(385d0/pi)*exp(3d0*cmplx_i*z_cc(k))* & - sin(sph_phi)**3d0*(9d0*cos(sph_phi)**2 - 1d0) - elseif (beta == 4d0) then - H = 3d0/16d0*sqrt(385d0/(2d0*pi))*exp(4d0*cmplx_i*z_cc(k))* & - sin(sph_phi)**4d0*cos(sph_phi) - elseif (beta == 5d0) then - H = -3d0/32d0*sqrt(77d0/pi)*exp(5d0*cmplx_i*z_cc(k))* & - sin(sph_phi)**5d0 - end if - end if - - q_prim_vf(adv_idx%beg)%sf(i, j, k) = 1d0 - abs(real(H, kind(0d0))) + else if ( p == 0) then + do j = 0, n + do i = 0, m + + if (non_axis_sym) then + phi = atan(((y_cc(j)-y_centroid)+eps)/((x_cc(i)-x_centroid)+eps)) + r = dsqrt((x_cc(i)-x_centroid)**2d0+(y_cc(j)-y_centroid)**2d0)+eps + x_p = (eps)/r + P2 = spherical_harmonic_func(x_p, phi, 2, 2) + P3 = spherical_harmonic_func(x_p, phi, 3, 3) + P4 = spherical_harmonic_func(x_p, phi, 4, 4) + P5 = spherical_harmonic_func(x_p, phi, 5, 5) + P6 = spherical_harmonic_func(x_p, phi, 6, 6) + P7 = spherical_harmonic_func(x_p, phi, 7, 7) + P8 = spherical_harmonic_func(x_p, phi, 8, 8) + P9 = spherical_harmonic_func(x_p, phi, 9, 9) + ! P10 = spherical_harmonic_func(x_p, phi, 10, 10) + ! P11 = spherical_harmonic_func(x_p, phi, 11, 11) + ! P12 = spherical_harmonic_func(x_p, phi, 12, 12) + else + r = dsqrt((x_cc(i)-x_centroid)**2d0+(y_cc(j)-y_centroid)**2d0)+eps + x_p = dabs(x_cc(i)-x_centroid+eps)/r + P2 = unassociated_legendre(x_p,2) + P3 = unassociated_legendre(x_p,3) + P4 = unassociated_legendre(x_p,4) + P5 = unassociated_legendre(x_p,5) + P6 = unassociated_legendre(x_p,6) + P7 = unassociated_legendre(x_p,7) + end if + + if (x_cc(i)-x_centroid >= 0 & + .and. & + r-a2*P2-a3*P3-a4*P4-a5*P5-a6*P6-a7*P7-a8*P8-a9*P9 <= 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, q_prim_vf, patch_id_fp) + + elseif (x_cc(i)-x_centroid < 0 & + .and. & + r-a2*P2+a3*P3-a4*P4+a5*P5-a6*P6+a7*P7-a8*P8+a9*P9 <= 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, q_prim_vf, patch_id_fp) + + endif + end do + end do + end if + + end subroutine s_spherical_harmonic ! ---------------------------------- - end if + !! This function generates the unassociated legendre poynomials with input + ! mode number and evaluates them at input x + + recursive function unassociated_legendre(x,l) result(P) + integer, intent(in) :: l + real(kind(0d0)), intent(in) :: x + real(kind(0d0)) :: P + + if (l == 0) then + P = 1d0 + else if (l == 1) then + P = x + else + P = ((2*l-1)*x*unassociated_legendre(x,l-1)-(l-1)*unassociated_legendre(x,l-2))/l + end if + + end function unassociated_legendre + + !! This function generated the spherical harmonic function valu, Y, + !based on inputs of x, phi, l and m + + recursive function spherical_harmonic_func(x, phi, l, m) result(Y) + integer, intent(in) :: l, m + real(kind(0d0)), intent(in) :: x, phi + real(kind(0d0)) :: Y, prefactor, pi + + pi = acos(-1d0) + prefactor = sqrt((2*l+1)/(4*pi)*factorial(l-m)/factorial(l+m)); + if (m == 0) then + Y = prefactor*associated_legendre(x, l, m); + elseif (m .gt. 0) then + Y = (-1d0)**m*sqrt(2d0)*prefactor*associated_legendre(x, l, m)*cos(m*phi); + endif + end function spherical_harmonic_func + + !! This function generates the associated legendre polynomials evaluated + !at x with inputs l and m + + recursive function associated_legendre(x, l, m) result(P) + integer, intent(in) :: l, m + real(kind(0d0)), intent(in) :: x + real(kind(0d0)) :: P + + if (m <= 0 .and. l <= 0) then + P = 1; + elseif (l == 1 .and. m <= 0) then + P = x; + elseif (l == 1 .and. m == 1) then + P = -(1-x**2)**(1/2); + elseif (m == l) then + P = (-1)**l*double_factorial(2*l-1)*(1-x**2)**(l/2); + elseif (m == l-1) then + P = x*(2*l-1)*associated_legendre(x, l-1, l-1); + else + P = ((2*l-1)*x*associated_legendre(x, l-1, m)-(l+m-1)*associated_legendre(x, l-2, m))/(l-m); + endif + + end function associated_legendre + + !! This function calculates the double factorial value of an integer + + recursive function double_factorial(n) result(R) + integer, intent (in) :: n + integer, parameter :: int64_kind = selected_int_kind(18) ! 18 bytes for 64-bit integer + integer(kind=int64_kind) :: R + + if (n <= 0) then + R = 1 + else if (n == 1) then + R = 1 + else + R = n * double_factorial(n - 2) + end if + + end function double_factorial + + !! The following function calculates the factorial value of an integer + + recursive function factorial(n) result(R) + integer, intent(in) :: n + integer, parameter :: int64_kind = selected_int_kind(18) ! 18 bytes for 64-bit integer + integer(kind=int64_kind) :: R + + if (n == 0) then + R = 1 + else + R = n * factorial(n - 1) + end if + + end function factorial - end do - end do - end do - 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 @@ -1558,7 +1666,7 @@ contains end subroutine s_convert_cylindrical_to_cartesian_coord ! -------------- - function f_convert_cyl_to_cart(cyl) result(cart) + function f_convert_cyl_to_cart(cyl) result(cart) !$acc routine seq @@ -1580,7 +1688,7 @@ contains end subroutine s_convert_cylindrical_to_spherical_coord ! -------------- - !> Archimedes spiral function + !> Archimedes spiral funcreal(kind(0d0)) :: theta_cc, r, x_p, P2, P3, P4, P5, P6, P7tion !! @param myth Angle !! @param offset Thickness !! @param a Starting position diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index ee65090a0a..2d0550babe 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -409,5 +409,4 @@ contains ! END: Fluids Physical Parameters ================================== end subroutine s_check_inputs - end module m_checker diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 52c2d70169..79adbc1064 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -1,4 +1,4 @@ -!> + !! @file m_data_output.f90 !! @brief Contains module m_data_output @@ -45,9 +45,11 @@ module m_data_output s_close_run_time_information_file, & s_close_com_files, & s_close_probe_files, & - s_finalize_data_output_module - - abstract interface ! =================================================== + s_finalize_data_output_module, & + s_open_sim_data_file, & + s_write_sim_data_file, & + s_close_sim_data_file + abstract interface ! =================================================== !> Write data files !! @param q_cons_vf Conservative variables @@ -201,6 +203,36 @@ contains end do end subroutine s_open_com_files ! -------------------------------------- + + subroutine s_open_sim_data_file() ! ------------------------ + + character(LEN=path_len + 5*name_len) :: file_path !< + !! Relative path to a file in the case directory + character(LEN=8) :: file_date !< + !! Creation date of the run-time information file + + write (file_path, '(A)') '/sim_data.txt' + file_path = trim(case_dir)//trim(file_path) + + ! Opening the simulation data file + open (21519, FILE=trim(file_path), & + FORM='formatted', & + POSITION='append', & + STATUS='unknown') +! call date_and_time(DATE=file_date) + +! write (21519, '(A)') 'Date: '//file_date(5:6)//'/'// & +! file_date(7:8)//'/'// & +! file_date(3:4) + + + end subroutine s_open_sim_data_file ! ---------------------------------------- + + + + + + !> This opens a formatted data file where the root processor !! can write out flow probe information subroutine s_open_probe_files() ! -------------------------------------- @@ -282,7 +314,6 @@ contains real(kind(0d0)) :: blkmod1, blkmod2 !< !! Fluid bulk modulus for Woods mixture sound speed - integer :: i, j, k, l, q !< Generic loop iterators integer :: Nfq @@ -294,7 +325,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - + do i = 1, num_fluids alpha_rho(i) = q_prim_vf(i)%sf(j, k, l) alpha(i) = q_prim_vf(E_idx + i)%sf(j, k, l) @@ -402,7 +433,7 @@ contains end do end do ! end: Computing Stability Criteria at Current Time-step =========== - + ! Determining local stability criteria extrema at current time-step !$acc kernels @@ -447,6 +478,7 @@ contains t_step, t_step*dt, icfl_max_glb, & vcfl_max_glb, & Rc_min_glb + else write (1, '(13X,I8,14X,F10.6,13X,F9.6)') & t_step, t_step*dt, icfl_max_glb @@ -471,6 +503,324 @@ contains end subroutine s_write_run_time_information ! -------------------------- + subroutine s_write_sim_data_file(q_prim_vf, t_step) + + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + integer, intent(IN) :: t_step + integer :: i, j, k, l, w !< Generic loop iterators + integer :: ierr, counter, counter2, counter3, root !< number of data points extracted to fit shape to SH perturbations + + real(kind(0d0)) :: u, m_a_x, m_a_y, m_a_z, eps + real(kind(0d0)), dimension(0:m,0:n) :: d_alpha_x, d_magdalphax, d_magdalphay, f_NS, rho, alpha_rhob + real(kind(0d0)), dimension(0:m,0:n) :: d_alpha_y, mag_d_alpha, d_rho_x, d_rho_y, mag_d_rho, alpha_b + real(kind(0d0)), dimension(0:m,0:n,0:p) :: d_alph_mpi_barrier_x3, d_alpha_y3, d_alpha_z3 + real(kind(0d0)) :: xdv, ydv, mag_d_alpha3, nondim_time, alphaxm, alphaxp, alphaym, alphayp + real(kind(0d0)), dimension(num_fluids) :: alpha, vol_fluid, xcom, ycom, zcom + real(kind(0d0)) :: alpha_t, concavity_x_prior, concavity_x_post, concavity_y_prior, concavity_y_post + real(kind(0d0)), allocatable :: q(:), maxdalphy(:), maxdalphx(:) + real(kind=8),parameter :: pi=4.D0*datan(1.D0) + real(kind(0d0)), allocatable :: x_td(:), y_td(:), x_tdf(:), y_tdf(:), x_d1(:), y_d1(:), y_d(:), x_d(:) + + real(kind(0d0)) :: axp, axm, ayp, aym + + call s_calculate_COM(q_prim_vf, xcom, ycom, vol_fluid) + + if (t_step_old /= dflt_int) then + nondim_time = real(t_step + t_step_old, kind(0d0))*dt + else + nondim_time = real(t_step, kind(0d0))*dt !*1.d-5/10.0761131451d0 + end if + root = 0 + allocate(x_d1(m*n)) + allocate(y_d1(m*n)) + counter = 0 + do k = 0,n + OLoop: do j = 0,m + axp = q_prim_vf(E_idx + 2)%sf(j+1,k,0) + axm = q_prim_vf(E_idx + 2)%sf(j-1,k,0) + ayp = q_prim_vf(E_idx + 2)%sf(j,k+1,0) + aym = q_prim_vf(E_idx + 2)%sf(j,k-1,0) + + if ((axp > 0.9 .and. axm < 0.9) .or. (axp < 0.9 .and. axm > 0.9)& + .or. (ayp > 0.9 .and. aym < 0.9) .or. (ayp < 0.9 .and. aym > 0.9)) then + if (counter == 0) then + counter = counter + 1 + x_d1(counter) = x_cc(j) + y_d1(counter) = y_cc(k) + else + do i = 1, counter + if (sqrt((x_cc(j)-x_d1(i))**2+(y_cc(k)-& + y_d1(i))**2) <= 2*sqrt(dx(j)**2& + +dy(k)**2)) then + cycle OLoop + elseif (sqrt((x_cc(j)-x_d1(i))**2+(y_cc(k)-& + y_d1(i))**2) > 2*sqrt(dx(j)**2& + +dy(k)**2) .and. i == counter) then + counter = counter + 1 + x_d1(counter) = x_cc(j) + y_d1(counter) = y_cc(k) + end if + end do + end if + end if + end do OLoop + end do + + allocate(y_d(counter)) + allocate(x_d(counter)) + do i = 1,counter + y_d(i) = y_d1(i) + x_d(i) = x_d1(i) + end do + if (num_procs > 1) then + call s_mpi_gather_data(x_d, counter, x_td, root) + call s_mpi_gather_data(y_d, counter, y_td, root) + if (proc_rank == 0) then + do i = 1, size(x_td) + if (i == size(x_td)) then + write(21519,'(F12.9,1X,F12.9,1X,I4, 1X, F12.9, 1X, F12.9)') & + x_td(i), y_td(i), size(x_td), xcom(2), nondim_time + else + write(21519,'(F12.9,1X,F12.9,1X,F3.1,1X,F3.1,1X,F3.1)') & + x_td(i), y_td(i), 0d0, 0d0, 0d0 + end if + end do + end if + end if + + end subroutine s_write_sim_data_file ! ----------------------------------- + + + subroutine s_calculate_numerical_schlieran(q_prim_vf, f_NS) + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + integer :: i, j, k, l + real(kind(0d0)), dimension(0:m,0:n), intent(OUT) :: f_NS + real(kind(0d0)), dimension(0:m,0:n) :: d_rho_mag, a, b, c, d, d_a_mag + real(kind(0d0)) :: rhoxp, rhoxm, rhoyp, rhoym, rhop, d_rhox, d_rhoy, mag_max + real(kind(0d0)) :: axp, axm, ayp, aym, ap, d_ax, d_ay, maga_max + + rhop = 0d0 + rhoxp = 0d0 + rhoxm = 0d0 + rhoyp = 0d0 + rhoym = 0d0 + ap = 0d0 + axp = 0d0 + axm = 0d0 + ayp = 0d0 + aym = 0d0 + + + do k = 0,n + do j = 0, m + do i = 1, num_fluids + rhop = rhop + q_prim_vf(i)%sf(j,k,0) + rhoxp = rhoxp + q_prim_vf(i)%sf(j+1,k,0) + rhoxm = rhoxm + q_prim_vf(i)%sf(j-1,k,0) + rhoyp = rhoyp + q_prim_vf(i)%sf(j,k+1,0) + rhoym = rhoym + q_prim_vf(i)%sf(j,k-1,0) + end do + ap = q_prim_vf(E_idx + 2)%sf(j,k,0) + axp = q_prim_vf(E_idx + 2)%sf(j+1,k,0) + axm = q_prim_vf(E_idx + 2)%sf(j-1,k,0) + ayp = q_prim_vf(E_idx + 2)%sf(j,k+1,0) + aym = q_prim_vf(E_idx + 2)%sf(j,k-1,0) + if (j == m) then + d_rhox = dabs((rhop-rhoxm)/(x_cc(j)-x_cc(j-1))) + d_ax = dabs((ap-axm)/(x_cc(j)-x_cc(j-1))) + else if (k == n) then + d_rhoy = dabs((rhop-rhoym)/(y_cc(k)-y_cc(k-1))) + d_ay = dabs((ap-aym)/(y_cc(k)-y_cc(k-1))) + else if (j == 0) then + d_rhox = dabs((rhoxp-rhop)/(x_cc(j+1)-x_cc(j))) + d_ax = dabs((axp-ap)/(x_cc(j+1)-x_cc(j))) + else if (k == 0) then + d_rhoy = dabs((rhoyp-rhop)/(y_cc(k+1)-y_cc(k))) + d_ay = dabs((ayp-ap)/(y_cc(k+1)-y_cc(k))) + else + d_rhox = dabs((rhoxp-rhoxm)/(x_cc(j+1)-x_cc(j-1))) + d_rhoy = dabs((rhoyp-rhoym)/(y_cc(k+1)-y_cc(k-1))) + d_ax = dabs((axp-axm)/(x_cc(j+1)-x_cc(j-1))) + d_ay = dabs((ayp-aym)/(y_cc(k+1)-y_cc(k-1))) + + end if + d_rho_mag(j,k) = dsqrt((d_rhox**2+d_rhoy**2)) + d_a_mag(j,k) = dsqrt((d_ax**2+d_ay**2)) + rhop = 0d0 + rhoxp = 0d0 + rhoxm = 0d0 + rhoyp = 0d0 + rhoym = 0d0 + ap = 0d0 + axp = 0d0 + axm = 0d0 + ayp = 0d0 + aym = 0d0 + end do + end do + + +! if (maxval(d_rho_mag) < 1/(100*maxval(dx)) .or. maxval(d_rho_mag) < 1/(100*maxval(dy))) then +! d_rho_mag(0:m,0:n) = 0d0 +! else +! d_rho_mag(0:m,0:n) = d_rho_mag(0:m,0:n)/maxval(d_rho_mag) +! end if + call s_mpi_allreduce_max(maxval(d_rho_mag),mag_max) + call s_mpi_allreduce_max(maxval(d_a_mag),maga_max) + ! print *, "d_rho_max =", mag_max + ! print*, "d_rho_mag =", d_rho_mag + d_rho_mag(0:m,0:n) = d_rho_mag(0:m,0:n)/mag_max + d_a_mag(0:m,0:n) = d_a_mag(0:m,0:n)/maga_max +! print*, d_rho_mag + a = 0.5 + b = 9 + c = 0.65 + d = 1 + ! f_NS(0:m,0:n) = d_a_mag(0:m,0:n)*(EXP(-b**2*(d_rho_mag(0:m,0:n)& + ! -d_a_mag(0:m,0:n))**2/(d_a_mag(0:m,0:n))**2)+ & + ! c*EXP(-b**2*(d_rho_mag(0:m,0:n)-(d_a_mag(0:m,0:n)-a))**2/& + ! (d_a_mag(0:m,0:n))**2)+d*d_rho_mag(0:m,0:n)/d_a_mag(0:m,0:n)*& + ! EXP(-b**2*(d_rho_mag(0:m,0:n)-(0.9))**2/(25**2*(d_a_mag(0:m,0:n))**2))) + + f_NS(0:m,0:n) = q_prim_vf(E_idx + 2)%sf(0:m,0:n,0)*(EXP(-b**2*(d_rho_mag(0:m,0:n)& + -q_prim_vf(E_idx + 2)%sf(0:m,0:n,0))**2/(q_prim_vf(E_idx + 2)%sf(0:m,0:n,0))**2)+ & + c*EXP(-b**2*(d_rho_mag(0:m,0:n)-(q_prim_vf(E_idx + 2)%sf(0:m,0:n,0)-a))**2/& + (q_prim_vf(E_idx + 2)%sf(0:m,0:n,0))**2)+d*d_rho_mag(0:m,0:n)/q_prim_vf(E_idx + 2)%sf(0:m,0:n,0)*& + EXP(-b**2*(d_rho_mag(0:m,0:n)-(0.9))**2/(25**2*(q_prim_vf(E_idx + 2)%sf(0:m,0:n,0))**2))) + + ! f_NS(0:m,0:n) = d*dsqrt(d_rho_mag(0:m,0:n))*& +! EXP(-b**2*(d_rho_mag(0:m,0:n)-(0.9))**2/(25**2*(q_prim_vf(E_idx + 2)%sf(0:m,0:n,0))**2)) +! f_NS(0:m,0:n) = d*(d_rho_mag(0:m,0:n)+d_a_mag(0:m,0:n))*& +! EXP(-b**2*(d_rho_mag(0:m,0:n)-(1+d_a_mag(0:m,0:n)))**2/(30**2*(d_a_mag(0:m,0:n))**2)) + + +!1-EXP(-(0.1+0.9*q_prim_vf(E_idx + 2)%sf(0:m,0:n, 0))*dsqrt(d_rho_mag(0:m,0:n))*q_prim_vf(E_idx + 2)%sf(0:m,0:n, 0)) + + + end subroutine s_calculate_numerical_schlieran + + + subroutine s_calculate_COM(q_prim_vf, xcom, ycom, vol_fluid) + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + integer :: i, j, k, l !< Generic loop iterators + real(kind(0d0)), dimension(num_fluids), intent(OUT) :: vol_fluid + real(kind(0d0)), dimension(num_fluids) :: ms, ym, xm, zm + real(kind(0d0)), dimension(num_fluids), intent(OUT) :: xcom, ycom + real(kind(0d0)) :: ybeg, xend, xbeg, zbeg, zend, tmp, dV, yend + + xm = 0d0 + ms = 0d0 + ym = 0d0 + ! zm = 0d0 + + do l = 0, p + do k = 0, n + do j = 0, m + if (p > 0) then + dV = dx(j)*dy(k)*dz(l) + else if (p == 0) then + dV = dx(j)*dy(k) + else if (n == 0) then + dV = dx(j) + end if + do i = 1, num_fluids + if (q_prim_vf(E_idx + i)%sf(j,k,l) .gt. 0.6) then + vol_fluid(i) = vol_fluid(i)+q_prim_vf(E_idx + i)%sf(j,k,l)*dV + end if + if (p > 0) then + ms(i) = ms(i) + q_prim_vf(i)%sf(j,k,l)*dV + xm(i) = xm(i) + q_prim_vf(i)%sf(j,k,l)*dV*x_cc(j) + ym(i) = ym(i) + q_prim_vf(i)%sf(j,k,l)*dV*y_cc(k) + ! zm(i) = zm(i) + q_prim_vf(i)%sf(j,k,l)*dV*z_cc(l) + else if (p == 0 .and.& + q_prim_vf(E_idx + 2)%sf(j,k,l) > 0.9) then + ms(i) = ms(i) + q_prim_vf(i)%sf(j,k,l)*dV + xm(i) = xm(i) + q_prim_vf(i)%sf(j,k,l)*dV*x_cc(j) + ym(i) = ym(i) + q_prim_vf(i)%sf(j,k,l)*dV*y_cc(k) + end if + end do + end do + end do + end do + do i = 1,num_fluids + if (num_procs > 1) then + tmp = vol_fluid(i) + call s_mpi_allreduce_sum(tmp, vol_fluid(i)) + if (p > 0) then + tmp = xm(i) + call s_mpi_allreduce_sum(tmp, xm(i)) + tmp = ym(i) + ! call s_mpi_allreduce_sum(tmp, ym(i)) + ! tmp = zm(i) + ! call s_mpi_allreduce_sum(tmp,zm(i)) + tmp = ms(i) + call s_mpi_allreduce_sum(tmp, ms(i)) + ! call s_mpi_allreduce_min(minval(x_cb(-1:m)), xbeg) + ! call s_mpi_allreduce_max(maxval(x_cb(-1:m)), xend) + ! call s_mpi_allreduce_min(minval(y_cb(-1:n)), ybeg) + ! call s_mpi_allreduce_max(maxval(y_cb(-1:n)), yend) + ! call s_mpi_allreduce_min(minval(z_cb(-1:p)), zbeg) + ! call s_mpi_allreduce_max(maxval(z_cb(-1:p)), zend) + else if (p == 0) then + tmp = xm(i) + call s_mpi_allreduce_sum(tmp, xm(i)) + tmp = ym(i) + ! call s_mpi_allreduce_sum(tmp, ym(i)) + tmp = ms(i) + call s_mpi_allreduce_sum(tmp, ms(i)) + ! call s_mpi_allreduce_min(minval(x_cb(-1:m)), xbeg) + ! call s_mpi_allreduce_max(maxval(x_cb(-1:m)), xend) + ! call s_mpi_allreduce_min(minval(y_cb(-1:n)), ybeg) + ! call s_mpi_allreduce_max(maxval(y_cb(-1:n)), yend) + end if + end if + + ! if (p > 1) then + ! xcom(i) = xm(i)/ms(i) + ycom(i) = 0d0 + ! zcom(i) = zm(i)/ms(i) + ! if (bc_x_glb%beg == -2) then +! ms(i) = 2*ms(i) + ! xcom(i) = xbeg + ! else if (bc_x_glb%end == -2) then +! ms(i) = 2*ms(i) +! xcom(i) = xend +! else if (bc_y_glb%beg == -2) then +! ms(i) = 2*ms(i) +! ycom(i) = ybeg +! else if (bc_y_glb%end == -2) then +! ms(i) = 2*ms(i) +! ycom(i) = yend + ! else if (bc_z_glb%beg == -2) then + ! ms(i) = 2*ms(i) + ! zcom(i) = zbeg + ! else if (bc_z_glb%end == -2) then + ! ms(i) = 2*ms(i) + ! zcom(i) = zend + ! end if + ! else if (p == 0) then + xcom(i) = xm(i)/ms(i) + ! ycom(i) = ym(i)/ms(i) + ! if (bc_x_glb%beg == -2) then + ! ms(i) = 2*ms(i) + ! xcom(i) = xbeg + ! else if (bc_x_glb%end == -2) then + ! ms(i) = 2*ms(i) + ! xcom(i) = xend + ! else if (bc_y_glb%beg == -2) then + ! ms(i) = 2*ms(i) + ! ycom(i) = ybeg + ! else if (bc_y_glb%end == -2) then + ! ms(i) = 2*ms(i) + ! ycom(i) = yend + ! end if + ! end if + end do + + end subroutine s_calculate_COM + + + !> The goal of this subroutine is to output the grid and !! conservative variables data files for given time-step. !! @param q_cons_vf Cell-average conservative variables @@ -1113,7 +1463,7 @@ contains logical :: trigger !< For integral quantities ! Non-dimensional time calculation - if (time_stepper == 23) then + if (time_stepper == 23) then nondim_time = mytime else if (t_step_old /= dflt_int) then @@ -1272,12 +1622,12 @@ contains call s_convert_to_mixture_variables(q_cons_vf, j - 2, k - 2, l, & rho, gamma, pi_inf, qv, & Re, G, fluid_pp(:)%G) - do s = 1, num_dims + do s = 1, num_dims vel(s) = q_cons_vf(cont_idx%end + s)%sf(j - 2, k - 2, l)/rho end do call s_compute_pressure( & - q_cons_vf(1)%sf(j - 2, k - 2, l), & + q_cons_vf(E_idx)%sf(j - 2, k - 2, l), & q_cons_vf(alf_idx)%sf(j - 2, k - 2, l), & 0.5d0*(q_cons_vf(2)%sf(j - 2, k - 2, l)**2.d0)/ & q_cons_vf(1)%sf(j - 2, k - 2, l), & @@ -1311,15 +1661,13 @@ contains R(:) = nR(:)/nbub Rdot(:) = nRdot(:)/nbub end if - ! Compute mixture sound speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & - ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) + ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) - accel = accel_mag(j - 2, k - 2, l) end if end if - else ! 3D simulation + else ! 3D f (t_step == t_step_stop)simulation if ((probe(i)%x >= x_cb(-1)) .and. (probe(i)%x <= x_cb(m))) then if ((probe(i)%y >= y_cb(-1)) .and. (probe(i)%y <= y_cb(n))) then if ((probe(i)%z >= z_cb(-1)) .and. (probe(i)%z <= z_cb(p))) then @@ -1362,7 +1710,6 @@ contains end if end if end if - if (num_procs > 1) then #:for VAR in ['rho','pres','gamma','pi_inf','qv','c','accel'] tmp = ${VAR}$ @@ -1395,8 +1742,7 @@ contains end do end if end if - - if (proc_rank == 0) then + if (proc_rank == 0) then if (n == 0) then if (bubbles .and. (num_fluids <= 2)) then if (qbmm) then @@ -1499,6 +1845,7 @@ contains rho, & vel(1), & pres + print*, 'time =', nondim_time, 'rho =', rho, 'pres =', pres end if else write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,'// & @@ -1686,6 +2033,7 @@ contains end subroutine s_close_run_time_information_file ! --------------------- + !> Closes communication files subroutine s_close_com_files() ! --------------------------------------- @@ -1696,6 +2044,23 @@ contains end subroutine s_close_com_files ! ------------------------------------- + subroutine s_close_sim_data_file() ! ----------------------- + + + ! Writing the footer of and closing the run-time information file + write (21519, '(A)') '----------------------------------------'// & + '----------------------------------------' + write (21519, '(A)') '' + write (21519, '(A)') '' + write (21519, '(A)') '========================================'// & + '========================================' + close (21519) + + end subroutine s_close_sim_data_file !--------------------- + + + + !> Closes probe files subroutine s_close_probe_files() ! ------------------------------------- diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index de9801e568..e1c5614d8c 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -94,7 +94,6 @@ subroutine s_initialize_derived_variables() ! ----------------------------- call s_open_probe_files() call s_open_com_files() end if - ! Computing centered finite difference coefficients call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & fd_number, fd_order) @@ -108,14 +107,21 @@ subroutine s_initialize_derived_variables() ! ----------------------------- fd_number, fd_order) end if end if + + if (sim_data .and. proc_rank == 0) then + call s_open_sim_data_file() + end if + end subroutine s_initialize_derived_variables ! ----------------------------- !> Writes coherent body information, communication files, and probes. !! @param t_step Current time-step - subroutine s_compute_derived_variables(t_step) ! ----------------------- + subroutine s_compute_derived_variables(q_prim_vf, t_step) ! ----------------------- integer, intent(IN) :: t_step + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + integer :: i, j, k !< Generic loop iterators if (probe_wrt) then @@ -159,6 +165,9 @@ subroutine s_compute_derived_variables(t_step) ! ----------------------- call s_write_probe_files(t_step, q_cons_ts(1)%vf, accel_mag) call s_write_com_files(t_step,c_mass) end if + if (sim_data) then + call s_write_sim_data_file(q_prim_vf, t_step) + endif end subroutine s_compute_derived_variables ! --------------------------- @@ -461,6 +470,13 @@ subroutine s_finalize_derived_variables_module() ! ------------------- end if end if + if (proc_rank == 0) then + if (sim_data) then + call s_close_sim_data_file() + end if + end if + + if (probe_wrt) then deallocate (accel_mag, x_accel) if (n > 0) then diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 18b3702c00..613433c232 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -34,6 +34,7 @@ module m_global_parameters integer :: num_procs !< Number of processors character(LEN=path_len) :: case_dir !< Case folder location logical :: run_time_info !< Run-time output flag + logical :: sim_data !< Simulation data output flag integer :: t_step_old !< Existing IC/grid folder ! ========================================================================== @@ -343,6 +344,7 @@ contains ! Logistics case_dir = '.' run_time_info = .false. + sim_data = .false. t_step_old = dflt_int ! Computational domain parameters diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index c165401f4e..a38df6b55f 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -111,6 +111,39 @@ contains !! available to the other processors. Then, the purpose of !! this subroutine is to distribute the user inputs to the !! remaining processors in the communicator. + + subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root) + +#ifdef MFC_MPI + + implicit none + integer, intent(in) :: counts ! Array of vector lengths for each process + real(kind(0d0)), intent(in), dimension(counts) :: my_vector ! Input vector on each process + integer, intent(in) :: root ! Rank of the root process + real(kind(0d0)), allocatable, intent(out) :: gathered_vector(:) ! Gathered vector on the root process + + integer :: i, offset, ierr + integer, allocatable :: recounts(:), displs(:) + + allocate(recounts(num_procs)) + + call MPI_GATHER(counts, 1, MPI_INTEGER, recounts, 1, MPI_INTEGER, root, & + MPI_COMM_WORLD, ierr) + + allocate(displs(size(recounts))) + + displs(1) = 0 + + do i = 2,size(recounts) + displs(i) = displs(i-1) + recounts(i-1) + end do + + allocate(gathered_vector(sum(recounts))) + call MPI_GATHERV(my_vector, counts, MPI_DOUBLE_PRECISION, gathered_vector,recounts, displs, MPI_DOUBLE_PRECISION, & + root, MPI_COMM_WORLD, ierr) +#endif + end subroutine s_mpi_gather_data + subroutine s_mpi_bcast_user_inputs() ! --------------------------------- #ifdef MFC_MPI @@ -129,7 +162,7 @@ contains call MPI_BCAST(${VAR}$, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) #:endfor - #:for VAR in [ 'run_time_info','cyl_coord', 'adv_alphan', 'mpp_lim', & + #:for VAR in [ 'run_time_info','sim_data','cyl_coord', 'adv_alphan', 'mpp_lim', & & 'mapped_weno', 'mp_weno', 'cu_mpi', 'weno_flat', 'riemann_flat', & & 'weno_Re_flux', 'alt_soundspeed', 'null_weights', 'mixture_err', & & 'parallel_io', 'hypoelasticity', 'bubbles', 'polytropic', & diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index d76dcbc8a0..c66915a1af 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -1852,7 +1852,7 @@ contains end do ! END: Dimensional Splitting Loop ================================= - if (run_time_info .or. probe_wrt) then + if (run_time_info .or. probe_wrt .or. sim_data) then ix%beg = -buff_size; iy%beg = 0; iz%beg = 0 if (n > 0) iy%beg = -buff_size; diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index cfdf4ebd5f..63553ac949 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -122,7 +122,7 @@ contains character(len=1000) :: line ! Namelist of the global parameters which may be specified by user - namelist /user_inputs/ case_dir, run_time_info, m, n, p, dt, & + namelist /user_inputs/ case_dir, run_time_info, sim_data, m, n, p, dt, & t_step_start, t_step_stop, t_step_save, & model_eqns, num_fluids, adv_alphan, & mpp_lim, time_stepper, weno_eps, weno_flat, & @@ -895,7 +895,7 @@ contains end do end if - call s_compute_derived_variables(t_step) + call s_compute_derived_variables(q_prim_vf,t_step) #ifdef DEBUG print *, 'Computed derived vars' @@ -915,7 +915,7 @@ contains ! Time-stepping loop controls if ((mytime + dt) >= finaltime) dt = finaltime - mytime t_step = t_step + 1 - + end subroutine s_perform_time_step subroutine s_save_performance_metrics(t_step, time_avg, time_final, io_time_avg, io_time_final, proc_time, io_proc_time, file_exists, start, finish, nt) diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index fc1e1065f3..23fc3e497e 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -211,9 +211,9 @@ contains ! Opening and writing the header of the run-time information file if (proc_rank == 0 .and. run_time_info) then - call s_open_run_time_information_file() + call s_open_run_time_information_file() end if - + end subroutine s_initialize_time_steppers_module ! --------------------- !> 1st order TVD RK time-stepping algorithm diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index 3f0e885c81..106be3f9dc 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -36,7 +36,6 @@ program p_main !Initialize MPI call s_initialize_mpi_domain() - !Initialize Modules call s_initialize_modules() @@ -56,7 +55,7 @@ program p_main ! Time-stepping Loop ======================================================= do - if (t_step == t_step_stop) then + if (t_step > t_step_stop) then call s_save_performance_metrics(t_step, time_avg, time_final, io_time_avg, & io_time_final, proc_time, io_proc_time, file_exists, start, finish, nt) exit @@ -65,7 +64,7 @@ program p_main call s_perform_time_step(t_step, time_avg, time_final, io_time_avg, io_time_final, & proc_time, io_proc_time, file_exists, start, finish, nt) - if (mod(t_step - t_step_start, t_step_save) == 0 .or. t_step == t_step_stop) then + if (mod(t_step - t_step_start, t_step_save) == 0 .or. t_step > t_step_stop) then call s_save_data(t_step, start, finish, io_time_avg, nt) end if diff --git a/toolchain/mfc/bench.py b/toolchain/mfc/bench.py index f2429e4c01..605d023bfc 100644 --- a/toolchain/mfc/bench.py +++ b/toolchain/mfc/bench.py @@ -13,7 +13,7 @@ class BenchCase: slug: str path: str - args: list[str] + #args: list[str] def bench(targets = None): diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index a12cc858fa..065458793f 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -34,8 +34,9 @@ "mu_v", "k_v", "G", "cv", "qv", "qvp" ]: PRE_PROCESS.append(f"fluid_pp({f_id})%{attribute}") -for p_id in range(1, 10+1): - for attribute in ["geometry", "radius", "radii", "epsilon", "beta", +for p_id in range(1, 10+4): + for attribute in ["geometry", "radius", "radii", "epsilon", "beta", "a2", + "a3", "a4", "a5", "a6", "a7","a8", "a9", "a10", "a11", "a12", 'non_axis_sym', "normal", "smoothen", "smooth_patch_id", "alpha_rho", "smooth_coeff", "rho", "vel", "pres", "alpha", "gamma", "pi_inf", "r0", "v0", "p0", "m0", "hcid", "cv", "qv", "qvp" ]: @@ -72,7 +73,7 @@ SIMULATION = COMMON + [ - 'run_time_info', 't_step_old', 't_tol', 'dt', 't_step_start', + 'run_time_info', 'sim_data', 't_step_old', 't_tol', 'dt', 't_step_start', 't_step_stop', 't_step_save', 'time_stepper', 'weno_eps', 'mapped_weno', 'mp_weno', 'weno_avg', 'weno_Re_flux', 'riemann_solver', 'wave_speeds', 'avg_state', 'prim_vars_wrt', diff --git a/trial1.sh b/trial1.sh new file mode 100755 index 0000000000..e5e5bf08e2 --- /dev/null +++ b/trial1.sh @@ -0,0 +1,40 @@ +# Pre_process + +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/invp_sod24/2Dshinputsod24.py -b mpirun -e batch -p wholenode -w 00:05:00 -# sod24 -a mch220010 -N 2 -n 128 -t pre_process +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod18/2Dshinputsod18.py -b mpirun -e batch -p wholenode -w 00:05:00 -# sod18 -a mch220010 -N 2 -n 128 -t pre_process +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod20/2Dshinputsod20.py -b mpirun -e batch -p wholenode -w 00:05:00 -# sod20 -a mch220010 -N 2 -n 128 -t pre_process +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod28/2Dshinputsod28.py -b mpirun -e batch -p wholenode -w 00:05:00 -# sod28 -a mch220010 -N 2 -n 128 -t pre_process +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod32/2Dshinputsod32.py -b mpirun -e batch -p wholenode -w 00:05:00 -# sod32 -a mch220010 -N 2 -n 128 -t pre_process +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod22/2Dshinputsod22.py -b mpirun -e batch -p wholenode -w 00:05:00 -# sod22 -a mch220010 -N 2 -n 128 -t pre_process +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod48/2Dshinputsod48.py -b mpirun -e batch -p wholenode -w 00:05:00 -# sod48 -a mch220010 -N 2 -n 128 -t pre_process +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod24/2Dshinputsod24.py -b mpirun -e batch -p wholenode -w 00:05:00 -# sod24 -a mch220010 -N 2 -n 128 -t pre_process + + + + + + + +# simulation +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/invp_sod24/2Dshinputsod24.py -b mpirun -e batch -p wholenode -w 01:00:00 -# sod24 -a mch220010 -N 2 -n 128 -t simulation +# +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod24/2Dshinputsod24.py -b mpirun -e batch -p wholenode -w 01:15:00 -# sod24 -a mch220010 -N 2 -n 128 -t simulation +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod18/2Dshinputsod18.py -b mpirun -e batch -p wholenode -w 01:30:00 -# sod18 -a mch220010 -N 2 -n 128 -t simulation +./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod20/2Dshinputsod20.py -b mpirun -e batch -p wholenode -w 01:15:00 -# sod20 -a mch220010 -N 2 -n 128 -t simulation +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod28/2Dshinputsod28.py -b mpirun -e batch -p wholenode -w 01:15:00 -# sod28 -a mch220010 -N 2 -n 128 -t simulation +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod32/2Dshinputsod32.py -b mpirun -e batch -p wholenode -w 01:15:00 -# sod32 -a mch220010 -N 2 -n 128 -t simulation +./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod22/2Dshinputsod22.py -b mpirun -e batch -p wholenode -w 01:15:00 -# sod22 -a mch220010 -N 2 -n 128 -t simulation +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod48/2Dshinputsod48.py -b mpirun -e batch -p wholenode -w 01:30:00 -# sod48 -a mch220010 -N 2 -n 128 -t simulation + + + +# post_processn + +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod18/2Dshinputsod18.py -b mpirun -e batch -p debug -w 00:05:00 -# sod18 -a mch220010 -N 2 -n 128 -t post_process + +./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod24/2Dshinputsod24.py -b mpirun -e batch -p wholenode -w 00:10:00 -# sod24 -a mch220010 -N 2 -n 128 -t post_process +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod32/2Dshinputsod32.py -b mpirun -e batch -p wholenode -w 00:45:00 -# sod32 -a mch220010 -N 2 -n 128 -t post_process +#./mfc.sh run ~/../../anvil/scratch/x-sremillard/invp_sod24_btr/2Dshinputsod24.py -b mpirun -e batch -p wholenode -w 00:25:00 -# sod24 -a mch220010 -N 2 -n 128 -t post_process +# + + From 357d40fe22827c1e3cb422a7c7def64aad9e9f8b Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Thu, 8 Feb 2024 10:33:27 -0500 Subject: [PATCH 016/380] all spherical capabilities added and tested --- 2Dshinputsod1.5.py | 164 --------------------------------------------- 2Dshinputsod18.py | 164 --------------------------------------------- trial1.sh | 40 ----------- 3 files changed, 368 deletions(-) delete mode 100755 2Dshinputsod1.5.py delete mode 100755 2Dshinputsod18.py delete mode 100755 trial1.sh diff --git a/2Dshinputsod1.5.py b/2Dshinputsod1.5.py deleted file mode 100755 index c0747e9839..0000000000 --- a/2Dshinputsod1.5.py +++ /dev/null @@ -1,164 +0,0 @@ -import math -import json - -Ri = 1.0E-01 -Rc = Ri -Rin = Ri/Rc -rhol = 1000 -rhog = 1 -rhoc = rhol -rholn = rhol/rhoc -rhogn = rhog/rhoc -Pb = 3550 -Pl = 5.0E+06 -delta_P = Pl-Pb -tc = 0.915*Ri*(rhol/delta_P)**(0.5) -mulc = 9E-04 -mubc = 1.0E-05 -uc = Ri/tc -Pc = rhoc*uc**(2) -Pln = Pl/Pc -Pbn = Pb/Pc -tcn = tc/tc -CFL = 0.2 -sod = 24/16 -leng = Rin*(3+sod) -PpBr = 256 -Nx = PpBr*leng -Ny = Nx -x_end = leng -y_end = leng -x_beg = 0.0 -y_beg = 0.0 -Pi_inf_l = 702.8E+06 -Pi_inf_b = 0.0E+00 -nl = 1.47 -nb = 1.19 -bl = 6.61E-04 -bb = 0.0E+00 -cl = (nl*(Pl+Pi_inf_l)/(rhol*(1-rhol*bl)))**(0.5) -clc = cl/uc -delta_x = leng/Nx -delta_t = CFL*delta_x/clc -Nt = int(1.255555*tcn/delta_t) -alpha1 = 1.0 -alpha2 = 1.0 -x_centroidl = (x_end-x_beg)/2.0 -y_centroidl = (y_end-y_beg)/2.0 -x_centroidb = sod -y_centroidb = 0.0E+00 -Rel = rhol*uc*2*Rin/mulc -Reb = rhog*uc*2*Rin/mubc - - -# Configuring case dictionary -print(json.dumps({ - # Logistics ================================================ - 'run_time_info' : 'T', - 'sim_data' : 'T', - # ========================================================== - - # Computational Domain Parameters ========================== - 'x_domain%beg' : x_beg, - 'x_domain%end' : x_end, - 'y_domain%beg' : y_beg, - 'y_domain%end' : y_end, - 'm' : int(Nx), - 'n' : int(Ny), - 'p' : 0, - 'cyl_coord' : 'T', - 'dt' : delta_t, - 't_step_start' : 0, - 't_step_stop' : Nt, - 't_step_save' : int(Nt/360), -# ========================================================== - - # Simulation Algorithm Parameters ========================== - 'num_patches' : 2, - 'model_eqns' : 2, - 'alt_soundspeed' : 'F', - 'num_fluids' : 2, - 'adv_alphan' : 'T', - 'mpp_lim' : 'F', - 'mixture_err' : 'F', - 'time_stepper' : 3, - 'weno_order' : 5, - 'weno_eps' : 1.E-32, - 'mapped_weno' : 'T', - 'null_weights' : 'F', - 'mp_weno' : 'F', - 'weno_Re_flux' : 'F', - 'riemann_solver' : 2, - 'wave_speeds' : 1, - 'avg_state' : 2, - 'bc_x%beg' : -5, - 'bc_x%end' : -6, - 'bc_y%beg' : -2, - 'bc_y%end' : -6, - # ========================================================== - - # Formatted Database Files Structure Parameters ============ - 'format' : 1, - 'precision' : 2, - 'prim_vars_wrt' :'T', - 'parallel_io' :'T', - 'fd_order' :'1', - 'probe_wrt' :'T', - 'num_probes' : 1, - 'probe(1)%x' : 0., - 'probe(1)%y' : 0., - # ========================================================== - - # Patch 1: Background ============================ - 'patch_icpp(1)%geometry' : 3, - 'patch_icpp(1)%x_centroid' : x_centroidl, - 'patch_icpp(1)%y_centroid' : y_centroidl, - 'patch_icpp(1)%length_x' : leng, - 'patch_icpp(1)%length_y' : leng, - 'patch_icpp(1)%vel(1)' : 0.E+00, - 'patch_icpp(1)%vel(2)' : 0.E+00, - 'patch_icpp(1)%pres' : Pln, - 'patch_icpp(1)%alpha_rho(1)' : alpha1*rholn, - 'patch_icpp(1)%alpha_rho(2)' : 0.0E+00, - 'patch_icpp(1)%alpha(1)' : alpha1, - 'patch_icpp(1)%alpha(2)' : 0.0E+00, - # ========================================================== - # Patch 2: Bubble ====================================== - 'patch_icpp(2)%geometry' : 14, - 'patch_icpp(2)%x_centroid' : x_centroidb, - 'patch_icpp(2)%y_centroid' : y_centroidb, - 'patch_icpp(2)%radius' : Rin, - 'patch_icpp(2)%non_axis_sym' : 'T', - 'patch_icpp(2)%a2' : 0.0, - 'patch_icpp(2)%a3' : 0.0, - 'patch_icpp(2)%a4' : 0.0, - 'patch_icpp(2)%a5' : 0.0, - 'patch_icpp(2)%a6' : 0.0, - 'patch_icpp(2)%a7' : 0.0, - 'patch_icpp(2)%a8' : 0.0, - 'patch_icpp(2)%a9' : 0.0, - 'patch_icpp(2)%a10' : 0.0, - 'patch_icpp(2)%a11' : 0.0, - 'patch_icpp(2)%a12' : 0.0, - 'patch_icpp(2)%alter_patch(1)' : 'T', - 'patch_icpp(2)%vel(1)' : 0.E+00, - 'patch_icpp(2)%vel(2)' : 0.E+00, - 'patch_icpp(2)%pres' : Pbn, - 'patch_icpp(2)%alpha_rho(1)' : 0.0E+00, - 'patch_icpp(2)%alpha_rho(2)' : alpha2*rhogn, - 'patch_icpp(2)%alpha(1)' : 0.0E+00, - 'patch_icpp(2)%alpha(2)' : alpha2, - # ========================================================== - - # Fluids Physical Parameters =============================== - 'fluid_pp(1)%gamma' : nl, - 'fluid_pp(1)%pi_inf' : Pi_inf_l/Pc, - 'fluid_pp(2)%gamma' : nb, - 'fluid_pp(2)%pi_inf' : Pi_inf_b/Pc, - 'fluid_pp(1)%Re(1)' : Rel, - 'fluid_pp(2)%Re(1)' : Reb, - # ========================================================== -})) - -# ============================================================================== - diff --git a/2Dshinputsod18.py b/2Dshinputsod18.py deleted file mode 100755 index 040f464874..0000000000 --- a/2Dshinputsod18.py +++ /dev/null @@ -1,164 +0,0 @@ -import math -import json - -Ri = 1.0E-01 -Rc = Ri -Rin = Ri/Rc -rhol = 1000 -rhog = 1 -rhoc = rhol -rholn = rhol/rhoc -rhogn = rhog/rhoc -Pb = 3550 -Pl = 5.0E+06 -delta_P = Pl-Pb -tc = 0.915*Ri*(rhol/delta_P)**(0.5) -mulc = 9E-04 -mubc = 1.0E-05 -uc = Ri/tc -Pc = rhoc*uc**(2) -Pln = Pl/Pc -Pbn = Pb/Pc -tcn = tc/tc -CFL = 0.2 -sod = 18/16 -leng = 4.5 -PpBr = 256 -Nx = PpBr*leng -Ny = Nx -x_end = leng -y_end = leng -x_beg = 0.0 -y_beg = 0.0 -Pi_inf_l = 702.8E+06 -Pi_inf_b = 0.0E+00 -nl = 1.47 -nb = 1.19 -bl = 6.61E-04 -bb = 0.0E+00 -cl = (nl*(Pl+Pi_inf_l)/(rhol*(1-rhol*bl)))**(0.5) -clc = cl/uc -delta_x = leng/Nx -delta_t = CFL*delta_x/clc -Nt = int(1.255555*tcn/delta_t) -alpha1 = 1.0 -alpha2 = 1.0 -x_centroidl = (x_end-x_beg)/2.0 -y_centroidl = (y_end-y_beg)/2.0 -x_centroidb = sod -y_centroidb = 0.0E+00 -Rel = rhol*uc*2*Rin/mulc -Reb = rhog*uc*2*Rin/mubc - - -# Configuring case dictionary -print(json.dumps({ - # Logistics ================================================ - 'run_time_info' : 'T', - 'sim_data' : 'T', - # ========================================================== - - # Computational Domain Parameters ========================== - 'x_domain%beg' : x_beg, - 'x_domain%end' : x_end, - 'y_domain%beg' : y_beg, - 'y_domain%end' : y_end, - 'm' : int(Nx), - 'n' : int(Ny), - 'p' : 0, - 'cyl_coord' : 'T', - 'dt' : delta_t, - 't_step_start' : 0, - 't_step_stop' : Nt, - 't_step_save' : int(Nt/360), -# ========================================================== - - # Simulation Algorithm Parameters ========================== - 'num_patches' : 2, - 'model_eqns' : 2, - 'alt_soundspeed' : 'F', - 'num_fluids' : 2, - 'adv_alphan' : 'T', - 'mpp_lim' : 'T', - 'mixture_err' : 'T', - 'time_stepper' : 3, - 'weno_order' : 5, - 'weno_eps' : 1.E-16, - 'mapped_weno' : 'T', - 'null_weights' : 'F', - 'mp_weno' : 'F', - 'weno_Re_flux' : 'F', - 'riemann_solver' : 2, - 'wave_speeds' : 1, - 'avg_state' : 2, - 'bc_x%beg' : -5, - 'bc_x%end' : -6, - 'bc_y%beg' : -2, - 'bc_y%end' : -6, - # ========================================================== - - # Formatted Database Files Structure Parameters ============ - 'format' : 1, - 'precision' : 2, - 'prim_vars_wrt' :'T', - 'parallel_io' :'T', - 'fd_order' :'1', - 'probe_wrt' :'T', - 'num_probes' : 1, - 'probe(1)%x' : 0., - 'probe(1)%y' : 0., - # ========================================================== - - # Patch 1: Background ============================ - 'patch_icpp(1)%geometry' : 3, - 'patch_icpp(1)%x_centroid' : x_centroidl, - 'patch_icpp(1)%y_centroid' : y_centroidl, - 'patch_icpp(1)%length_x' : leng, - 'patch_icpp(1)%length_y' : leng, - 'patch_icpp(1)%vel(1)' : 0.E+00, - 'patch_icpp(1)%vel(2)' : 0.E+00, - 'patch_icpp(1)%pres' : Pln, - 'patch_icpp(1)%alpha_rho(1)' : alpha1*rholn, - 'patch_icpp(1)%alpha_rho(2)' : 0.0E+00, - 'patch_icpp(1)%alpha(1)' : alpha1, - 'patch_icpp(1)%alpha(2)' : 0.0E+00, - # ========================================================== - # Patch 2: Bubble ====================================== - 'patch_icpp(2)%geometry' : 14, - 'patch_icpp(2)%x_centroid' : x_centroidb, - 'patch_icpp(2)%y_centroid' : y_centroidb, - 'patch_icpp(2)%radius' : Rin, - 'patch_icpp(2)%non_axis_sym' : 'T', - 'patch_icpp(2)%a2' : 0.0, - 'patch_icpp(2)%a3' : 0.0, - 'patch_icpp(2)%a4' : 0.0, - 'patch_icpp(2)%a5' : 0.0, - 'patch_icpp(2)%a6' : 0.0, - 'patch_icpp(2)%a7' : 0.0, - 'patch_icpp(2)%a8' : 0.0, - 'patch_icpp(2)%a9' : 0.0, - 'patch_icpp(2)%a10' : 0.0, - 'patch_icpp(2)%a11' : 0.0, - 'patch_icpp(2)%a12' : 0.0, - 'patch_icpp(2)%alter_patch(1)' : 'T', - 'patch_icpp(2)%vel(1)' : 0.E+00, - 'patch_icpp(2)%vel(2)' : 0.E+00, - 'patch_icpp(2)%pres' : Pbn, - 'patch_icpp(2)%alpha_rho(1)' : 0.0E+00, - 'patch_icpp(2)%alpha_rho(2)' : alpha2*rhogn, - 'patch_icpp(2)%alpha(1)' : 0.0E+00, - 'patch_icpp(2)%alpha(2)' : alpha2, - # ========================================================== - - # Fluids Physical Parameters =============================== - 'fluid_pp(1)%gamma' : nl, - 'fluid_pp(1)%pi_inf' : Pi_inf_l/Pc, - 'fluid_pp(2)%gamma' : nb, - 'fluid_pp(2)%pi_inf' : Pi_inf_b/Pc, - 'fluid_pp(1)%Re(1)' : Rel, - 'fluid_pp(2)%Re(1)' : Reb, - # ========================================================== -})) - -# ============================================================================== - diff --git a/trial1.sh b/trial1.sh deleted file mode 100755 index e5e5bf08e2..0000000000 --- a/trial1.sh +++ /dev/null @@ -1,40 +0,0 @@ -# Pre_process - -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/invp_sod24/2Dshinputsod24.py -b mpirun -e batch -p wholenode -w 00:05:00 -# sod24 -a mch220010 -N 2 -n 128 -t pre_process -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod18/2Dshinputsod18.py -b mpirun -e batch -p wholenode -w 00:05:00 -# sod18 -a mch220010 -N 2 -n 128 -t pre_process -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod20/2Dshinputsod20.py -b mpirun -e batch -p wholenode -w 00:05:00 -# sod20 -a mch220010 -N 2 -n 128 -t pre_process -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod28/2Dshinputsod28.py -b mpirun -e batch -p wholenode -w 00:05:00 -# sod28 -a mch220010 -N 2 -n 128 -t pre_process -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod32/2Dshinputsod32.py -b mpirun -e batch -p wholenode -w 00:05:00 -# sod32 -a mch220010 -N 2 -n 128 -t pre_process -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod22/2Dshinputsod22.py -b mpirun -e batch -p wholenode -w 00:05:00 -# sod22 -a mch220010 -N 2 -n 128 -t pre_process -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod48/2Dshinputsod48.py -b mpirun -e batch -p wholenode -w 00:05:00 -# sod48 -a mch220010 -N 2 -n 128 -t pre_process -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod24/2Dshinputsod24.py -b mpirun -e batch -p wholenode -w 00:05:00 -# sod24 -a mch220010 -N 2 -n 128 -t pre_process - - - - - - - -# simulation -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/invp_sod24/2Dshinputsod24.py -b mpirun -e batch -p wholenode -w 01:00:00 -# sod24 -a mch220010 -N 2 -n 128 -t simulation -# -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod24/2Dshinputsod24.py -b mpirun -e batch -p wholenode -w 01:15:00 -# sod24 -a mch220010 -N 2 -n 128 -t simulation -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod18/2Dshinputsod18.py -b mpirun -e batch -p wholenode -w 01:30:00 -# sod18 -a mch220010 -N 2 -n 128 -t simulation -./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod20/2Dshinputsod20.py -b mpirun -e batch -p wholenode -w 01:15:00 -# sod20 -a mch220010 -N 2 -n 128 -t simulation -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod28/2Dshinputsod28.py -b mpirun -e batch -p wholenode -w 01:15:00 -# sod28 -a mch220010 -N 2 -n 128 -t simulation -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod32/2Dshinputsod32.py -b mpirun -e batch -p wholenode -w 01:15:00 -# sod32 -a mch220010 -N 2 -n 128 -t simulation -./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod22/2Dshinputsod22.py -b mpirun -e batch -p wholenode -w 01:15:00 -# sod22 -a mch220010 -N 2 -n 128 -t simulation -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod48/2Dshinputsod48.py -b mpirun -e batch -p wholenode -w 01:30:00 -# sod48 -a mch220010 -N 2 -n 128 -t simulation - - - -# post_processn - -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod18/2Dshinputsod18.py -b mpirun -e batch -p debug -w 00:05:00 -# sod18 -a mch220010 -N 2 -n 128 -t post_process - -./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod24/2Dshinputsod24.py -b mpirun -e batch -p wholenode -w 00:10:00 -# sod24 -a mch220010 -N 2 -n 128 -t post_process -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/sod32/2Dshinputsod32.py -b mpirun -e batch -p wholenode -w 00:45:00 -# sod32 -a mch220010 -N 2 -n 128 -t post_process -#./mfc.sh run ~/../../anvil/scratch/x-sremillard/invp_sod24_btr/2Dshinputsod24.py -b mpirun -e batch -p wholenode -w 00:25:00 -# sod24 -a mch220010 -N 2 -n 128 -t post_process -# - - From 237079941787664a354eb7ed6ab48951487ecf29 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 19 Feb 2024 21:21:15 -0600 Subject: [PATCH 017/380] merged with source --- src/common/m_derived_types.fpp | 4 +- src/pre_process/m_check_patches.fpp | 40 +- src/pre_process/m_global_parameters.fpp | 1 - src/pre_process/m_initial_condition.fpp | 4 +- src/pre_process/m_mpi_proxy.fpp | 2 +- src/pre_process/m_patches.fpp | 301 +++++----- src/simulation/m_data_output.fpp | 728 ++++++++++++------------ src/simulation/m_derived_variables.f90 | 276 +++++---- src/simulation/m_mpi_proxy.fpp | 40 +- src/simulation/m_time_steppers.fpp | 4 +- src/simulation/p_main.fpp | 2 +- 11 files changed, 687 insertions(+), 715 deletions(-) diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index 58b1842b7c..97c03830cf 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -144,12 +144,12 @@ module m_derived_types real(kind(0d0)) :: epsilon, beta !< !! The isentropic vortex parameters administrating, respectively, both !! the amplitude of the disturbance as well as its domain of influence. - + real(kind(0d0)) :: a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 !< !! The parameters needed for the spherical harmonic patch logical :: non_axis_sym - + real(kind(0d0)), dimension(3) :: normal !< !! Normal vector indicating the orientation of the patch. It is specified !! through its x-, y- and z-components, respectively. diff --git a/src/pre_process/m_check_patches.fpp b/src/pre_process/m_check_patches.fpp index dd8bda0597..72452ba6d3 100644 --- a/src/pre_process/m_check_patches.fpp +++ b/src/pre_process/m_check_patches.fpp @@ -420,31 +420,31 @@ contains ! Constraints on the geometric parameters of the spherical harmonic patch - if (p > 0) then + if (p > 0) then if (n == 0 .or. patch_icpp(patch_id)%radius <= 0d0 & - .or. & - patch_icpp(patch_id)%x_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%y_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%z_centroid == dflt_real) then + .or. & + patch_icpp(patch_id)%x_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%y_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%z_centroid == dflt_real) then - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of spherical '// & - 'harmonic patch '//trim(iStr)//'. Exiting ...') + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'geometric parameters of spherical '// & + 'harmonic patch '//trim(iStr)//'. Exiting ...') - end if + end if else if (p == 0) then - if (n == 0 .or. p > 0 .or. patch_icpp(patch_id)%radius <= 0d0 & - .or. & - patch_icpp(patch_id)%x_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%y_centroid == dflt_real) then + if (n == 0 .or. p > 0 .or. patch_icpp(patch_id)%radius <= 0d0 & + .or. & + patch_icpp(patch_id)%x_centroid == dflt_real & + .or. & + patch_icpp(patch_id)%y_centroid == dflt_real) then - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of spherical '// & - 'harmonic patch '//trim(iStr)//'. Exiting ...') - end if + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'geometric parameters of spherical '// & + 'harmonic patch '//trim(iStr)//'. Exiting ...') + end if end if end subroutine s_check_spherical_harmonic_patch_geometry ! ------------- diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index d3a0283b21..f712967ab6 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -229,7 +229,6 @@ contains old_ic = .false. t_step_old = dflt_int t_step_start = dflt_int - ! Computational domain parameters m = dflt_int; n = 0; p = 0 diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp index 22e99bad30..8164091f9c 100644 --- a/src/pre_process/m_initial_condition.fpp +++ b/src/pre_process/m_initial_condition.fpp @@ -246,10 +246,10 @@ contains ! Analytical function patch for testing purposes elseif (patch_icpp(i)%geometry == 7) then call s_2D_analytical(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_spherical_harmonic(i, patch_id_fp, q_prim_vf) ! Spiral patch elseif (patch_icpp(i)%geometry == 17) then diff --git a/src/pre_process/m_mpi_proxy.fpp b/src/pre_process/m_mpi_proxy.fpp index 70f8fd2ba1..076787a9c0 100644 --- a/src/pre_process/m_mpi_proxy.fpp +++ b/src/pre_process/m_mpi_proxy.fpp @@ -87,7 +87,7 @@ contains #:endfor #:for VAR in [ 'a2', 'a3', 'a4', 'a5', 'a6', 'a7', 'a8', 'a9', 'a10', 'a11', 'a12'] - call MPI_BCAST(patch_icpp(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(patch_icpp(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) #:endfor call MPI_BCAST(patch_icpp(i)%model%filepath, len(patch_icpp(i)%model%filepath), MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr) diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index afc936c92a..dd10a5f7e5 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -760,7 +760,7 @@ contains ((y_cc(j) - y_centroid)/b)**2) & - 1d0))*(-0.5d0) + 0.5d0 end if - PRINT *,"a :",a, "b :",b + print *, "a :", a, "b :", b if ((((x_cc(i) - x_centroid)/a)**2 + & ((y_cc(j) - y_centroid)/b)**2 <= 1d0 & .and. & @@ -1358,18 +1358,17 @@ contains !! as a perturbation to a perfect sphere !! @param patch_id is the patch identifier 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) :: q_prim_vf - real(kind(0d0)) :: r, x_p, P2, P3, P4, P5, P6, P7, P8, P9, P10, P11, P12, eps, phi - real(kind(0d0)) :: a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 - real(kind(0d0)) :: radius, x_centroid, y_centroid, z_centroid - logical :: non_axis_sym + 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) :: q_prim_vf - integer :: i, j, k !< generic loop iterators + real(kind(0d0)) :: r, x_p, P2, P3, P4, P5, P6, P7, P8, P9, P10, P11, P12, eps, phi + real(kind(0d0)) :: a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 + real(kind(0d0)) :: radius, x_centroid, y_centroid, z_centroid + logical :: non_axis_sym + integer :: i, j, k !< generic loop iterators ! Transferring the patch's centroid and radius information x_centroid = patch_icpp(patch_id)%x_centroid @@ -1396,128 +1395,126 @@ contains eta = 1d0 eps = 1.d-32 - ! 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) 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 = dsqrt((x_cc(i)-x_centroid)**2+(cart_y-y_centroid)**2+(cart_z-z_centroid)**2)+eps - x_p = dabs(x_cc(i)-x_centroid+eps)/r - P2 = unassociated_legendre(x_p,2) - P3 = unassociated_legendre(x_p,3) - P4 = unassociated_legendre(x_p,4) - P5 = unassociated_legendre(x_p,5) - P6 = unassociated_legendre(x_p,6) - P7 = unassociated_legendre(x_p,7) - - - if (x_cc(i)-x_centroid >= 0 & - .and. & - r-a2*P2-a3*P3-a4*P4-a5*P5-a6*P6-a7*P7 <= radius & - .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) + 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 - elseif (x_cc(i)-x_centroid < 0 & + r = dsqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) + eps + x_p = dabs(x_cc(i) - x_centroid + eps)/r + P2 = unassociated_legendre(x_p, 2) + P3 = unassociated_legendre(x_p, 3) + P4 = unassociated_legendre(x_p, 4) + P5 = unassociated_legendre(x_p, 5) + P6 = unassociated_legendre(x_p, 6) + P7 = unassociated_legendre(x_p, 7) + + if (x_cc(i) - x_centroid >= 0 & + .and. & + r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7 <= radius & + .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) + + elseif (x_cc(i) - x_centroid < 0 & .and. & - r-a2*P2+a3*P3-a4*P4+a5*P5-a6*P6+a7*P7 <= radius & + r - a2*P2 + a3*P3 - a4*P4 + a5*P5 - a6*P6 + a7*P7 <= radius & .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) - endif - end do + then + call s_assign_patch_primitive_variables(patch_id, i, j, k, & + eta, q_prim_vf, patch_id_fp) + end if + end do + end do end do - end do - else if ( p == 0) then - do j = 0, n - do i = 0, m - - if (non_axis_sym) then - phi = atan(((y_cc(j)-y_centroid)+eps)/((x_cc(i)-x_centroid)+eps)) - r = dsqrt((x_cc(i)-x_centroid)**2d0+(y_cc(j)-y_centroid)**2d0)+eps - x_p = (eps)/r - P2 = spherical_harmonic_func(x_p, phi, 2, 2) - P3 = spherical_harmonic_func(x_p, phi, 3, 3) - P4 = spherical_harmonic_func(x_p, phi, 4, 4) - P5 = spherical_harmonic_func(x_p, phi, 5, 5) - P6 = spherical_harmonic_func(x_p, phi, 6, 6) - P7 = spherical_harmonic_func(x_p, phi, 7, 7) - P8 = spherical_harmonic_func(x_p, phi, 8, 8) - P9 = spherical_harmonic_func(x_p, phi, 9, 9) - ! P10 = spherical_harmonic_func(x_p, phi, 10, 10) - ! P11 = spherical_harmonic_func(x_p, phi, 11, 11) - ! P12 = spherical_harmonic_func(x_p, phi, 12, 12) - else - r = dsqrt((x_cc(i)-x_centroid)**2d0+(y_cc(j)-y_centroid)**2d0)+eps - x_p = dabs(x_cc(i)-x_centroid+eps)/r - P2 = unassociated_legendre(x_p,2) - P3 = unassociated_legendre(x_p,3) - P4 = unassociated_legendre(x_p,4) - P5 = unassociated_legendre(x_p,5) - P6 = unassociated_legendre(x_p,6) - P7 = unassociated_legendre(x_p,7) - end if - - if (x_cc(i)-x_centroid >= 0 & - .and. & - r-a2*P2-a3*P3-a4*P4-a5*P5-a6*P6-a7*P7-a8*P8-a9*P9 <= 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, q_prim_vf, patch_id_fp) + else if (p == 0) then + do j = 0, n + do i = 0, m - elseif (x_cc(i)-x_centroid < 0 & - .and. & - r-a2*P2+a3*P3-a4*P4+a5*P5-a6*P6+a7*P7-a8*P8+a9*P9 <= 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, q_prim_vf, patch_id_fp) + if (non_axis_sym) then + phi = atan(((y_cc(j) - y_centroid) + eps)/((x_cc(i) - x_centroid) + eps)) + r = dsqrt((x_cc(i) - x_centroid)**2d0 + (y_cc(j) - y_centroid)**2d0) + eps + x_p = (eps)/r + P2 = spherical_harmonic_func(x_p, phi, 2, 2) + P3 = spherical_harmonic_func(x_p, phi, 3, 3) + P4 = spherical_harmonic_func(x_p, phi, 4, 4) + P5 = spherical_harmonic_func(x_p, phi, 5, 5) + P6 = spherical_harmonic_func(x_p, phi, 6, 6) + P7 = spherical_harmonic_func(x_p, phi, 7, 7) + P8 = spherical_harmonic_func(x_p, phi, 8, 8) + P9 = spherical_harmonic_func(x_p, phi, 9, 9) + ! P10 = spherical_harmonic_func(x_p, phi, 10, 10) + ! P11 = spherical_harmonic_func(x_p, phi, 11, 11) + ! P12 = spherical_harmonic_func(x_p, phi, 12, 12) + else + r = dsqrt((x_cc(i) - x_centroid)**2d0 + (y_cc(j) - y_centroid)**2d0) + eps + x_p = dabs(x_cc(i) - x_centroid + eps)/r + P2 = unassociated_legendre(x_p, 2) + P3 = unassociated_legendre(x_p, 3) + P4 = unassociated_legendre(x_p, 4) + P5 = unassociated_legendre(x_p, 5) + P6 = unassociated_legendre(x_p, 6) + P7 = unassociated_legendre(x_p, 7) + end if - endif + if (x_cc(i) - x_centroid >= 0 & + .and. & + r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7 - a8*P8 - a9*P9 <= 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, q_prim_vf, patch_id_fp) + + elseif (x_cc(i) - x_centroid < 0 & + .and. & + r - a2*P2 + a3*P3 - a4*P4 + a5*P5 - a6*P6 + a7*P7 - a8*P8 + a9*P9 <= 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, q_prim_vf, patch_id_fp) + + end if end do - end do - end if - + end do + end if + end subroutine s_spherical_harmonic ! ---------------------------------- !! This function generates the unassociated legendre poynomials with input - ! mode number and evaluates them at input x + ! mode number and evaluates them at input x - recursive function unassociated_legendre(x,l) result(P) + recursive function unassociated_legendre(x, l) result(P) integer, intent(in) :: l real(kind(0d0)), intent(in) :: x real(kind(0d0)) :: P if (l == 0) then - P = 1d0 + P = 1d0 else if (l == 1) then - P = x + P = x else - P = ((2*l-1)*x*unassociated_legendre(x,l-1)-(l-1)*unassociated_legendre(x,l-2))/l - end if + P = ((2*l - 1)*x*unassociated_legendre(x, l - 1) - (l - 1)*unassociated_legendre(x, l - 2))/l + end if end function unassociated_legendre !! This function generated the spherical harmonic function valu, Y, - !based on inputs of x, phi, l and m + !based on inputs of x, phi, l and m recursive function spherical_harmonic_func(x, phi, l, m) result(Y) integer, intent(in) :: l, m @@ -1525,71 +1522,69 @@ contains real(kind(0d0)) :: Y, prefactor, pi pi = acos(-1d0) - prefactor = sqrt((2*l+1)/(4*pi)*factorial(l-m)/factorial(l+m)); + prefactor = sqrt((2*l + 1)/(4*pi)*factorial(l - m)/factorial(l + m)); if (m == 0) then - Y = prefactor*associated_legendre(x, l, m); - elseif (m .gt. 0) then - Y = (-1d0)**m*sqrt(2d0)*prefactor*associated_legendre(x, l, m)*cos(m*phi); - endif + Y = prefactor*associated_legendre(x, l, m); + elseif (m > 0) then + Y = (-1d0)**m*sqrt(2d0)*prefactor*associated_legendre(x, l, m)*cos(m*phi); + end if end function spherical_harmonic_func !! This function generates the associated legendre polynomials evaluated - !at x with inputs l and m + !at x with inputs l and m recursive function associated_legendre(x, l, m) result(P) - integer, intent(in) :: l, m - real(kind(0d0)), intent(in) :: x - real(kind(0d0)) :: P - - if (m <= 0 .and. l <= 0) then - P = 1; - elseif (l == 1 .and. m <= 0) then - P = x; - elseif (l == 1 .and. m == 1) then - P = -(1-x**2)**(1/2); - elseif (m == l) then - P = (-1)**l*double_factorial(2*l-1)*(1-x**2)**(l/2); - elseif (m == l-1) then - P = x*(2*l-1)*associated_legendre(x, l-1, l-1); - else - P = ((2*l-1)*x*associated_legendre(x, l-1, m)-(l+m-1)*associated_legendre(x, l-2, m))/(l-m); - endif - - end function associated_legendre + integer, intent(in) :: l, m + real(kind(0d0)), intent(in) :: x + real(kind(0d0)) :: P - !! This function calculates the double factorial value of an integer + if (m <= 0 .and. l <= 0) then + P = 1; + elseif (l == 1 .and. m <= 0) then + P = x; + elseif (l == 1 .and. m == 1) then + P = -(1 - x**2)**(1/2); + elseif (m == l) then + P = (-1)**l*double_factorial(2*l - 1)*(1 - x**2)**(l/2); + elseif (m == l - 1) then + P = x*(2*l - 1)*associated_legendre(x, l - 1, l - 1); + else + P = ((2*l - 1)*x*associated_legendre(x, l - 1, m) - (l + m - 1)*associated_legendre(x, l - 2, m))/(l - m); + end if - recursive function double_factorial(n) result(R) - integer, intent (in) :: n - integer, parameter :: int64_kind = selected_int_kind(18) ! 18 bytes for 64-bit integer - integer(kind=int64_kind) :: R + end function associated_legendre - if (n <= 0) then - R = 1 - else if (n == 1) then - R = 1 - else - R = n * double_factorial(n - 2) - end if + !! This function calculates the double factorial value of an integer - end function double_factorial + recursive function double_factorial(n) result(R) + integer, intent(in) :: n + integer, parameter :: int64_kind = selected_int_kind(18) ! 18 bytes for 64-bit integer + integer(kind=int64_kind) :: R - !! The following function calculates the factorial value of an integer + if (n <= 0) then + R = 1 + else if (n == 1) then + R = 1 + else + R = n*double_factorial(n - 2) + end if - recursive function factorial(n) result(R) - integer, intent(in) :: n - integer, parameter :: int64_kind = selected_int_kind(18) ! 18 bytes for 64-bit integer - integer(kind=int64_kind) :: R + end function double_factorial - if (n == 0) then - R = 1 - else - R = n * factorial(n - 1) - end if + !! The following function calculates the factorial value of an integer - end function factorial + recursive function factorial(n) result(R) + integer, intent(in) :: n + integer, parameter :: int64_kind = selected_int_kind(18) ! 18 bytes for 64-bit integer + integer(kind=int64_kind) :: R + if (n == 0) then + R = 1 + else + R = n*factorial(n - 1) + end if + end function factorial !> The spherical patch is a 3D geometry that may be used, !! for example, in creating a bubble or a droplet. The patch @@ -2090,7 +2085,7 @@ contains end subroutine s_convert_cylindrical_to_cartesian_coord ! -------------- - function f_convert_cyl_to_cart(cyl) result(cart) + function f_convert_cyl_to_cart(cyl) result(cart) !$acc routine seq diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 19a033e512..e58c4593ed 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -35,23 +35,23 @@ module m_data_output implicit none private; public :: s_initialize_data_output_module, & - s_open_run_time_information_file, & - s_open_com_files, & - s_open_probe_files, & - s_write_run_time_information, & - s_write_data_files, & - s_write_serial_data_files, & - s_write_parallel_data_files, & - s_write_com_files, & - s_write_probe_files, & - s_close_run_time_information_file, & - s_close_com_files, & - s_close_probe_files, & - s_finalize_data_output_module, & - s_open_sim_data_file, & - s_write_sim_data_file, & - s_close_sim_data_file - abstract interface ! =================================================== + s_open_run_time_information_file, & + s_open_com_files, & + s_open_probe_files, & + s_write_run_time_information, & + s_write_data_files, & + s_write_serial_data_files, & + s_write_parallel_data_files, & + s_write_com_files, & + s_write_probe_files, & + s_close_run_time_information_file, & + s_close_com_files, & + s_close_probe_files, & + s_finalize_data_output_module, & + s_open_sim_data_file, & + s_write_sim_data_file, & + s_close_sim_data_file + abstract interface ! =================================================== !> Write data files !! @param q_cons_vf Conservative variables @@ -166,46 +166,45 @@ contains end if end subroutine s_open_run_time_information_file ! ---------------------- - - !> This opens a formatted data file where the root processor - !! can write out the CoM information + + !> This opens a formatted data file where the root processor + !! can write out the CoM information subroutine s_open_com_files() ! ---------------------------------------- - character(len = path_len + 3*name_len) :: file_path !< - !! Relative path to the CoM file in the case directory - integer :: i !< Generic loop iterator - do i = 1, num_fluids - ! Generating the relative path to the CoM data file - write(file_path,'(A,I0,A)') '/fluid',i,'_com.dat' - file_path = trim(case_dir) // trim(file_path) - ! Creating the formatted data file and setting up its - ! structure - open(i+120, file = trim(file_path), & - form = 'formatted', & - position = 'append', & - status = 'unknown') - if (n == 0) then - write(i+120,'(A)') '=== Non-Dimensional Time ' // & - '=== Total Mass ' // & - '=== x-loc ' // & - '=== Total Volume ===' - elseif (p == 0) then - write(i+120,'(A)') '=== Non-Dimensional Time ' // & - '=== Total Mass ' // & - '=== x-loc ' // & - '=== y-loc ' // & - '=== Total Volume ===' - else - write(i+120,'(A)') '=== Non-Dimensional Time ' // & - '=== Total Mass ' // & - '=== x-loc ' // & - '=== y-loc ' // & - '=== z-loc ' // & - '=== Total Volume ===' - end if - end do + character(len=path_len + 3*name_len) :: file_path !< + !! Relative path to the CoM file in the case directory + integer :: i !< Generic loop iterator + do i = 1, num_fluids + ! Generating the relative path to the CoM data file + write (file_path, '(A,I0,A)') '/fluid', i, '_com.dat' + file_path = trim(case_dir)//trim(file_path) + ! Creating the formatted data file and setting up its + ! structure + open (i + 120, file=trim(file_path), & + form='formatted', & + position='append', & + status='unknown') + if (n == 0) then + write (i + 120, '(A)') '=== Non-Dimensional Time '// & + '=== Total Mass '// & + '=== x-loc '// & + '=== Total Volume ===' + elseif (p == 0) then + write (i + 120, '(A)') '=== Non-Dimensional Time '// & + '=== Total Mass '// & + '=== x-loc '// & + '=== y-loc '// & + '=== Total Volume ===' + else + write (i + 120, '(A)') '=== Non-Dimensional Time '// & + '=== Total Mass '// & + '=== x-loc '// & + '=== y-loc '// & + '=== z-loc '// & + '=== Total Volume ===' + end if + end do end subroutine s_open_com_files ! -------------------------------------- - subroutine s_open_sim_data_file() ! ------------------------ character(LEN=path_len + 5*name_len) :: file_path !< @@ -214,26 +213,20 @@ contains !! Creation date of the run-time information file write (file_path, '(A)') '/sim_data.txt' - file_path = trim(case_dir)//trim(file_path) + file_path = trim(case_dir)//trim(file_path) - ! Opening the simulation data file + ! Opening the simulation data file open (21519, FILE=trim(file_path), & - FORM='formatted', & - POSITION='append', & - STATUS='unknown') + FORM='formatted', & + POSITION='append', & + STATUS='unknown') ! call date_and_time(DATE=file_date) - + ! write (21519, '(A)') 'Date: '//file_date(5:6)//'/'// & ! file_date(7:8)//'/'// & ! file_date(3:4) - - end subroutine s_open_sim_data_file ! ---------------------------------------- - - - - - + end subroutine s_open_sim_data_file ! ---------------------------------------- !> This opens a formatted data file where the root processor !! can write out flow probe information @@ -327,7 +320,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - + do i = 1, num_fluids alpha_rho(i) = q_prim_vf(i)%sf(j, k, l) alpha(i) = q_prim_vf(E_idx + i)%sf(j, k, l) @@ -435,7 +428,7 @@ contains end do end do ! end: Computing Stability Criteria at Current Time-step =========== - + ! Determining local stability criteria extrema at current time-step !$acc kernels @@ -480,7 +473,7 @@ contains t_step, t_step*dt, icfl_max_glb, & vcfl_max_glb, & Rc_min_glb - + else write (1, '(13X,I8,14X,F10.6,13X,F9.6)') & t_step, t_step*dt, icfl_max_glb @@ -506,98 +499,97 @@ contains end subroutine s_write_run_time_information ! -------------------------- subroutine s_write_sim_data_file(q_prim_vf, t_step) - + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer, intent(IN) :: t_step integer :: i, j, k, l, w !< Generic loop iterators integer :: ierr, counter, counter2, counter3, root !< number of data points extracted to fit shape to SH perturbations real(kind(0d0)) :: u, m_a_x, m_a_y, m_a_z, eps - real(kind(0d0)), dimension(0:m,0:n) :: d_alpha_x, d_magdalphax, d_magdalphay, f_NS, rho, alpha_rhob - real(kind(0d0)), dimension(0:m,0:n) :: d_alpha_y, mag_d_alpha, d_rho_x, d_rho_y, mag_d_rho, alpha_b - real(kind(0d0)), dimension(0:m,0:n,0:p) :: d_alph_mpi_barrier_x3, d_alpha_y3, d_alpha_z3 - real(kind(0d0)) :: xdv, ydv, mag_d_alpha3, nondim_time, alphaxm, alphaxp, alphaym, alphayp + real(kind(0d0)), dimension(0:m, 0:n) :: d_alpha_x, d_magdalphax, d_magdalphay, f_NS, rho, alpha_rhob + real(kind(0d0)), dimension(0:m, 0:n) :: d_alpha_y, mag_d_alpha, d_rho_x, d_rho_y, mag_d_rho, alpha_b + real(kind(0d0)), dimension(0:m, 0:n, 0:p) :: d_alph_mpi_barrier_x3, d_alpha_y3, d_alpha_z3 + real(kind(0d0)) :: xdv, ydv, mag_d_alpha3, nondim_time, alphaxm, alphaxp, alphaym, alphayp real(kind(0d0)), dimension(num_fluids) :: alpha, vol_fluid, xcom, ycom, zcom real(kind(0d0)) :: alpha_t, concavity_x_prior, concavity_x_post, concavity_y_prior, concavity_y_post real(kind(0d0)), allocatable :: q(:), maxdalphy(:), maxdalphx(:) - real(kind=8),parameter :: pi=4.D0*datan(1.D0) + real(kind=8), parameter :: pi = 4.d0*datan(1.d0) real(kind(0d0)), allocatable :: x_td(:), y_td(:), x_tdf(:), y_tdf(:), x_d1(:), y_d1(:), y_d(:), x_d(:) - - real(kind(0d0)) :: axp, axm, ayp, aym - + + real(kind(0d0)) :: axp, axm, ayp, aym + call s_calculate_COM(q_prim_vf, xcom, ycom, vol_fluid) - + if (t_step_old /= dflt_int) then nondim_time = real(t_step + t_step_old, kind(0d0))*dt else nondim_time = real(t_step, kind(0d0))*dt !*1.d-5/10.0761131451d0 end if root = 0 - allocate(x_d1(m*n)) - allocate(y_d1(m*n)) + allocate (x_d1(m*n)) + allocate (y_d1(m*n)) counter = 0 - do k = 0,n - OLoop: do j = 0,m - axp = q_prim_vf(E_idx + 2)%sf(j+1,k,0) - axm = q_prim_vf(E_idx + 2)%sf(j-1,k,0) - ayp = q_prim_vf(E_idx + 2)%sf(j,k+1,0) - aym = q_prim_vf(E_idx + 2)%sf(j,k-1,0) - - if ((axp > 0.9 .and. axm < 0.9) .or. (axp < 0.9 .and. axm > 0.9)& - .or. (ayp > 0.9 .and. aym < 0.9) .or. (ayp < 0.9 .and. aym > 0.9)) then - if (counter == 0) then - counter = counter + 1 - x_d1(counter) = x_cc(j) - y_d1(counter) = y_cc(k) - else - do i = 1, counter - if (sqrt((x_cc(j)-x_d1(i))**2+(y_cc(k)-& - y_d1(i))**2) <= 2*sqrt(dx(j)**2& - +dy(k)**2)) then - cycle OLoop - elseif (sqrt((x_cc(j)-x_d1(i))**2+(y_cc(k)-& - y_d1(i))**2) > 2*sqrt(dx(j)**2& - +dy(k)**2) .and. i == counter) then - counter = counter + 1 - x_d1(counter) = x_cc(j) - y_d1(counter) = y_cc(k) - end if - end do - end if - end if - end do OLoop - end do - - allocate(y_d(counter)) - allocate(x_d(counter)) - do i = 1,counter - y_d(i) = y_d1(i) - x_d(i) = x_d1(i) + do k = 0, n + OLoop: do j = 0, m + axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, 0) + axm = q_prim_vf(E_idx + 2)%sf(j - 1, k, 0) + ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, 0) + aym = q_prim_vf(E_idx + 2)%sf(j, k - 1, 0) + + if ((axp > 0.9 .and. axm < 0.9) .or. (axp < 0.9 .and. axm > 0.9) & + .or. (ayp > 0.9 .and. aym < 0.9) .or. (ayp < 0.9 .and. aym > 0.9)) then + if (counter == 0) then + counter = counter + 1 + x_d1(counter) = x_cc(j) + y_d1(counter) = y_cc(k) + else + do i = 1, counter + if (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & + y_d1(i))**2) <= 2*sqrt(dx(j)**2 & + + dy(k)**2)) then + cycle OLoop + elseif (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & + y_d1(i))**2) > 2*sqrt(dx(j)**2 & + + dy(k)**2) .and. i == counter) then + counter = counter + 1 + x_d1(counter) = x_cc(j) + y_d1(counter) = y_cc(k) + end if + end do + end if + end if + end do OLoop + end do + + allocate (y_d(counter)) + allocate (x_d(counter)) + do i = 1, counter + y_d(i) = y_d1(i) + x_d(i) = x_d1(i) end do if (num_procs > 1) then call s_mpi_gather_data(x_d, counter, x_td, root) call s_mpi_gather_data(y_d, counter, y_td, root) - if (proc_rank == 0) then + if (proc_rank == 0) then do i = 1, size(x_td) - if (i == size(x_td)) then - write(21519,'(F12.9,1X,F12.9,1X,I4, 1X, F12.9, 1X, F12.9)') & - x_td(i), y_td(i), size(x_td), xcom(2), nondim_time - else - write(21519,'(F12.9,1X,F12.9,1X,F3.1,1X,F3.1,1X,F3.1)') & - x_td(i), y_td(i), 0d0, 0d0, 0d0 - end if - end do - end if - end if + if (i == size(x_td)) then + write (21519, '(F12.9,1X,F12.9,1X,I4, 1X, F12.9, 1X, F12.9)') & + x_td(i), y_td(i), size(x_td), xcom(2), nondim_time + else + write (21519, '(F12.9,1X,F12.9,1X,F3.1,1X,F3.1,1X,F3.1)') & + x_td(i), y_td(i), 0d0, 0d0, 0d0 + end if + end do + end if + end if end subroutine s_write_sim_data_file ! ----------------------------------- - subroutine s_calculate_numerical_schlieran(q_prim_vf, f_NS) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer :: i, j, k, l - real(kind(0d0)), dimension(0:m,0:n), intent(OUT) :: f_NS - real(kind(0d0)), dimension(0:m,0:n) :: d_rho_mag, a, b, c, d, d_a_mag + real(kind(0d0)), dimension(0:m, 0:n), intent(OUT) :: f_NS + real(kind(0d0)), dimension(0:m, 0:n) :: d_rho_mag, a, b, c, d, d_a_mag real(kind(0d0)) :: rhoxp, rhoxm, rhoyp, rhoym, rhop, d_rhox, d_rhoy, mag_max real(kind(0d0)) :: axp, axm, ayp, aym, ap, d_ax, d_ay, maga_max @@ -611,43 +603,42 @@ contains axm = 0d0 ayp = 0d0 aym = 0d0 - - - do k = 0,n - do j = 0, m - do i = 1, num_fluids - rhop = rhop + q_prim_vf(i)%sf(j,k,0) - rhoxp = rhoxp + q_prim_vf(i)%sf(j+1,k,0) - rhoxm = rhoxm + q_prim_vf(i)%sf(j-1,k,0) - rhoyp = rhoyp + q_prim_vf(i)%sf(j,k+1,0) - rhoym = rhoym + q_prim_vf(i)%sf(j,k-1,0) - end do - ap = q_prim_vf(E_idx + 2)%sf(j,k,0) - axp = q_prim_vf(E_idx + 2)%sf(j+1,k,0) - axm = q_prim_vf(E_idx + 2)%sf(j-1,k,0) - ayp = q_prim_vf(E_idx + 2)%sf(j,k+1,0) - aym = q_prim_vf(E_idx + 2)%sf(j,k-1,0) - if (j == m) then - d_rhox = dabs((rhop-rhoxm)/(x_cc(j)-x_cc(j-1))) - d_ax = dabs((ap-axm)/(x_cc(j)-x_cc(j-1))) - else if (k == n) then - d_rhoy = dabs((rhop-rhoym)/(y_cc(k)-y_cc(k-1))) - d_ay = dabs((ap-aym)/(y_cc(k)-y_cc(k-1))) - else if (j == 0) then - d_rhox = dabs((rhoxp-rhop)/(x_cc(j+1)-x_cc(j))) - d_ax = dabs((axp-ap)/(x_cc(j+1)-x_cc(j))) - else if (k == 0) then - d_rhoy = dabs((rhoyp-rhop)/(y_cc(k+1)-y_cc(k))) - d_ay = dabs((ayp-ap)/(y_cc(k+1)-y_cc(k))) - else - d_rhox = dabs((rhoxp-rhoxm)/(x_cc(j+1)-x_cc(j-1))) - d_rhoy = dabs((rhoyp-rhoym)/(y_cc(k+1)-y_cc(k-1))) - d_ax = dabs((axp-axm)/(x_cc(j+1)-x_cc(j-1))) - d_ay = dabs((ayp-aym)/(y_cc(k+1)-y_cc(k-1))) - - end if - d_rho_mag(j,k) = dsqrt((d_rhox**2+d_rhoy**2)) - d_a_mag(j,k) = dsqrt((d_ax**2+d_ay**2)) + + do k = 0, n + do j = 0, m + do i = 1, num_fluids + rhop = rhop + q_prim_vf(i)%sf(j, k, 0) + rhoxp = rhoxp + q_prim_vf(i)%sf(j + 1, k, 0) + rhoxm = rhoxm + q_prim_vf(i)%sf(j - 1, k, 0) + rhoyp = rhoyp + q_prim_vf(i)%sf(j, k + 1, 0) + rhoym = rhoym + q_prim_vf(i)%sf(j, k - 1, 0) + end do + ap = q_prim_vf(E_idx + 2)%sf(j, k, 0) + axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, 0) + axm = q_prim_vf(E_idx + 2)%sf(j - 1, k, 0) + ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, 0) + aym = q_prim_vf(E_idx + 2)%sf(j, k - 1, 0) + if (j == m) then + d_rhox = dabs((rhop - rhoxm)/(x_cc(j) - x_cc(j - 1))) + d_ax = dabs((ap - axm)/(x_cc(j) - x_cc(j - 1))) + else if (k == n) then + d_rhoy = dabs((rhop - rhoym)/(y_cc(k) - y_cc(k - 1))) + d_ay = dabs((ap - aym)/(y_cc(k) - y_cc(k - 1))) + else if (j == 0) then + d_rhox = dabs((rhoxp - rhop)/(x_cc(j + 1) - x_cc(j))) + d_ax = dabs((axp - ap)/(x_cc(j + 1) - x_cc(j))) + else if (k == 0) then + d_rhoy = dabs((rhoyp - rhop)/(y_cc(k + 1) - y_cc(k))) + d_ay = dabs((ayp - ap)/(y_cc(k + 1) - y_cc(k))) + else + d_rhox = dabs((rhoxp - rhoxm)/(x_cc(j + 1) - x_cc(j - 1))) + d_rhoy = dabs((rhoyp - rhoym)/(y_cc(k + 1) - y_cc(k - 1))) + d_ax = dabs((axp - axm)/(x_cc(j + 1) - x_cc(j - 1))) + d_ay = dabs((ayp - aym)/(y_cc(k + 1) - y_cc(k - 1))) + + end if + d_rho_mag(j, k) = dsqrt((d_rhox**2 + d_rhoy**2)) + d_a_mag(j, k) = dsqrt((d_ax**2 + d_ay**2)) rhop = 0d0 rhoxp = 0d0 rhoxm = 0d0 @@ -658,133 +649,129 @@ contains axm = 0d0 ayp = 0d0 aym = 0d0 - end do - end do - + end do + end do -! if (maxval(d_rho_mag) < 1/(100*maxval(dx)) .or. maxval(d_rho_mag) < 1/(100*maxval(dy))) then +! if (maxval(d_rho_mag) < 1/(100*maxval(dx)) .or. maxval(d_rho_mag) < 1/(100*maxval(dy))) then ! d_rho_mag(0:m,0:n) = 0d0 ! else ! d_rho_mag(0:m,0:n) = d_rho_mag(0:m,0:n)/maxval(d_rho_mag) ! end if - call s_mpi_allreduce_max(maxval(d_rho_mag),mag_max) - call s_mpi_allreduce_max(maxval(d_a_mag),maga_max) - ! print *, "d_rho_max =", mag_max - ! print*, "d_rho_mag =", d_rho_mag - d_rho_mag(0:m,0:n) = d_rho_mag(0:m,0:n)/mag_max - d_a_mag(0:m,0:n) = d_a_mag(0:m,0:n)/maga_max -! print*, d_rho_mag - a = 0.5 - b = 9 - c = 0.65 - d = 1 - ! f_NS(0:m,0:n) = d_a_mag(0:m,0:n)*(EXP(-b**2*(d_rho_mag(0:m,0:n)& - ! -d_a_mag(0:m,0:n))**2/(d_a_mag(0:m,0:n))**2)+ & - ! c*EXP(-b**2*(d_rho_mag(0:m,0:n)-(d_a_mag(0:m,0:n)-a))**2/& - ! (d_a_mag(0:m,0:n))**2)+d*d_rho_mag(0:m,0:n)/d_a_mag(0:m,0:n)*& - ! EXP(-b**2*(d_rho_mag(0:m,0:n)-(0.9))**2/(25**2*(d_a_mag(0:m,0:n))**2))) - - f_NS(0:m,0:n) = q_prim_vf(E_idx + 2)%sf(0:m,0:n,0)*(EXP(-b**2*(d_rho_mag(0:m,0:n)& - -q_prim_vf(E_idx + 2)%sf(0:m,0:n,0))**2/(q_prim_vf(E_idx + 2)%sf(0:m,0:n,0))**2)+ & - c*EXP(-b**2*(d_rho_mag(0:m,0:n)-(q_prim_vf(E_idx + 2)%sf(0:m,0:n,0)-a))**2/& - (q_prim_vf(E_idx + 2)%sf(0:m,0:n,0))**2)+d*d_rho_mag(0:m,0:n)/q_prim_vf(E_idx + 2)%sf(0:m,0:n,0)*& - EXP(-b**2*(d_rho_mag(0:m,0:n)-(0.9))**2/(25**2*(q_prim_vf(E_idx + 2)%sf(0:m,0:n,0))**2))) - - ! f_NS(0:m,0:n) = d*dsqrt(d_rho_mag(0:m,0:n))*& -! EXP(-b**2*(d_rho_mag(0:m,0:n)-(0.9))**2/(25**2*(q_prim_vf(E_idx + 2)%sf(0:m,0:n,0))**2)) + call s_mpi_allreduce_max(maxval(d_rho_mag), mag_max) + call s_mpi_allreduce_max(maxval(d_a_mag), maga_max) + ! print *, "d_rho_max =", mag_max + ! print*, "d_rho_mag =", d_rho_mag + d_rho_mag(0:m, 0:n) = d_rho_mag(0:m, 0:n)/mag_max + d_a_mag(0:m, 0:n) = d_a_mag(0:m, 0:n)/maga_max +! print*, d_rho_mag + a = 0.5 + b = 9 + c = 0.65 + d = 1 + ! f_NS(0:m,0:n) = d_a_mag(0:m,0:n)*(EXP(-b**2*(d_rho_mag(0:m,0:n)& + ! -d_a_mag(0:m,0:n))**2/(d_a_mag(0:m,0:n))**2)+ & + ! c*EXP(-b**2*(d_rho_mag(0:m,0:n)-(d_a_mag(0:m,0:n)-a))**2/& + ! (d_a_mag(0:m,0:n))**2)+d*d_rho_mag(0:m,0:n)/d_a_mag(0:m,0:n)*& + ! EXP(-b**2*(d_rho_mag(0:m,0:n)-(0.9))**2/(25**2*(d_a_mag(0:m,0:n))**2))) + + f_NS(0:m, 0:n) = q_prim_vf(E_idx + 2)%sf(0:m, 0:n, 0)*(exp(-b**2*(d_rho_mag(0:m, 0:n) & + - q_prim_vf(E_idx + 2)%sf(0:m, 0:n, 0))**2/(q_prim_vf(E_idx + 2)%sf(0:m, 0:n, 0))**2) + & + c*exp(-b**2*(d_rho_mag(0:m, 0:n) - (q_prim_vf(E_idx + 2)%sf(0:m, 0:n, 0) - a))**2/ & + (q_prim_vf(E_idx + 2)%sf(0:m, 0:n, 0))**2) + d*d_rho_mag(0:m, 0:n)/q_prim_vf(E_idx + 2)%sf(0:m, 0:n, 0)* & + exp(-b**2*(d_rho_mag(0:m, 0:n) - (0.9))**2/(25**2*(q_prim_vf(E_idx + 2)%sf(0:m, 0:n, 0))**2))) + + ! f_NS(0:m,0:n) = d*dsqrt(d_rho_mag(0:m,0:n))*& +! EXP(-b**2*(d_rho_mag(0:m,0:n)-(0.9))**2/(25**2*(q_prim_vf(E_idx + 2)%sf(0:m,0:n,0))**2)) ! f_NS(0:m,0:n) = d*(d_rho_mag(0:m,0:n)+d_a_mag(0:m,0:n))*& -! EXP(-b**2*(d_rho_mag(0:m,0:n)-(1+d_a_mag(0:m,0:n)))**2/(30**2*(d_a_mag(0:m,0:n))**2)) - - -!1-EXP(-(0.1+0.9*q_prim_vf(E_idx + 2)%sf(0:m,0:n, 0))*dsqrt(d_rho_mag(0:m,0:n))*q_prim_vf(E_idx + 2)%sf(0:m,0:n, 0)) +! EXP(-b**2*(d_rho_mag(0:m,0:n)-(1+d_a_mag(0:m,0:n)))**2/(30**2*(d_a_mag(0:m,0:n))**2)) +!1-EXP(-(0.1+0.9*q_prim_vf(E_idx + 2)%sf(0:m,0:n, 0))*dsqrt(d_rho_mag(0:m,0:n))*q_prim_vf(E_idx + 2)%sf(0:m,0:n, 0)) end subroutine s_calculate_numerical_schlieran - subroutine s_calculate_COM(q_prim_vf, xcom, ycom, vol_fluid) - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - integer :: i, j, k, l !< Generic loop iterators - real(kind(0d0)), dimension(num_fluids), intent(OUT) :: vol_fluid - real(kind(0d0)), dimension(num_fluids) :: ms, ym, xm, zm - real(kind(0d0)), dimension(num_fluids), intent(OUT) :: xcom, ycom - real(kind(0d0)) :: ybeg, xend, xbeg, zbeg, zend, tmp, dV, yend - - xm = 0d0 - ms = 0d0 - ym = 0d0 - ! zm = 0d0 - - do l = 0, p - do k = 0, n - do j = 0, m - if (p > 0) then - dV = dx(j)*dy(k)*dz(l) - else if (p == 0) then - dV = dx(j)*dy(k) - else if (n == 0) then - dV = dx(j) - end if - do i = 1, num_fluids - if (q_prim_vf(E_idx + i)%sf(j,k,l) .gt. 0.6) then - vol_fluid(i) = vol_fluid(i)+q_prim_vf(E_idx + i)%sf(j,k,l)*dV - end if - if (p > 0) then - ms(i) = ms(i) + q_prim_vf(i)%sf(j,k,l)*dV - xm(i) = xm(i) + q_prim_vf(i)%sf(j,k,l)*dV*x_cc(j) - ym(i) = ym(i) + q_prim_vf(i)%sf(j,k,l)*dV*y_cc(k) - ! zm(i) = zm(i) + q_prim_vf(i)%sf(j,k,l)*dV*z_cc(l) - else if (p == 0 .and.& - q_prim_vf(E_idx + 2)%sf(j,k,l) > 0.9) then - ms(i) = ms(i) + q_prim_vf(i)%sf(j,k,l)*dV - xm(i) = xm(i) + q_prim_vf(i)%sf(j,k,l)*dV*x_cc(j) - ym(i) = ym(i) + q_prim_vf(i)%sf(j,k,l)*dV*y_cc(k) - end if - end do - end do - end do - end do - do i = 1,num_fluids - if (num_procs > 1) then + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + integer :: i, j, k, l !< Generic loop iterators + real(kind(0d0)), dimension(num_fluids), intent(OUT) :: vol_fluid + real(kind(0d0)), dimension(num_fluids) :: ms, ym, xm, zm + real(kind(0d0)), dimension(num_fluids), intent(OUT) :: xcom, ycom + real(kind(0d0)) :: ybeg, xend, xbeg, zbeg, zend, tmp, dV, yend + + xm = 0d0 + ms = 0d0 + ym = 0d0 + ! zm = 0d0 + + do l = 0, p + do k = 0, n + do j = 0, m + if (p > 0) then + dV = dx(j)*dy(k)*dz(l) + else if (p == 0) then + dV = dx(j)*dy(k) + else if (n == 0) then + dV = dx(j) + end if + do i = 1, num_fluids + if (q_prim_vf(E_idx + i)%sf(j, k, l) > 0.6) then + vol_fluid(i) = vol_fluid(i) + q_prim_vf(E_idx + i)%sf(j, k, l)*dV + end if + if (p > 0) then + ms(i) = ms(i) + q_prim_vf(i)%sf(j, k, l)*dV + xm(i) = xm(i) + q_prim_vf(i)%sf(j, k, l)*dV*x_cc(j) + ym(i) = ym(i) + q_prim_vf(i)%sf(j, k, l)*dV*y_cc(k) + ! zm(i) = zm(i) + q_prim_vf(i)%sf(j,k,l)*dV*z_cc(l) + else if (p == 0 .and. & + q_prim_vf(E_idx + 2)%sf(j, k, l) > 0.9) then + ms(i) = ms(i) + q_prim_vf(i)%sf(j, k, l)*dV + xm(i) = xm(i) + q_prim_vf(i)%sf(j, k, l)*dV*x_cc(j) + ym(i) = ym(i) + q_prim_vf(i)%sf(j, k, l)*dV*y_cc(k) + end if + end do + end do + end do + end do + do i = 1, num_fluids + if (num_procs > 1) then tmp = vol_fluid(i) call s_mpi_allreduce_sum(tmp, vol_fluid(i)) - if (p > 0) then - tmp = xm(i) - call s_mpi_allreduce_sum(tmp, xm(i)) - tmp = ym(i) - ! call s_mpi_allreduce_sum(tmp, ym(i)) - ! tmp = zm(i) - ! call s_mpi_allreduce_sum(tmp,zm(i)) - tmp = ms(i) - call s_mpi_allreduce_sum(tmp, ms(i)) - ! call s_mpi_allreduce_min(minval(x_cb(-1:m)), xbeg) - ! call s_mpi_allreduce_max(maxval(x_cb(-1:m)), xend) - ! call s_mpi_allreduce_min(minval(y_cb(-1:n)), ybeg) - ! call s_mpi_allreduce_max(maxval(y_cb(-1:n)), yend) - ! call s_mpi_allreduce_min(minval(z_cb(-1:p)), zbeg) - ! call s_mpi_allreduce_max(maxval(z_cb(-1:p)), zend) - else if (p == 0) then - tmp = xm(i) - call s_mpi_allreduce_sum(tmp, xm(i)) - tmp = ym(i) - ! call s_mpi_allreduce_sum(tmp, ym(i)) - tmp = ms(i) - call s_mpi_allreduce_sum(tmp, ms(i)) - ! call s_mpi_allreduce_min(minval(x_cb(-1:m)), xbeg) - ! call s_mpi_allreduce_max(maxval(x_cb(-1:m)), xend) - ! call s_mpi_allreduce_min(minval(y_cb(-1:n)), ybeg) - ! call s_mpi_allreduce_max(maxval(y_cb(-1:n)), yend) - end if - end if - - ! if (p > 1) then - ! xcom(i) = xm(i)/ms(i) - ycom(i) = 0d0 - ! zcom(i) = zm(i)/ms(i) - ! if (bc_x_glb%beg == -2) then + if (p > 0) then + tmp = xm(i) + call s_mpi_allreduce_sum(tmp, xm(i)) + tmp = ym(i) + ! call s_mpi_allreduce_sum(tmp, ym(i)) + ! tmp = zm(i) + ! call s_mpi_allreduce_sum(tmp,zm(i)) + tmp = ms(i) + call s_mpi_allreduce_sum(tmp, ms(i)) + ! call s_mpi_allreduce_min(minval(x_cb(-1:m)), xbeg) + ! call s_mpi_allreduce_max(maxval(x_cb(-1:m)), xend) + ! call s_mpi_allreduce_min(minval(y_cb(-1:n)), ybeg) + ! call s_mpi_allreduce_max(maxval(y_cb(-1:n)), yend) + ! call s_mpi_allreduce_min(minval(z_cb(-1:p)), zbeg) + ! call s_mpi_allreduce_max(maxval(z_cb(-1:p)), zend) + else if (p == 0) then + tmp = xm(i) + call s_mpi_allreduce_sum(tmp, xm(i)) + tmp = ym(i) + ! call s_mpi_allreduce_sum(tmp, ym(i)) + tmp = ms(i) + call s_mpi_allreduce_sum(tmp, ms(i)) + ! call s_mpi_allreduce_min(minval(x_cb(-1:m)), xbeg) + ! call s_mpi_allreduce_max(maxval(x_cb(-1:m)), xend) + ! call s_mpi_allreduce_min(minval(y_cb(-1:n)), ybeg) + ! call s_mpi_allreduce_max(maxval(y_cb(-1:n)), yend) + end if + end if + + ! if (p > 1) then + ! xcom(i) = xm(i)/ms(i) + ycom(i) = 0d0 + ! zcom(i) = zm(i)/ms(i) + ! if (bc_x_glb%beg == -2) then ! ms(i) = 2*ms(i) - ! xcom(i) = xbeg - ! else if (bc_x_glb%end == -2) then + ! xcom(i) = xbeg + ! else if (bc_x_glb%end == -2) then ! ms(i) = 2*ms(i) ! xcom(i) = xend ! else if (bc_y_glb%beg == -2) then @@ -793,36 +780,34 @@ contains ! else if (bc_y_glb%end == -2) then ! ms(i) = 2*ms(i) ! ycom(i) = yend - ! else if (bc_z_glb%beg == -2) then - ! ms(i) = 2*ms(i) - ! zcom(i) = zbeg - ! else if (bc_z_glb%end == -2) then - ! ms(i) = 2*ms(i) - ! zcom(i) = zend - ! end if - ! else if (p == 0) then - xcom(i) = xm(i)/ms(i) - ! ycom(i) = ym(i)/ms(i) - ! if (bc_x_glb%beg == -2) then - ! ms(i) = 2*ms(i) - ! xcom(i) = xbeg - ! else if (bc_x_glb%end == -2) then - ! ms(i) = 2*ms(i) - ! xcom(i) = xend - ! else if (bc_y_glb%beg == -2) then - ! ms(i) = 2*ms(i) - ! ycom(i) = ybeg - ! else if (bc_y_glb%end == -2) then - ! ms(i) = 2*ms(i) - ! ycom(i) = yend - ! end if - ! end if - end do + ! else if (bc_z_glb%beg == -2) then + ! ms(i) = 2*ms(i) + ! zcom(i) = zbeg + ! else if (bc_z_glb%end == -2) then + ! ms(i) = 2*ms(i) + ! zcom(i) = zend + ! end if + ! else if (p == 0) then + xcom(i) = xm(i)/ms(i) + ! ycom(i) = ym(i)/ms(i) + ! if (bc_x_glb%beg == -2) then + ! ms(i) = 2*ms(i) + ! xcom(i) = xbeg + ! else if (bc_x_glb%end == -2) then + ! ms(i) = 2*ms(i) + ! xcom(i) = xend + ! else if (bc_y_glb%beg == -2) then + ! ms(i) = 2*ms(i) + ! ycom(i) = ybeg + ! else if (bc_y_glb%end == -2) then + ! ms(i) = 2*ms(i) + ! ycom(i) = yend + ! end if + ! end if + end do end subroutine s_calculate_COM - - !> The goal of this subroutine is to output the grid and !! conservative variables data files for given time-step. !! @param q_cons_vf Cell-average conservative variables @@ -1391,52 +1376,52 @@ contains end subroutine s_write_parallel_data_files ! --------------------------- !> This writes a formatted data file where the root processor - !! can write out the CoM information + !! can write out the CoM information !! @param t_step Current time-step !! @param q_com Center of mass information !! @param moments Higher moment information - subroutine s_write_com_files(t_step,c_mass) ! ------------------- + subroutine s_write_com_files(t_step, c_mass) ! ------------------- - integer, intent(in) :: t_step - real(kind(0d0)), dimension(num_fluids,5), intent(in) :: c_mass - integer :: i,j !< Generic loop iterator - real(kind(0d0)) :: nondim_time !< Non-dimensional time + integer, intent(in) :: t_step + real(kind(0d0)), dimension(num_fluids, 5), intent(in) :: c_mass + integer :: i, j !< Generic loop iterator + real(kind(0d0)) :: nondim_time !< Non-dimensional time - ! Non-dimensional time calculation - if (t_step_old /= dflt_int) then - nondim_time = real(t_step + t_step_old,kind(0d0))*dt - else - nondim_time = real(t_step,kind(0d0))*dt - end if + ! Non-dimensional time calculation + if (t_step_old /= dflt_int) then + nondim_time = real(t_step + t_step_old, kind(0d0))*dt + else + nondim_time = real(t_step, kind(0d0))*dt + end if - if (proc_rank == 0) then + if (proc_rank == 0) then if (n == 0) then ! 1D simulation - do i = 1, num_fluids ! Loop through fluids - write(i+120, '(6X,4F24.12)') & - nondim_time, & - c_mass(i,1), & - c_mass(i,2), & - c_mass(i,5) - end do + do i = 1, num_fluids ! Loop through fluids + write (i + 120, '(6X,4F24.12)') & + nondim_time, & + c_mass(i, 1), & + c_mass(i, 2), & + c_mass(i, 5) + end do elseif (p == 0) then ! 2D simulation - do i = 1, num_fluids ! Loop through fluids - write(i+120, '(6X,5F24.12)') & - nondim_time, & - c_mass(i,1), & - c_mass(i,2), & - c_mass(i,3), & - c_mass(i,5) - end do + do i = 1, num_fluids ! Loop through fluids + write (i + 120, '(6X,5F24.12)') & + nondim_time, & + c_mass(i, 1), & + c_mass(i, 2), & + c_mass(i, 3), & + c_mass(i, 5) + end do else ! 3D simulation - do i = 1, num_fluids ! Loop through fluids - write(i+120, '(6X,6F24.12)') & - nondim_time, & - c_mass(i,1), & - c_mass(i,2), & - c_mass(i,3), & - c_mass(i,4), & - c_mass(i,5) - end do + do i = 1, num_fluids ! Loop through fluids + write (i + 120, '(6X,6F24.12)') & + nondim_time, & + c_mass(i, 1), & + c_mass(i, 2), & + c_mass(i, 3), & + c_mass(i, 4), & + c_mass(i, 5) + end do end if end if end subroutine s_write_com_files ! ------------------------------------- @@ -1498,7 +1483,7 @@ contains logical :: trigger !< For integral quantities ! Non-dimensional time calculation - if (time_stepper == 23) then + if (time_stepper == 23) then nondim_time = mytime else if (t_step_old /= dflt_int) then @@ -1657,7 +1642,7 @@ contains call s_convert_to_mixture_variables(q_cons_vf, j - 2, k - 2, l, & rho, gamma, pi_inf, qv, & Re, G, fluid_pp(:)%G) - do s = 1, num_dims + do s = 1, num_dims vel(s) = q_cons_vf(cont_idx%end + s)%sf(j - 2, k - 2, l)/rho end do @@ -1698,7 +1683,7 @@ contains end if ! Compute mixture sound speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & - ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) + ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) end if end if @@ -1777,7 +1762,7 @@ contains end do end if end if - if (proc_rank == 0) then + if (proc_rank == 0) then if (n == 0) then if (bubbles .and. (num_fluids <= 2)) then if (qbmm) then @@ -1880,7 +1865,7 @@ contains rho, & vel(1), & pres - print*, 'time =', nondim_time, 'rho =', rho, 'pres =', pres + print *, 'time =', nondim_time, 'rho =', rho, 'pres =', pres end if else write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,'// & @@ -2068,33 +2053,28 @@ contains end subroutine s_close_run_time_information_file ! --------------------- - - !> Closes communication files + !> Closes communication files subroutine s_close_com_files() ! --------------------------------------- - integer :: i !< Generic loop iterator - do i = 1, num_fluids - close(i+120) - end do + integer :: i !< Generic loop iterator + do i = 1, num_fluids + close (i + 120) + end do end subroutine s_close_com_files ! ------------------------------------- subroutine s_close_sim_data_file() ! ----------------------- + ! Writing the footer of and closing the run-time information file + write (21519, '(A)') '----------------------------------------'// & + '----------------------------------------' + write (21519, '(A)') '' + write (21519, '(A)') '' + write (21519, '(A)') '========================================'// & + '========================================' + close (21519) - ! Writing the footer of and closing the run-time information file - write (21519, '(A)') '----------------------------------------'// & - '----------------------------------------' - write (21519, '(A)') '' - write (21519, '(A)') '' - write (21519, '(A)') '========================================'// & - '========================================' - close (21519) - - end subroutine s_close_sim_data_file !--------------------- - - - + end subroutine s_close_sim_data_file !--------------------- !> Closes probe files subroutine s_close_probe_files() ! ------------------------------------- @@ -2116,7 +2096,7 @@ contains integer :: i !< Generic loop iterator - allocate(c_mass(1:num_fluids,1:5)) + allocate (c_mass(1:num_fluids, 1:5)) ! Allocating/initializing ICFL, VCFL, CCFL and Rc stability criteria @:ALLOCATE(icfl_sf(0:m, 0:n, 0:p)) @@ -2156,8 +2136,8 @@ contains subroutine s_finalize_data_output_module() ! --------------------------- integer :: i !< Generic loop iterator - - deallocate(c_mass) + + deallocate (c_mass) ! Deallocating the ICFL, VCFL, CCFL, and Rc stability criteria @:DEALLOCATE(icfl_sf) diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index e1c5614d8c..e9ac8dabd0 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -28,9 +28,9 @@ module m_derived_variables implicit none private; public :: s_initialize_derived_variables_module, & - s_initialize_derived_variables, & - s_compute_derived_variables, & - s_finalize_derived_variables_module + s_initialize_derived_variables, & + s_compute_derived_variables, & + s_finalize_derived_variables_module !> @name Finite-difference coefficients !! Finite-difference (fd) coefficients in x-, y- and z-coordinate directions. @@ -82,7 +82,7 @@ subroutine s_initialize_derived_variables_module() ! ---------------------- end if end if end if - + end subroutine s_initialize_derived_variables_module ! -------------------- !> Allocate and open derived variables. Computing FD coefficients. @@ -107,12 +107,11 @@ subroutine s_initialize_derived_variables() ! ----------------------------- fd_number, fd_order) end if end if - + if (sim_data .and. proc_rank == 0) then - call s_open_sim_data_file() + call s_open_sim_data_file() end if - end subroutine s_initialize_derived_variables ! ----------------------------- !> Writes coherent body information, communication files, and probes. @@ -123,7 +122,7 @@ subroutine s_compute_derived_variables(q_prim_vf, t_step) ! -------------------- type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer :: i, j, k !< Generic loop iterators - + if (probe_wrt) then call s_derive_acceleration_component(1, q_prim_ts(0)%vf, & q_prim_ts(1)%vf, & @@ -160,14 +159,14 @@ subroutine s_compute_derived_variables(q_prim_vf, t_step) ! -------------------- end do end do end do - call s_derive_center_of_mass(q_prim_ts(3)%vf,c_mass) + call s_derive_center_of_mass(q_prim_ts(3)%vf, c_mass) call s_write_probe_files(t_step, q_cons_ts(1)%vf, accel_mag) - call s_write_com_files(t_step,c_mass) + call s_write_com_files(t_step, c_mass) end if if (sim_data) then - call s_write_sim_data_file(q_prim_vf, t_step) - endif + call s_write_sim_data_file(q_prim_vf, t_step) + end if end subroutine s_compute_derived_variables ! --------------------------- @@ -319,144 +318,144 @@ end subroutine s_derive_acceleration_component ! -------------------------- !> This subroutine is used together with the volume fraction !! model and when called upon, it computes the location of - !! of the center of mass for each fluid from the inputted + !! of the center of mass for each fluid from the inputted !! primitive variables, q_prim_vf. The computed location !! is then written to a formatted data file by the root process. !! @param q_prim_vf Primitive variables !! @param c_m Mass,x-location,y-location,z-location - subroutine s_derive_center_of_mass(q_vf,c_m) - type(scalar_field), dimension(sys_size), intent(IN) :: q_vf - real(kind(0d0)), dimension(1:num_fluids,1:5), intent(INOUT) :: c_m - integer :: i,j,k,l !< Generic loop iterators - real(kind(0d0)) :: tmp, tmp_out !< Temporary variable to store quantity for mpi_allreduce - real(kind(0d0)) :: dV !< Discrete cell volume - - do i = 1, num_fluids - do j = 1,5 - c_m(i,j) = 0.0d0 - end do - end do - - if (n == 0) then !1D simulation - do i = 1,num_fluids !Loop over individual fluids - do l = 0, p !Loop over grid - do k = 0, n - do j = 0, m - dV = dx(j) - ! Mass - c_m(i,1) = c_m(i,1) + q_vf(i)%sf(j,k,l)*dV - ! x-location weighted - c_m(i,2) = c_m(i,2) + q_vf(i)%sf(j,k,l)*dV*x_cc(j) - ! Volume fraction - c_m(i,5) = c_m(i,5) + q_vf(i+adv_idx%beg-1)%sf(j,k,l)*dV - end do - end do + subroutine s_derive_center_of_mass(q_vf, c_m) + type(scalar_field), dimension(sys_size), intent(IN) :: q_vf + real(kind(0d0)), dimension(1:num_fluids, 1:5), intent(INOUT) :: c_m + integer :: i, j, k, l !< Generic loop iterators + real(kind(0d0)) :: tmp, tmp_out !< Temporary variable to store quantity for mpi_allreduce + real(kind(0d0)) :: dV !< Discrete cell volume + + do i = 1, num_fluids + do j = 1, 5 + c_m(i, j) = 0.0d0 + end do + end do + + if (n == 0) then !1D simulation + do i = 1, num_fluids !Loop over individual fluids + do l = 0, p !Loop over grid + do k = 0, n + do j = 0, m + dV = dx(j) + ! Mass + c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV + ! x-location weighted + c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) + ! Volume fraction + c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 1)%sf(j, k, l)*dV end do + end do end do + end do elseif (p == 0) then !2D simulation - do i = 1,num_fluids !Loop over individual fluids - do l = 0, p !Loop over grid - do k = 0, n - do j = 0, m - dV = dx(j)*dy(k) - ! Mass - c_m(i,1) = c_m(i,1) + q_vf(i)%sf(j,k,l)*dV - ! x-location weighted - c_m(i,2) = c_m(i,2) + q_vf(i)%sf(j,k,l)*dV*x_cc(j) - ! y-location weighted - c_m(i,3) = c_m(i,3) + q_vf(i)%sf(j,k,l)*dV*y_cc(k) - ! Volume fraction - c_m(i,5) = c_m(i,5) + q_vf(i+adv_idx%beg-1)%sf(j,k,l)*dV - end do - end do + do i = 1, num_fluids !Loop over individual fluids + do l = 0, p !Loop over grid + do k = 0, n + do j = 0, m + dV = dx(j)*dy(k) + ! Mass + c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV + ! x-location weighted + c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) + ! y-location weighted + c_m(i, 3) = c_m(i, 3) + q_vf(i)%sf(j, k, l)*dV*y_cc(k) + ! Volume fraction + c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 1)%sf(j, k, l)*dV end do + end do end do + end do else !3D simulation - do i = 1, num_fluids !Loop over individual fluids - do l = 0, p !Loop over grid - do k = 0, n - do j = 0, m - dV = dx(j)*dy(k)*dz(l) - ! Mass - c_m(i,1) = c_m(i,1) + q_vf(i)%sf(j,k,l)*dV - ! x-location weighted - c_m(i,2) = c_m(i,2) + q_vf(i)%sf(j,k,l)*dV*x_cc(j) - ! y-location weighted - c_m(i,3) = c_m(i,3) + q_vf(i)%sf(j,k,l)*dV*y_cc(k) - ! z-location weighted - c_m(i,4) = c_m(i,4) + q_vf(i)%sf(j,k,l)*dV*z_cc(l) - ! Volume fraction - c_m(i,5) = c_m(i,5) + q_vf(i+adv_idx%beg-1)%sf(j,k,l)*dV - end do + do i = 1, num_fluids !Loop over individual fluids + do l = 0, p !Loop over grid + do k = 0, n + do j = 0, m + dV = dx(j)*dy(k)*dz(l) + ! Mass + c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV + ! x-location weighted + c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) + ! y-location weighted + c_m(i, 3) = c_m(i, 3) + q_vf(i)%sf(j, k, l)*dV*y_cc(k) + ! z-location weighted + c_m(i, 4) = c_m(i, 4) + q_vf(i)%sf(j, k, l)*dV*z_cc(l) + ! Volume fraction + c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 1)%sf(j, k, l)*dV end do - end do - end do - end if - if (n == 0) then !1D simulation - do i = 1,num_fluids !Loop over individual fluids - ! Sum all components across all processors using MPI_ALLREDUCE - if (num_procs > 1) then - tmp = c_m(i,1) - call s_mpi_allreduce_sum(tmp,tmp_out) - c_m(i,1) = tmp_out - tmp = c_m(i,2) - call s_mpi_allreduce_sum(tmp,tmp_out) - c_m(i,2) = tmp_out - tmp = c_m(i,5) - call s_mpi_allreduce_sum(tmp,tmp_out) - c_m(i,5) = tmp_out - end if - ! Compute quotients - c_m(i,2) = c_m(i,2)/c_m(i,1) - end do - elseif (p == 0) then !2D simulation - do i = 1,num_fluids !Loop over individual fluids - ! Sum all components across all processors using MPI_ALLREDUCE - if (num_procs > 1) then - tmp = c_m(i,1) - call s_mpi_allreduce_sum(tmp,tmp_out) - c_m(i,1) = tmp_out - tmp = c_m(i,2) - call s_mpi_allreduce_sum(tmp,tmp_out) - c_m(i,2) = tmp_out - tmp = c_m(i,3) - call s_mpi_allreduce_sum(tmp,tmp_out) - c_m(i,3) = tmp_out - tmp = c_m(i,5) - call s_mpi_allreduce_sum(tmp,tmp_out) - c_m(i,5) = tmp_out - end if - ! Compute quotients - c_m(i,2) = c_m(i,2)/c_m(i,1) - c_m(i,3) = c_m(i,3)/c_m(i,1) + end do end do - else !3D simulation - do i = 1, num_fluids !Loop over individual fluids - ! Sum all components across all processors using MPI_ALLREDUCE - if (num_procs > 1) then - tmp = c_m(i,1) - call s_mpi_allreduce_sum(tmp,tmp_out) - c_m(i,1) = tmp_out - tmp = c_m(i,2) - call s_mpi_allreduce_sum(tmp,tmp_out) - c_m(i,2) = tmp_out - tmp = c_m(i,3) - call s_mpi_allreduce_sum(tmp,tmp_out) - c_m(i,3) = tmp_out - tmp = c_m(i,4) - call s_mpi_allreduce_sum(tmp,tmp_out) - c_m(i,4) = tmp_out - tmp = c_m(i,5) - call s_mpi_allreduce_sum(tmp,tmp_out) - c_m(i,5) = tmp_out - end if - ! Compute quotients - c_m(i,2) = c_m(i,2)/c_m(i,1) - c_m(i,3) = c_m(i,3)/c_m(i,1) - c_m(i,4) = c_m(i,4)/c_m(i,1) - end do - end if - + end do + end if + if (n == 0) then !1D simulation + do i = 1, num_fluids !Loop over individual fluids + ! Sum all components across all processors using MPI_ALLREDUCE + if (num_procs > 1) then + tmp = c_m(i, 1) + call s_mpi_allreduce_sum(tmp, tmp_out) + c_m(i, 1) = tmp_out + tmp = c_m(i, 2) + call s_mpi_allreduce_sum(tmp, tmp_out) + c_m(i, 2) = tmp_out + tmp = c_m(i, 5) + call s_mpi_allreduce_sum(tmp, tmp_out) + c_m(i, 5) = tmp_out + end if + ! Compute quotients + c_m(i, 2) = c_m(i, 2)/c_m(i, 1) + end do + elseif (p == 0) then !2D simulation + do i = 1, num_fluids !Loop over individual fluids + ! Sum all components across all processors using MPI_ALLREDUCE + if (num_procs > 1) then + tmp = c_m(i, 1) + call s_mpi_allreduce_sum(tmp, tmp_out) + c_m(i, 1) = tmp_out + tmp = c_m(i, 2) + call s_mpi_allreduce_sum(tmp, tmp_out) + c_m(i, 2) = tmp_out + tmp = c_m(i, 3) + call s_mpi_allreduce_sum(tmp, tmp_out) + c_m(i, 3) = tmp_out + tmp = c_m(i, 5) + call s_mpi_allreduce_sum(tmp, tmp_out) + c_m(i, 5) = tmp_out + end if + ! Compute quotients + c_m(i, 2) = c_m(i, 2)/c_m(i, 1) + c_m(i, 3) = c_m(i, 3)/c_m(i, 1) + end do + else !3D simulation + do i = 1, num_fluids !Loop over individual fluids + ! Sum all components across all processors using MPI_ALLREDUCE + if (num_procs > 1) then + tmp = c_m(i, 1) + call s_mpi_allreduce_sum(tmp, tmp_out) + c_m(i, 1) = tmp_out + tmp = c_m(i, 2) + call s_mpi_allreduce_sum(tmp, tmp_out) + c_m(i, 2) = tmp_out + tmp = c_m(i, 3) + call s_mpi_allreduce_sum(tmp, tmp_out) + c_m(i, 3) = tmp_out + tmp = c_m(i, 4) + call s_mpi_allreduce_sum(tmp, tmp_out) + c_m(i, 4) = tmp_out + tmp = c_m(i, 5) + call s_mpi_allreduce_sum(tmp, tmp_out) + c_m(i, 5) = tmp_out + end if + ! Compute quotients + c_m(i, 2) = c_m(i, 2)/c_m(i, 1) + c_m(i, 3) = c_m(i, 3)/c_m(i, 1) + c_m(i, 4) = c_m(i, 4)/c_m(i, 1) + end do + end if + end subroutine s_derive_center_of_mass ! ---------------------------------- !> Deallocation procedures for the module @@ -476,7 +475,6 @@ subroutine s_finalize_derived_variables_module() ! ------------------- end if end if - if (probe_wrt) then deallocate (accel_mag, x_accel) if (n > 0) then diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index 9efbf5c2c7..90d70fa4dd 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -123,36 +123,36 @@ contains !! remaining processors in the communicator. subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root) - + #ifdef MFC_MPI - implicit none - integer, intent(in) :: counts ! Array of vector lengths for each process - real(kind(0d0)), intent(in), dimension(counts) :: my_vector ! Input vector on each process - integer, intent(in) :: root ! Rank of the root process - real(kind(0d0)), allocatable, intent(out) :: gathered_vector(:) ! Gathered vector on the root process + implicit none + integer, intent(in) :: counts ! Array of vector lengths for each process + real(kind(0d0)), intent(in), dimension(counts) :: my_vector ! Input vector on each process + integer, intent(in) :: root ! Rank of the root process + real(kind(0d0)), allocatable, intent(out) :: gathered_vector(:) ! Gathered vector on the root process - integer :: i, offset, ierr - integer, allocatable :: recounts(:), displs(:) + integer :: i, offset, ierr + integer, allocatable :: recounts(:), displs(:) - allocate(recounts(num_procs)) + allocate (recounts(num_procs)) - call MPI_GATHER(counts, 1, MPI_INTEGER, recounts, 1, MPI_INTEGER, root, & - MPI_COMM_WORLD, ierr) + call MPI_GATHER(counts, 1, MPI_INTEGER, recounts, 1, MPI_INTEGER, root, & + MPI_COMM_WORLD, ierr) - allocate(displs(size(recounts))) + allocate (displs(size(recounts))) - displs(1) = 0 + displs(1) = 0 - do i = 2,size(recounts) - displs(i) = displs(i-1) + recounts(i-1) - end do + do i = 2, size(recounts) + displs(i) = displs(i - 1) + recounts(i - 1) + end do - allocate(gathered_vector(sum(recounts))) - call MPI_GATHERV(my_vector, counts, MPI_DOUBLE_PRECISION, gathered_vector,recounts, displs, MPI_DOUBLE_PRECISION, & - root, MPI_COMM_WORLD, ierr) + allocate (gathered_vector(sum(recounts))) + call MPI_GATHERV(my_vector, counts, MPI_DOUBLE_PRECISION, gathered_vector, recounts, displs, MPI_DOUBLE_PRECISION, & + root, MPI_COMM_WORLD, ierr) #endif - end subroutine s_mpi_gather_data + end subroutine s_mpi_gather_data subroutine s_mpi_bcast_user_inputs() ! --------------------------------- diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 2d9e214843..d482d0ab53 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -213,9 +213,9 @@ contains ! Opening and writing the header of the run-time information file if (proc_rank == 0 .and. run_time_info) then - call s_open_run_time_information_file() + call s_open_run_time_information_file() end if - + end subroutine s_initialize_time_steppers_module ! --------------------- !> 1st order TVD RK time-stepping algorithm diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index 106be3f9dc..8fc4523f82 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -55,7 +55,7 @@ program p_main ! Time-stepping Loop ======================================================= do - if (t_step > t_step_stop) then + if (t_step > t_step_stop) then call s_save_performance_metrics(t_step, time_avg, time_final, io_time_avg, & io_time_final, proc_time, io_proc_time, file_exists, start, finish, nt) exit From 12fed2b9aa9250e069f2fb529c27e7fd827a7b27 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 1 Mar 2024 21:28:19 -0600 Subject: [PATCH 018/380] added GPU memory to the mako file --- toolchain/templates/delta.mako | 2 ++ 1 file changed, 2 insertions(+) diff --git a/toolchain/templates/delta.mako b/toolchain/templates/delta.mako index 7416c5a704..4230f3711e 100644 --- a/toolchain/templates/delta.mako +++ b/toolchain/templates/delta.mako @@ -16,6 +16,8 @@ % endif % if gpu: #SBATCH --gpus-per-node=${tasks_per_node} +#SBATCH --mem=208G +#SBATCH --gpu-bind=closest % endif #SBATCH --output="${name}.out" #SBATCH --error="${name}.err" From 8e2dd85c2139f4b53f77e520c7bce1d159145b75 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Mon, 4 Mar 2024 13:54:59 -0500 Subject: [PATCH 019/380] cleaning up interface outputting --- src/simulation/m_data_output.fpp | 81 ++++++++++++++++---------------- 1 file changed, 41 insertions(+), 40 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index e58c4593ed..6d691598d7 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -503,62 +503,63 @@ contains type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer, intent(IN) :: t_step integer :: i, j, k, l, w !< Generic loop iterators - integer :: ierr, counter, counter2, counter3, root !< number of data points extracted to fit shape to SH perturbations + integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations - real(kind(0d0)) :: u, m_a_x, m_a_y, m_a_z, eps - real(kind(0d0)), dimension(0:m, 0:n) :: d_alpha_x, d_magdalphax, d_magdalphay, f_NS, rho, alpha_rhob - real(kind(0d0)), dimension(0:m, 0:n) :: d_alpha_y, mag_d_alpha, d_rho_x, d_rho_y, mag_d_rho, alpha_b - real(kind(0d0)), dimension(0:m, 0:n, 0:p) :: d_alph_mpi_barrier_x3, d_alpha_y3, d_alpha_z3 - real(kind(0d0)) :: xdv, ydv, mag_d_alpha3, nondim_time, alphaxm, alphaxp, alphaym, alphayp + real(kind(0d0)) :: u, eps + real(kind(0d0)), dimension(0:m, 0:n) :: rho + real(kind(0d0)) :: nondim_time real(kind(0d0)), dimension(num_fluids) :: alpha, vol_fluid, xcom, ycom, zcom - real(kind(0d0)) :: alpha_t, concavity_x_prior, concavity_x_post, concavity_y_prior, concavity_y_post - real(kind(0d0)), allocatable :: q(:), maxdalphy(:), maxdalphx(:) real(kind=8), parameter :: pi = 4.d0*datan(1.d0) - real(kind(0d0)), allocatable :: x_td(:), y_td(:), x_tdf(:), y_tdf(:), x_d1(:), y_d1(:), y_d(:), x_d(:) + real(kind(0d0)), allocatable :: x_td(:), y_td(:), x_d1(:), y_d1(:), y_d(:), x_d(:) - real(kind(0d0)) :: axp, axm, ayp, aym + real(kind(0d0)) :: axp, axm, ayp, aym, azm, azp call s_calculate_COM(q_prim_vf, xcom, ycom, vol_fluid) if (t_step_old /= dflt_int) then nondim_time = real(t_step + t_step_old, kind(0d0))*dt else - nondim_time = real(t_step, kind(0d0))*dt !*1.d-5/10.0761131451d0 + nondim_time = real(t_step, kind(0d0))*dt end if root = 0 allocate (x_d1(m*n)) allocate (y_d1(m*n)) counter = 0 - do k = 0, n - OLoop: do j = 0, m - axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, 0) - axm = q_prim_vf(E_idx + 2)%sf(j - 1, k, 0) - ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, 0) - aym = q_prim_vf(E_idx + 2)%sf(j, k - 1, 0) - - if ((axp > 0.9 .and. axm < 0.9) .or. (axp < 0.9 .and. axm > 0.9) & - .or. (ayp > 0.9 .and. aym < 0.9) .or. (ayp < 0.9 .and. aym > 0.9)) then - if (counter == 0) then - counter = counter + 1 - x_d1(counter) = x_cc(j) - y_d1(counter) = y_cc(k) - else - do i = 1, counter - if (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & - y_d1(i))**2) <= 2*sqrt(dx(j)**2 & - + dy(k)**2)) then - cycle OLoop - elseif (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & - y_d1(i))**2) > 2*sqrt(dx(j)**2 & - + dy(k)**2) .and. i == counter) then - counter = counter + 1 - x_d1(counter) = x_cc(j) - y_d1(counter) = y_cc(k) - end if - end do + do l = 0, p + do k = 0, n + OLoop: do j = 0, m + axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, 0) + axm = q_prim_vf(E_idx + 2)%sf(j - 1, k, 0) + ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, 0) + aym = q_prim_vf(E_idx + 2)%sf(j, k - 1, 0) + azm = q_prim_vf(E_idx + 2)%sf(j, k, p - 1) + azp = q_prim_vf(E_idx + 2)%sf(j, k, p + 1) + + + if ((axp > 0.9 .and. axm < 0.9) .or. (axp < 0.9 .and. axm > 0.9) & + .or. (ayp > 0.9 .and. aym < 0.9) .or. (ayp < 0.9 .and. aym > 0.9)) then + if (counter == 0) then + counter = counter + 1 + x_d1(counter) = x_cc(j) + y_d1(counter) = y_cc(k) + else + do i = 1, counter + if (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & + y_d1(i))**2) <= 2*sqrt(dx(j)**2 & + + dy(k)**2)) then + cycle OLoop + elseif (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & + y_d1(i))**2) > 2*sqrt(dx(j)**2 & + + dy(k)**2) .and. i == counter) then + counter = counter + 1 + x_d1(counter) = x_cc(j) + y_d1(counter) = y_cc(k) + end if + end do + end if end if - end if - end do OLoop + end do OLoop + end do end do allocate (y_d(counter)) From f4341ea32011e18c2891c78cda3174be1eaaac43 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 4 Mar 2024 16:48:37 -0600 Subject: [PATCH 020/380] added some action items for hyperelasticity --- src/common/m_finger_matrix_calc.f90 | 32 +++++++++++++++++++++++++++ src/common/m_variables_conversion.fpp | 28 +++++++++++++++++++++-- 2 files changed, 58 insertions(+), 2 deletions(-) create mode 100644 src/common/m_finger_matrix_calc.f90 diff --git a/src/common/m_finger_matrix_calc.f90 b/src/common/m_finger_matrix_calc.f90 new file mode 100644 index 0000000000..c8e1cba1cb --- /dev/null +++ b/src/common/m_finger_matrix_calc.f90 @@ -0,0 +1,32 @@ +!> +!! @file m_variables_conversion.f90 +!! @brief Contains module m_variables_conversion + +#:include 'macros.fpp' +#:include 'inline_conversions.fpp' +#:include '../simulation/include/case.fpp' + +!> @brief This module consists of subroutines used in the conversion of the +!! conservative variables into the primitive ones and vice versa. In +!! addition, the module also contains the subroutines used to obtain +!! the mixture variables and the subroutines used to compute pressure. +module m_finger_matrix_calc + + ! Dependencies ============================================================= + use m_derived_types !< Definitions of the derived types + + use m_global_parameters !< Definitions of the global parameters + + use m_mpi_proxy !< Message passing interface (MPI) module proxy + + use m_helper + ! ========================================================================== + + implicit none + + + + + + +end module m_finger_matrix_calc diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 387832115f..3ca476d673 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -19,6 +19,8 @@ module m_variables_conversion use m_mpi_proxy !< Message passing interface (MPI) module proxy + use m_finger_matrix_calc !< Using finger matrix calculations + use m_helper ! ========================================================================== @@ -171,6 +173,12 @@ contains end if + if (hyperelasticity .and. present(G)) then + !TODO ADD CODE HERE + + end if + + end subroutine s_compute_pressure !> This subroutine is designed for the gamma/pi_inf model @@ -427,6 +435,7 @@ contains #endif if (present(G_K)) then + !TODO Check our mixture rule? Replace with Cauchy numbers, make code nondimensional G_K = 0d0 do i = 1, num_fluids G_K = G_K + alpha_K(i)*G(i) @@ -498,6 +507,7 @@ contains G_K = 0d0 do i = 1, num_fluids !TODO: change to use Gs directly here? + !TODO: Make this changes as well for GPUs G_K = G_K + alpha_K(i)*G(i) end do G_K = max(0d0, G_K) @@ -876,7 +886,7 @@ contains if (model_eqns /= 4) then #ifdef MFC_SIMULATION ! If in simulation, use acc mixture subroutines - if (hypoelasticity) then + if (hypoelasticity .or. hyperelasticity) then call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & alpha_rho_K, Re_K, j, k, l, G_K, Gs) else if (bubbles) then @@ -888,7 +898,7 @@ contains end if #else ! If pre-processing, use non acc mixture subroutines - if (hypoelasticity) then + if (hypoelasticity .or. hyperelasticity) then call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) else @@ -1124,6 +1134,20 @@ contains end if end do end if + + if (hyperelasticity) then + ! TODO ADD the e^e term contribution to the total energy equation here + ! Multiple functions need to be called for 3x3 matrix calculations at each cell + + ! PRECOMPUTATIONS TO CALCULATE \rho e^e = \rho (\frac{\mu}{4 \rho_0} \tr ((\hat(g) - I)^2)) + ! To do that, we need \hat(g), to get \hat(g), we need G^e + ! To get G^e, we need g_{ij}^e, we have this stored in q_cons_vf(i) where + ! i goes from stress_idx%beg to stress_idx%end + !do i = stress_idx%beg, stress_idx%end + ! q_cons_vf(E_idx)%sf(j,k,l) = q_cons_vf(E_idx)%sf(j,k,l) + & + ! stuff + end if + end do end do end do From 0ec87b7f0f991174809125cb7be4e7895e0ca2ad Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Tue, 5 Mar 2024 10:53:10 -0600 Subject: [PATCH 021/380] attempting to add 3D axissym data outputting capabilities --- src/simulation/m_data_output.fpp | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 6d691598d7..b3a2b1937b 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -502,7 +502,7 @@ contains type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer, intent(IN) :: t_step - integer :: i, j, k, l, w !< Generic loop iterators + integer :: i, j, k, l, w, cent !< Generic loop iterators integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations real(kind(0d0)) :: u, eps @@ -525,15 +525,22 @@ contains allocate (x_d1(m*n)) allocate (y_d1(m*n)) counter = 0 - do l = 0, p + if (mod(p, 2) > 0) then + cent = p/2 + 1/2 + elseif (mod(p, 2) == 0) then + cent = p/2 + 1/2 + elseif (p == 0) then + cent = 0 + endif + ! do l = 0, p do k = 0, n OLoop: do j = 0, m - axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, 0) - axm = q_prim_vf(E_idx + 2)%sf(j - 1, k, 0) - ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, 0) - aym = q_prim_vf(E_idx + 2)%sf(j, k - 1, 0) - azm = q_prim_vf(E_idx + 2)%sf(j, k, p - 1) - azp = q_prim_vf(E_idx + 2)%sf(j, k, p + 1) + axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) + axm = q_prim_vf(E_idx + 2)%sf(j - 1, k, cent) + ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, cent) + aym = q_prim_vf(E_idx + 2)%sf(j, k - 1, cent) + ! azm = q_prim_vf(E_idx + 2)%sf(j, k, p - 1) + ! azp = q_prim_vf(E_idx + 2)%sf(j, k, p + 1) if ((axp > 0.9 .and. axm < 0.9) .or. (axp < 0.9 .and. axm > 0.9) & @@ -560,7 +567,7 @@ contains end if end do OLoop end do - end do + ! end do allocate (y_d(counter)) allocate (x_d(counter)) From aa732d049b957c8f64138067bbf257338b292aa5 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Tue, 5 Mar 2024 11:24:32 -0600 Subject: [PATCH 022/380] code should work in 3D for outputting critical plane of data for perturbations, still yet to be tested --- src/pre_process/m_patches.fpp | 2 ++ src/simulation/m_data_output.fpp | 4 ---- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index dd10a5f7e5..7acb4d9240 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -1469,6 +1469,8 @@ contains P5 = unassociated_legendre(x_p, 5) P6 = unassociated_legendre(x_p, 6) P7 = unassociated_legendre(x_p, 7) + P8 = unassociated_legendre(x_p, 8) + P9 = unassociated_legendre(x_p, 9) end if if (x_cc(i) - x_centroid >= 0 & diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index b3a2b1937b..f0ba287c9b 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -532,15 +532,12 @@ contains elseif (p == 0) then cent = 0 endif - ! do l = 0, p do k = 0, n OLoop: do j = 0, m axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) axm = q_prim_vf(E_idx + 2)%sf(j - 1, k, cent) ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, cent) aym = q_prim_vf(E_idx + 2)%sf(j, k - 1, cent) - ! azm = q_prim_vf(E_idx + 2)%sf(j, k, p - 1) - ! azp = q_prim_vf(E_idx + 2)%sf(j, k, p + 1) if ((axp > 0.9 .and. axm < 0.9) .or. (axp < 0.9 .and. axm > 0.9) & @@ -567,7 +564,6 @@ contains end if end do OLoop end do - ! end do allocate (y_d(counter)) allocate (x_d(counter)) From 1cff718090d273efaa42ba5e5055c53fe7729e40 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 6 Mar 2024 13:08:38 -0600 Subject: [PATCH 023/380] added some stuff for finger tensor --- src/common/m_finger_matrix_calc.f90 | 32 ------------ src/common/m_finger_tensor_calc.f90 | 68 ++++++++++++++++++++++++++ src/simulation/m_global_parameters.fpp | 9 +++- 3 files changed, 76 insertions(+), 33 deletions(-) delete mode 100644 src/common/m_finger_matrix_calc.f90 create mode 100644 src/common/m_finger_tensor_calc.f90 diff --git a/src/common/m_finger_matrix_calc.f90 b/src/common/m_finger_matrix_calc.f90 deleted file mode 100644 index c8e1cba1cb..0000000000 --- a/src/common/m_finger_matrix_calc.f90 +++ /dev/null @@ -1,32 +0,0 @@ -!> -!! @file m_variables_conversion.f90 -!! @brief Contains module m_variables_conversion - -#:include 'macros.fpp' -#:include 'inline_conversions.fpp' -#:include '../simulation/include/case.fpp' - -!> @brief This module consists of subroutines used in the conversion of the -!! conservative variables into the primitive ones and vice versa. In -!! addition, the module also contains the subroutines used to obtain -!! the mixture variables and the subroutines used to compute pressure. -module m_finger_matrix_calc - - ! Dependencies ============================================================= - use m_derived_types !< Definitions of the derived types - - use m_global_parameters !< Definitions of the global parameters - - use m_mpi_proxy !< Message passing interface (MPI) module proxy - - use m_helper - ! ========================================================================== - - implicit none - - - - - - -end module m_finger_matrix_calc diff --git a/src/common/m_finger_tensor_calc.f90 b/src/common/m_finger_tensor_calc.f90 new file mode 100644 index 0000000000..36fa5498e8 --- /dev/null +++ b/src/common/m_finger_tensor_calc.f90 @@ -0,0 +1,68 @@ +!> +!! @file m_variables_conversion.f90 +!! @brief Contains module m_variables_conversion + +#:include 'macros.fpp' +#:include 'inline_conversions.fpp' +#:include '../simulation/include/case.fpp' + +!> @brief This module consists of subroutines used in the calculation of matrix +!! operations for the finger tensor + +module m_finger_tensor_calc + + ! Dependencies ============================================================= + use m_derived_types !< Definitions of the derived types + + use m_global_parameters !< Definitions of the global parameters + + use m_mpi_proxy !< Message passing interface (MPI) module proxy + + use m_helper + ! ========================================================================== + + implicit none + + private; + + public :: s_finger_tensor !variables ! name public variables for all of the subroutines + + contains + + subroutine s_allocate_tensor(q_cons_vf,j,k,l,tensor) + + type(scalar_field), dimension(sys_size), intent(IN) :: q_cons_vf + type(int_bounds_info), optional, intent(IN) :: j, k, l + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: tensor + + integer :: i !< Generic loop iterators + +#ifndef MFC_SIMULATION + ! Converting the primitive variables to the conservative variables + do i = 1, num_dims**2 + tensor(i) = q_cons_vf(stress_idx%beg+i-1)%sf(j,k,l) + end do +#endif + end subroutine s_allocate_tensor + + function s_calculate_determinant(tensor) + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: tensor + real(kind(0d0)) :: det + + det = + + return det + + end function s_calculate_determinant + + subroutine s_calculate_deviatoric(tensor,deviatoric) + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: tensor + + end subroutine s_calculate_deviatoric + + subroutine s_calculate_atransposea(tensor,tproduct) + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: tensor + + end subroutine s_calculate_atransposea + +end module m_finger_tensor_calc diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 9b795d4bd9..8087fce10e 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -577,7 +577,7 @@ contains if (model_eqns == 2) then cont_idx%beg = 1 cont_idx%end = num_fluids - mom_idx%beg = cont_idx%end + 1 + mom_idx%beg = cont_idx%end + mom_idx%end = cont_idx%end + num_dims E_idx = mom_idx%end + 1 adv_idx%beg = E_idx + 1 @@ -692,6 +692,13 @@ contains sys_size = stress_idx%end end if + if (hyperelasticity) then + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*num_dims) + ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end + end if + else if (model_eqns == 3) then cont_idx%beg = 1 cont_idx%end = num_fluids From 622b62bed0089050420976e5c1dca028b40fdb9b Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 6 Mar 2024 17:35:42 -0600 Subject: [PATCH 024/380] added more progress, not yet compiling --- src/common/m_finger_tensor_calc.f90 | 16 ++++++++++++---- src/simulation/m_global_parameters.fpp | 12 +++++++----- 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/src/common/m_finger_tensor_calc.f90 b/src/common/m_finger_tensor_calc.f90 index 36fa5498e8..0a82e8f97f 100644 --- a/src/common/m_finger_tensor_calc.f90 +++ b/src/common/m_finger_tensor_calc.f90 @@ -49,19 +49,27 @@ function s_calculate_determinant(tensor) real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: tensor real(kind(0d0)) :: det - det = + if num_dims .eq. 1 then + det = tensor(1) ! does this make sense? + elseif num_dims .eq. 2 then + det = tensor(1)*tensor(4) - tensor(2)*tensor(3) + else + det = tensor(1)*(tensor(2)*tensor(3) + end if return det end function s_calculate_determinant subroutine s_calculate_deviatoric(tensor,deviatoric) - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: tensor + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: deviatoric - end subroutine s_calculate_deviatoric + end subroutine s_calculate_deviatoric subroutine s_calculate_atransposea(tensor,tproduct) - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: tensor + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: tproduct end subroutine s_calculate_atransposea diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 8087fce10e..af27d67094 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -120,9 +120,10 @@ module m_global_parameters real(kind(0d0)) :: palpha_eps !< trigger parameter for the p relaxation procedure, phase change model real(kind(0d0)) :: ptgalpha_eps !< trigger parameter for the pTg relaxation procedure, phase change model logical :: alt_soundspeed !< Alternate mixture sound speed - logical :: null_weights !< Null undesired WENO weights - logical :: mixture_err !< Mixture properties correction - logical :: hypoelasticity !< hypoelasticity modeling + logical :: null_weights !< Null undesired WENO weights + logical :: mixture_err !< Mixture properties correction + logical :: hypoelasticity !< hypoelasticity modeling + logical :: hyperelasticity !< hyperelasticity modeling logical :: cu_tensor integer :: cpu_start, cpu_end, cpu_rate @@ -406,6 +407,7 @@ contains palpha_eps = dflt_real ptgalpha_eps = dflt_real hypoelasticity = .false. + hyperelasticity = .false. weno_flat = .true. riemann_flat = .true. cu_mpi = .false. @@ -693,9 +695,9 @@ contains end if if (hyperelasticity) then + ! number of distinct stress is 1 in 1D, 6 in 2D, and 9 in 3D stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*num_dims) - ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D + stress_idx%end = sys_size + num_dims**2 sys_size = stress_idx%end end if From 2a9bd1de2a1a0eb9843bff8a15c521800fd14111 Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Wed, 6 Mar 2024 17:47:25 -0600 Subject: [PATCH 025/380] added hyperelasticity option to src/post&pre/m_global_params --- src/post_process/m_global_parameters.fpp | 9 +++++++++ src/pre_process/m_global_parameters.fpp | 9 +++++++++ 2 files changed, 18 insertions(+) diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index e50f7b4b2c..7e020ed0ea 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -93,6 +93,7 @@ module m_global_parameters logical :: mixture_err !< Mixture error limiter logical :: alt_soundspeed !< Alternate sound speed logical :: hypoelasticity !< Turn hypoelasticity on + logical :: hyperelasticity !< Turn hyperelasticity on !> @} !> @name Annotations of the structure, i.e. the organization, of the state vectors @@ -275,7 +276,9 @@ contains alt_soundspeed = .false. relax = .false. relax_model = dflt_int + hypoelasticity = .false. + hyperelastictiy = .false. bc_x%beg = dflt_int; bc_x%end = dflt_int bc_y%beg = dflt_int; bc_y%end = dflt_int @@ -472,6 +475,12 @@ contains sys_size = stress_idx%end end if + if (hyperelasticity) then + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + num_dims**2 + sys_size = stress_idx%end + end if + ! ================================================================== ! Volume Fraction Model (6-equation model) ========================= diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index e36a586b94..fd4bd9024e 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -84,6 +84,7 @@ module m_global_parameters integer :: sys_size !< Number of unknowns in the system of equations integer :: weno_order !< Order of accuracy for the WENO reconstruction logical :: hypoelasticity !< activate hypoelasticity + logical :: hyperelasticity !< activate hyperelasticity ! Annotations of the structure, i.e. the organization, of the state vectors type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. @@ -272,6 +273,7 @@ contains weno_order = dflt_int hypoelasticity = .false. + hyperelasticity = .false. bc_x%beg = dflt_int; bc_x%end = dflt_int bc_y%beg = dflt_int; bc_y%end = dflt_int @@ -576,6 +578,13 @@ contains sys_size = stress_idx%end end if + if (hyperelasticity) then + ! number of distinct stress is 1 in 1D, 6 in 2D, and 9 in 3D + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + num_dims**2 + sys_size = stress_idx%end + end if + ! ================================================================== ! Volume Fraction Model (6-equation model) ========================= From aeefbeaa7262516e03825302540df14b3873bcc1 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 6 Mar 2024 18:16:42 -0600 Subject: [PATCH 026/380] debugging towards compilation --- src/common/m_finger_tensor_calc.f90 | 32 +++++++++++---------------- src/common/m_variables_conversion.fpp | 8 +++---- 2 files changed, 17 insertions(+), 23 deletions(-) diff --git a/src/common/m_finger_tensor_calc.f90 b/src/common/m_finger_tensor_calc.f90 index 0a82e8f97f..e707a212eb 100644 --- a/src/common/m_finger_tensor_calc.f90 +++ b/src/common/m_finger_tensor_calc.f90 @@ -2,10 +2,6 @@ !! @file m_variables_conversion.f90 !! @brief Contains module m_variables_conversion -#:include 'macros.fpp' -#:include 'inline_conversions.fpp' -#:include '../simulation/include/case.fpp' - !> @brief This module consists of subroutines used in the calculation of matrix !! operations for the finger tensor @@ -23,16 +19,16 @@ module m_finger_tensor_calc implicit none - private; - - public :: s_finger_tensor !variables ! name public variables for all of the subroutines - + private; public :: s_allocate_tensor, & + f_determinant, & + s_calculate_deviatoric, & + s_calculate_atransposea contains subroutine s_allocate_tensor(q_cons_vf,j,k,l,tensor) type(scalar_field), dimension(sys_size), intent(IN) :: q_cons_vf - type(int_bounds_info), optional, intent(IN) :: j, k, l + integer, intent(IN) :: j, k, l real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: tensor integer :: i !< Generic loop iterators @@ -45,21 +41,19 @@ subroutine s_allocate_tensor(q_cons_vf,j,k,l,tensor) #endif end subroutine s_allocate_tensor - function s_calculate_determinant(tensor) + function f_determinant(tensor) real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: tensor - real(kind(0d0)) :: det + real(kind(0d0)) :: f_determinant - if num_dims .eq. 1 then - det = tensor(1) ! does this make sense? - elseif num_dims .eq. 2 then - det = tensor(1)*tensor(4) - tensor(2)*tensor(3) + if (num_dims .eq. 1) then + f_determinant = tensor(1) ! does this make sense? + elseif (num_dims .eq. 2) then + f_determinant = tensor(1)*tensor(4) - tensor(2)*tensor(3) else - det = tensor(1)*(tensor(2)*tensor(3) + f_determinant = tensor(1)*(tensor(2)*tensor(3)) end if - return det - - end function s_calculate_determinant + end function f_determinant subroutine s_calculate_deviatoric(tensor,deviatoric) real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 3ca476d673..60e4a97e5b 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -19,7 +19,7 @@ module m_variables_conversion use m_mpi_proxy !< Message passing interface (MPI) module proxy - use m_finger_matrix_calc !< Using finger matrix calculations + use m_finger_tensor_calc !< Using finger matrix calculations use m_helper ! ========================================================================== @@ -173,10 +173,10 @@ contains end if - if (hyperelasticity .and. present(G)) then + !if (hyperelasticity .and. present(G)) then !TODO ADD CODE HERE - end if + !end if end subroutine s_compute_pressure @@ -898,7 +898,7 @@ contains end if #else ! If pre-processing, use non acc mixture subroutines - if (hypoelasticity .or. hyperelasticity) then + if (hypoelasticity) then ! .or. hyperelasticity) then call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) else From 35ffe0122e7c173cafe900371f2f52aac9a3d927 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 6 Mar 2024 18:19:23 -0600 Subject: [PATCH 027/380] merged changes, compiling but early code --- src/common/m_finger_tensor_calc.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/common/m_finger_tensor_calc.f90 b/src/common/m_finger_tensor_calc.f90 index e707a212eb..5e15cedb71 100644 --- a/src/common/m_finger_tensor_calc.f90 +++ b/src/common/m_finger_tensor_calc.f90 @@ -23,6 +23,7 @@ module m_finger_tensor_calc f_determinant, & s_calculate_deviatoric, & s_calculate_atransposea + contains subroutine s_allocate_tensor(q_cons_vf,j,k,l,tensor) From 95ea23e50d87fff773dc5fbe9119fd915ae01bf5 Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Wed, 6 Mar 2024 18:52:20 -0600 Subject: [PATCH 028/380] completed det function --- src/common/m_finger_tensor_calc.f90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/common/m_finger_tensor_calc.f90 b/src/common/m_finger_tensor_calc.f90 index 5e15cedb71..b5e410a855 100644 --- a/src/common/m_finger_tensor_calc.f90 +++ b/src/common/m_finger_tensor_calc.f90 @@ -51,9 +51,11 @@ function f_determinant(tensor) elseif (num_dims .eq. 2) then f_determinant = tensor(1)*tensor(4) - tensor(2)*tensor(3) else - f_determinant = tensor(1)*(tensor(2)*tensor(3)) - end if - + f_determinant = tensor(1)*(tensor(5)*tensor(9) - tensor(6)*tensor(8)) + - tensor(2)*(tensor(4)*tensor(9) - tensor(6)*tensor(7)) + + tensor(3)*(tensor(4)*tensor(8) - tensor(5)*tensor(7)) + end if + end function f_determinant subroutine s_calculate_deviatoric(tensor,deviatoric) From aa32741803264f439cb641b056807d7fdb954276 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 7 Mar 2024 14:37:51 -0600 Subject: [PATCH 029/380] added the matrix calculations --- src/common/m_finger_tensor_calc.f90 | 55 ++++++++++++++++++++------ src/common/m_variables_conversion.fpp | 25 ++++++++++-- src/simulation/m_global_parameters.fpp | 2 +- 3 files changed, 66 insertions(+), 16 deletions(-) diff --git a/src/common/m_finger_tensor_calc.f90 b/src/common/m_finger_tensor_calc.f90 index b5e410a855..a6547705ae 100644 --- a/src/common/m_finger_tensor_calc.f90 +++ b/src/common/m_finger_tensor_calc.f90 @@ -34,25 +34,23 @@ subroutine s_allocate_tensor(q_cons_vf,j,k,l,tensor) integer :: i !< Generic loop iterators -#ifndef MFC_SIMULATION ! Converting the primitive variables to the conservative variables do i = 1, num_dims**2 tensor(i) = q_cons_vf(stress_idx%beg+i-1)%sf(j,k,l) end do -#endif end subroutine s_allocate_tensor function f_determinant(tensor) - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: tensor + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor real(kind(0d0)) :: f_determinant if (num_dims .eq. 1) then - f_determinant = tensor(1) ! does this make sense? + f_determinant = tensor(1) ! TODO: Mirelys: does this make sense? elseif (num_dims .eq. 2) then f_determinant = tensor(1)*tensor(4) - tensor(2)*tensor(3) else - f_determinant = tensor(1)*(tensor(5)*tensor(9) - tensor(6)*tensor(8)) - - tensor(2)*(tensor(4)*tensor(9) - tensor(6)*tensor(7)) + f_determinant = tensor(1)*(tensor(5)*tensor(9) - tensor(6)*tensor(8)) & + - tensor(2)*(tensor(4)*tensor(9) - tensor(6)*tensor(7)) & + tensor(3)*(tensor(4)*tensor(8) - tensor(5)*tensor(7)) end if @@ -61,13 +59,46 @@ end function f_determinant subroutine s_calculate_deviatoric(tensor,deviatoric) real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: deviatoric - - end subroutine s_calculate_deviatoric - - subroutine s_calculate_atransposea(tensor,tproduct) + real(kind(0d0)) :: trace13 + + deviatoric = tensor + trace13 = tensor(1) + if (num_dims .eq. 2) then + trace13 = trace13 + tensor(4) + elseif (num_dims .eq. 3) then + trace13 = trace13 + tensor(5) + tensor(9) + end if + trace13 = (1.0/3.0)*trace13 + deviatoric(1) = tensor(1) - trace13 + if (num_dims .eq. 2) then + deviatoric(4) = tensor(4) - trace13 + elseif (num_dims .eq. 3) then + deviatoric(5) = tensor(5) - trace13 + deviatoric(9) = tensor(9) - trace13 + end if + end subroutine s_calculate_deviatoric + + subroutine s_calculate_atransposea(tensor,ata) real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: tproduct - + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ata + + ata(1) = tensor(1)**2 ! TODO: Mirelys: Does this make sense? + if (num_dims .eq. 2) then + ata(1) = ata(1) + tensor(3)**2 + ata(2) = tensor(1)*tensor(2) + tensor(3)*tensor(4) + ata(3) = ata(2) + ata(4) = tensor(2)**2 + tensor(4)**2 + elseif (num_dims .eq. 3) then + ata(1) = ata(1) + tensor(4)**2 + tensor(7)**2 + ata(5) = tensor(2) + tensor(5)**2 + tensor(8)**2 + ata(9) = tensor(3) + tensor(6)**2 + tensor(9)**2 + ata(2) = tensor(1)*tensor(2) + tensor(4)*tensor(5) + tensor(7)*tensor(8) + ata(3) = tensor(1)*tensor(3) + tensor(4)*tensor(6) + tensor(7)*tensor(9) + ata(6) = tensor(2)*tensor(3) + tensor(5)*tensor(6) + tensor(8)*tensor(9) + ata(4) = ata(2) + ata(7) = ata(3) + ata(8) = ata(4) + end if end subroutine s_calculate_atransposea end module m_finger_tensor_calc diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 60e4a97e5b..e942225e62 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -173,11 +173,30 @@ contains end if - !if (hyperelasticity .and. present(G)) then - !TODO ADD CODE HERE + if (hyperelasticity .and. present(G)) then + ! calculate elastic contribution to Energy + E_e = 0d0 + do s = stress_idx%beg, stress_idx%end + if (G > 0) then + E_e = E_e + ((stress/rho)**2d0)/(4d0*G) + ! Additional terms in 2D and 3D + if ((s == stress_idx%beg + 1) .or. & + (s == stress_idx%beg + 3) .or. & + (s == stress_idx%beg + 4)) then + E_e = E_e + ((stress/rho)**2d0)/(4d0*G) + end if + end if + end do - !end if + pres = ( & + energy - & + 0.5d0*(mom**2.d0)/rho - & + pi_inf - qv - E_e & + )/gamma + + + end if end subroutine s_compute_pressure diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index af27d67094..109e829e8c 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -579,7 +579,7 @@ contains if (model_eqns == 2) then cont_idx%beg = 1 cont_idx%end = num_fluids - mom_idx%beg = cont_idx%end + + mom_idx%beg = cont_idx%end + 1 mom_idx%end = cont_idx%end + num_dims E_idx = mom_idx%end + 1 adv_idx%beg = E_idx + 1 From baa193897faaae42ac7ea31b689f7ae56f98e06c Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 7 Mar 2024 15:49:06 -0600 Subject: [PATCH 030/380] elastic energy, does not compile --- src/common/m_finger_tensor_calc.f90 | 39 ++++++++++++++++++++++----- src/common/m_variables_conversion.fpp | 39 ++++++++++++++++++++------- 2 files changed, 62 insertions(+), 16 deletions(-) diff --git a/src/common/m_finger_tensor_calc.f90 b/src/common/m_finger_tensor_calc.f90 index a6547705ae..7f99d4fe4e 100644 --- a/src/common/m_finger_tensor_calc.f90 +++ b/src/common/m_finger_tensor_calc.f90 @@ -22,7 +22,8 @@ module m_finger_tensor_calc private; public :: s_allocate_tensor, & f_determinant, & s_calculate_deviatoric, & - s_calculate_atransposea + s_calculate_atransposea, & + s_calculate_elastic_energy contains @@ -62,12 +63,7 @@ subroutine s_calculate_deviatoric(tensor,deviatoric) real(kind(0d0)) :: trace13 deviatoric = tensor - trace13 = tensor(1) - if (num_dims .eq. 2) then - trace13 = trace13 + tensor(4) - elseif (num_dims .eq. 3) then - trace13 = trace13 + tensor(5) + tensor(9) - end if + trace13 = f_trace(tensor) trace13 = (1.0/3.0)*trace13 deviatoric(1) = tensor(1) - trace13 if (num_dims .eq. 2) then @@ -101,4 +97,33 @@ subroutine s_calculate_atransposea(tensor,ata) end if end subroutine s_calculate_atransposea + function f_elastic_energy(ghat) + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: ghat + real(kind(0d0)), dimension(num_dims**2) :: matrix + real(kind(0d0)) :: f_elastic_energy + ! remove the identity and square + matrix = ghat + matrix(1) = matrix(1) - 1d0 + if (num_dims .eq. 2) then + matrix(4) = matrix(4) - 1d0 + elseif (num_dims .eq. 3) then + matrix(5) = matrix(5) - 1d0 + matrix(9) = matrix(9) - 1d0 + end if + matrix(:) = matrix(:)**2 + ! compute the trace + f_elastic_energy = f_trace(matrix) + end subroutine s_calculate_elastic_energy + + function f_trace(tensor) + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)) :: f_trace + f_trace = tensor(1) + if (num_dims .eq. 2) then + f_trace = f_trace + tensor(4) + elseif (num_dims .eq. 3) then + f_trace = f_trace + tensor(5) + tensor(9) + end if + end function f_trace + end module m_finger_tensor_calc diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index e942225e62..66100c79e2 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -192,10 +192,7 @@ contains energy - & 0.5d0*(mom**2.d0)/rho - & pi_inf - qv - E_e & - )/gamma - - - + )/gamma end if end subroutine s_compute_pressure @@ -917,7 +914,7 @@ contains end if #else ! If pre-processing, use non acc mixture subroutines - if (hypoelasticity) then ! .or. hyperelasticity) then + if (hypoelasticity .or. hyperelasticity) then ! .or. hyperelasticity) then call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) else @@ -1002,6 +999,26 @@ contains end do end if + if (hyperelasticity) then + !$acc loop seq + do i = strxb, strxe + qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & + /rho_K + ! subtracting elastic contribution for pressure calculation + if (G_K > 1000) then !TODO: check if stable for >0 + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K + ! extra terms in 2 and 3D + if ((i == strxb + 1) .or. & + (i == strxb + 3) .or. & + (i == strxb + 4)) then + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K + end if + end if + end do + end if + !$acc loop seq do i = advxb, advxe qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) @@ -1042,8 +1059,9 @@ contains real(kind(0d0)) :: dyn_pres real(kind(0d0)) :: nbub, R3, vftmp, R3tmp real(kind(0d0)), dimension(nb) :: Rtmp - real(kind(0d0)) :: G + real(kind(0d0)) :: G, detG real(kind(0d0)), dimension(2) :: Re_K + real(kind(0d0)), dimension(num_dims**2) :: gtensor, getge, ghat integer :: i, j, k, l, q !< Generic loop iterators @@ -1162,9 +1180,12 @@ contains ! To do that, we need \hat(g), to get \hat(g), we need G^e ! To get G^e, we need g_{ij}^e, we have this stored in q_cons_vf(i) where ! i goes from stress_idx%beg to stress_idx%end - !do i = stress_idx%beg, stress_idx%end - ! q_cons_vf(E_idx)%sf(j,k,l) = q_cons_vf(E_idx)%sf(j,k,l) + & - ! stuff + call s_allocate_tensor(q_cons_vf,j,k,l,gtensor) + call s_calculate_atransposea(gtensor,getge) ! getge is G^e + detG = f_determinant(getge) ! determinant of G^e + ghat(:) = getge(:)*detG**(-1.d0/3.d0) + e_e = (G/(4.d0*rho)*f_elastic_energy(ghat) + q_cons_vf(E_idx)%sf(j,k,l) = q_cons_vf(E_idx)%sf(j,k,l) + e_e end if end do From 5b791752e13ea82464e334554529adf9d6505b40 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Thu, 7 Mar 2024 15:49:27 -0600 Subject: [PATCH 031/380] 3D interface outputting works for axissym --- src/simulation/m_data_output.fpp | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index f0ba287c9b..01966093b5 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -528,11 +528,11 @@ contains if (mod(p, 2) > 0) then cent = p/2 + 1/2 elseif (mod(p, 2) == 0) then - cent = p/2 + 1/2 + cent = p/2 elseif (p == 0) then cent = 0 endif - do k = 0, n + do k = 0, n OLoop: do j = 0, m axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) axm = q_prim_vf(E_idx + 2)%sf(j - 1, k, cent) @@ -564,6 +564,8 @@ contains end if end do OLoop end do + ! endif + ! end do allocate (y_d(counter)) allocate (x_d(counter)) From 67ac36399acd688e4a44c3774a2b4305fc3bae37 Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Thu, 7 Mar 2024 16:19:03 -0600 Subject: [PATCH 032/380] changes to m_finger_tensor, does not build yet --- src/common/m_finger_tensor_calc.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/common/m_finger_tensor_calc.f90 b/src/common/m_finger_tensor_calc.f90 index 7f99d4fe4e..2b2955bffa 100644 --- a/src/common/m_finger_tensor_calc.f90 +++ b/src/common/m_finger_tensor_calc.f90 @@ -23,7 +23,7 @@ module m_finger_tensor_calc f_determinant, & s_calculate_deviatoric, & s_calculate_atransposea, & - s_calculate_elastic_energy + f_elastic_energy contains @@ -113,7 +113,7 @@ function f_elastic_energy(ghat) matrix(:) = matrix(:)**2 ! compute the trace f_elastic_energy = f_trace(matrix) - end subroutine s_calculate_elastic_energy + end function f_elastic_energy function f_trace(tensor) real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor From b8f1908e63e66174372e5edd349b53ba9c8aaacc Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Thu, 7 Mar 2024 16:45:07 -0600 Subject: [PATCH 033/380] incremental --- src/simulation/m_data_output.fpp | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 01966093b5..3521e3a8a9 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -591,6 +591,14 @@ contains end subroutine s_write_sim_data_file ! ----------------------------------- + subroutine s_calculate_energy_contributions(q_prim_vf, Elk, Elp, Egk, Egie) + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + real(kind(0d0)), intent(OUT) :: Elk, Elp, Egk, Egie + real(kind(0d0)) :: rho + + + end subroutine + subroutine s_calculate_numerical_schlieran(q_prim_vf, f_NS) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer :: i, j, k, l From 5f935c0adf9f4220cde47a343ea0b9c6b401db17 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Fri, 8 Mar 2024 11:35:04 -0600 Subject: [PATCH 034/380] incremental --- src/simulation/m_data_output.fpp | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 3521e3a8a9..22e64b6d73 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -595,6 +595,30 @@ contains type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf real(kind(0d0)), intent(OUT) :: Elk, Elp, Egk, Egie real(kind(0d0)) :: rho + integer :: i, j, k, l !looping indicies + + Elk = 0d0 + Elp = 0d0 + Egk = 0d0 + Egie = 0d0 + rho = 0d0 + + + + if (p > 0) then + do k = 0, p + do j = 0, n + do i = 0, m + do l = 0, num_fluids + rho = rho + q_prim_vf(l)%sf(i,j,k) + end do + + + end do + end do + end do + end if + end subroutine From c1c05448dd2815665c9e3763d682373d691a2477 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 8 Mar 2024 11:35:30 -0600 Subject: [PATCH 035/380] began working on hyperelastic stress, not yet done --- src/common/m_variables_conversion.fpp | 48 +++++++++++---------------- 1 file changed, 20 insertions(+), 28 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 66100c79e2..d11a1a4b8e 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -862,6 +862,10 @@ contains real(kind(0d0)) :: pres + real(kind(0d0)) :: detG, e_e + + real(kind(0d0)), dimension(num_dims**2) :: gtensor, getge, ghat + integer :: i, j, k, l !< Generic loop iterators real(kind(0.d0)) :: ntmp @@ -999,24 +1003,18 @@ contains end do end if - if (hyperelasticity) then - !$acc loop seq - do i = strxb, strxe - qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & - /rho_K - ! subtracting elastic contribution for pressure calculation - if (G_K > 1000) then !TODO: check if stable for >0 - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K - ! extra terms in 2 and 3D - if ((i == strxb + 1) .or. & - (i == strxb + 3) .or. & - (i == strxb + 4)) then - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K - end if - end if - end do + !$acc loop seq + do i = strxb, strxe + qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) + end do + + if (hyperelasticity .and. G_K .gt. 0.d0) then + call s_allocate_tensor(qK_prim_vf,j,k,l,gtensor) + call s_calculate_atransposea(gtensor,getge) ! getge is G^e + detG = f_determinant(getge) ! determinant of G^e + ghat(:) = getge(:)*detG**(-1.d0/3.d0) + e_e = (G_K/(4.d0*rho_K))*f_elastic_energy(ghat) + qK_prim_vf(E_idx)%sf(j,k,l) = qK_prim_vf(E_idx)%sf(j,k,l) - e_e/gamma_k end if !$acc loop seq @@ -1059,8 +1057,9 @@ contains real(kind(0d0)) :: dyn_pres real(kind(0d0)) :: nbub, R3, vftmp, R3tmp real(kind(0d0)), dimension(nb) :: Rtmp - real(kind(0d0)) :: G, detG + real(kind(0d0)) :: G real(kind(0d0)), dimension(2) :: Re_K + real(kind(0d0)) :: detG, e_e real(kind(0d0)), dimension(num_dims**2) :: gtensor, getge, ghat integer :: i, j, k, l, q !< Generic loop iterators @@ -1172,19 +1171,12 @@ contains end do end if - if (hyperelasticity) then - ! TODO ADD the e^e term contribution to the total energy equation here - ! Multiple functions need to be called for 3x3 matrix calculations at each cell - - ! PRECOMPUTATIONS TO CALCULATE \rho e^e = \rho (\frac{\mu}{4 \rho_0} \tr ((\hat(g) - I)^2)) - ! To do that, we need \hat(g), to get \hat(g), we need G^e - ! To get G^e, we need g_{ij}^e, we have this stored in q_cons_vf(i) where - ! i goes from stress_idx%beg to stress_idx%end + if (hyperelasticity .and. G .gt. 0.d0 ) then call s_allocate_tensor(q_cons_vf,j,k,l,gtensor) call s_calculate_atransposea(gtensor,getge) ! getge is G^e detG = f_determinant(getge) ! determinant of G^e ghat(:) = getge(:)*detG**(-1.d0/3.d0) - e_e = (G/(4.d0*rho)*f_elastic_energy(ghat) + e_e = (G/(4.d0*rho))*f_elastic_energy(ghat) q_cons_vf(E_idx)%sf(j,k,l) = q_cons_vf(E_idx)%sf(j,k,l) + e_e end if From 5ebd6b6f46f29572bfde6c49058945ea1a10a64c Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 8 Mar 2024 12:00:19 -0600 Subject: [PATCH 036/380] reviewed the code --- src/simulation/m_data_output.fpp | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 22e64b6d73..3c2b4527ba 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -602,8 +602,6 @@ contains Egk = 0d0 Egie = 0d0 rho = 0d0 - - if (p > 0) then do k = 0, p @@ -611,16 +609,12 @@ contains do i = 0, m do l = 0, num_fluids rho = rho + q_prim_vf(l)%sf(i,j,k) - end do - - + end do end do end do end do end if - - end subroutine subroutine s_calculate_numerical_schlieran(q_prim_vf, f_NS) From 0a2a5da7506b3dd18626c8eb3a7f3ec9e8d16eff Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Fri, 8 Mar 2024 12:26:07 -0600 Subject: [PATCH 037/380] kinetic energy calcs in m_dataoutput in sim compile --- src/simulation/m_data_output.fpp | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 22e64b6d73..15d1873451 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -591,11 +591,12 @@ contains end subroutine s_write_sim_data_file ! ----------------------------------- - subroutine s_calculate_energy_contributions(q_prim_vf, Elk, Elp, Egk, Egie) - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + subroutine s_calculate_energy_contributions(q_cons_vf, Elk, Elp, Egk, Egie) + type(scalar_field), dimension(sys_size), intent(IN) :: q_cons_vf real(kind(0d0)), intent(OUT) :: Elk, Elp, Egk, Egie real(kind(0d0)) :: rho - integer :: i, j, k, l !looping indicies + real(kind(0d0)), dimension(num_dims) :: vel + integer :: i, j, k, l, s !looping indicies Elk = 0d0 Elp = 0d0 @@ -610,10 +611,17 @@ contains do j = 0, n do i = 0, m do l = 0, num_fluids - rho = rho + q_prim_vf(l)%sf(i,j,k) + rho = rho + q_cons_vf(l)%sf(i,j,k) end do - - + do s = 1, num_dims + vel(s) = q_cons_vf(cont_idx%end + s)%sf(i, j, k)/rho + if (q_cons_vf(E_idx + 1)%sf(i, j, k) > 0.9d0) then + Elk = Elk + 0.5d0*rho*vel(s)*vel(s) + else + Egk = Egk + 0.5d0*rho*vel(s)*vel(s) + endif + end do + end do end do end do @@ -621,7 +629,7 @@ contains - end subroutine + end subroutine s_calculate_energy_contributions subroutine s_calculate_numerical_schlieran(q_prim_vf, f_NS) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf @@ -1511,7 +1519,7 @@ contains real(kind(0d0)) :: nondim_time !< Non-dimensional time real(kind(0d0)) :: tmp !< - !! Temporary variable to store quantity for mpi_allreduce + !! Temporary variable to store quantity for mpi_allreduce real(kind(0d0)) :: blkmod1, blkmod2 !< !! Fluid bulk modulus for Woods mixture sound speed From c66a1dfe8172ce5fd23fb72d45ed79946c736918 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Fri, 8 Mar 2024 12:47:38 -0600 Subject: [PATCH 038/380] incremental, compiles correctly --- src/simulation/m_data_output.fpp | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 209813cb10..2a79fc8daf 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -594,7 +594,7 @@ contains subroutine s_calculate_energy_contributions(q_cons_vf, Elk, Elp, Egk, Egie) type(scalar_field), dimension(sys_size), intent(IN) :: q_cons_vf real(kind(0d0)), intent(OUT) :: Elk, Elp, Egk, Egie - real(kind(0d0)) :: rho + real(kind(0d0)) :: rho, pres, pi_inf, qv, gamma, dV real(kind(0d0)), dimension(num_dims) :: vel integer :: i, j, k, l, s !looping indicies @@ -603,6 +603,13 @@ contains Egk = 0d0 Egie = 0d0 rho = 0d0 + pi_inf = fluid_pp(1)%pi_inf + qv = fluid_pp(1)%qv + gamma = fluid_pp(1)%gamma + + + + if (p > 0) then do k = 0, p @@ -611,6 +618,14 @@ contains do l = 0, num_fluids rho = rho + q_cons_vf(l)%sf(i,j,k) end do + dV = dx(i)*dy(j)*dz(k) + call s_compute_pressure( & + q_cons_vf(1)%sf(i, j, k), & + q_cons_vf(alf_idx)%sf(i, j, k), & + 0.5d0*(q_cons_vf(2)%sf(i, j, k)**2.d0)/ & + q_cons_vf(1)%sf(i, j, k), & + pi_inf, gamma, rho, qv, pres) + do s = 1, num_dims vel(s) = q_cons_vf(cont_idx%end + s)%sf(i, j, k)/rho if (q_cons_vf(E_idx + 1)%sf(i, j, k) > 0.9d0) then @@ -619,9 +634,6 @@ contains Egk = Egk + 0.5d0*rho*vel(s)*vel(s) endif end do - - rho = rho + q_prim_vf(l)%sf(i,j,k) - end do end do end do end do From a32e284d914d73193f5ca77c56e06057372c2909 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Mon, 11 Mar 2024 12:47:47 -0500 Subject: [PATCH 039/380] incremental --- src/simulation/m_data_output.fpp | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 2a79fc8daf..abdaefd57c 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -594,7 +594,7 @@ contains subroutine s_calculate_energy_contributions(q_cons_vf, Elk, Elp, Egk, Egie) type(scalar_field), dimension(sys_size), intent(IN) :: q_cons_vf real(kind(0d0)), intent(OUT) :: Elk, Elp, Egk, Egie - real(kind(0d0)) :: rho, pres, pi_inf, qv, gamma, dV + real(kind(0d0)) :: rho, pres, pi_inf, qv, gamma, dV, Vb real(kind(0d0)), dimension(num_dims) :: vel integer :: i, j, k, l, s !looping indicies @@ -606,9 +606,7 @@ contains pi_inf = fluid_pp(1)%pi_inf qv = fluid_pp(1)%qv gamma = fluid_pp(1)%gamma - - - + Vb = 0d0 if (p > 0) then @@ -618,14 +616,14 @@ contains do l = 0, num_fluids rho = rho + q_cons_vf(l)%sf(i,j,k) end do - dV = dx(i)*dy(j)*dz(k) + call s_compute_pressure( & q_cons_vf(1)%sf(i, j, k), & q_cons_vf(alf_idx)%sf(i, j, k), & 0.5d0*(q_cons_vf(2)%sf(i, j, k)**2.d0)/ & q_cons_vf(1)%sf(i, j, k), & pi_inf, gamma, rho, qv, pres) - + dV = dx(i)*dy(j)*dz(k) do s = 1, num_dims vel(s) = q_cons_vf(cont_idx%end + s)%sf(i, j, k)/rho if (q_cons_vf(E_idx + 1)%sf(i, j, k) > 0.9d0) then @@ -634,10 +632,17 @@ contains Egk = Egk + 0.5d0*rho*vel(s)*vel(s) endif end do + if (q_cons_vf(E_idx + 1)%sf(i, j, k) .lt. 0.9d0) then + Vb = Vb + dV + Egie = Egie + pres*dV/(gamma-1) + else + Elp = Elp + pres*dV + endif end do end do end do end if + Elp = Elp + Vb From 74c129f2bed7eeea7008797743093ce1767a2c00 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Mon, 11 Mar 2024 13:37:53 -0500 Subject: [PATCH 040/380] incremental --- src/simulation/m_data_output.fpp | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index abdaefd57c..3da8fa85c4 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -594,7 +594,7 @@ contains subroutine s_calculate_energy_contributions(q_cons_vf, Elk, Elp, Egk, Egie) type(scalar_field), dimension(sys_size), intent(IN) :: q_cons_vf real(kind(0d0)), intent(OUT) :: Elk, Elp, Egk, Egie - real(kind(0d0)) :: rho, pres, pi_inf, qv, gamma, dV, Vb + real(kind(0d0)) :: rho, pres, pi_inf, qv, gamma, dV, Vb, tmp real(kind(0d0)), dimension(num_dims) :: vel integer :: i, j, k, l, s !looping indicies @@ -642,6 +642,16 @@ contains end do end do end if + tmp = Elk + call s_mpi_allreduce_sum(tmp, Elk) + tmp = Elp + call s_mpi_allreduce_sum(tmp, Elp) + tmp = Egie + call s_mpi_allreduce_sum(tmp, Egie) + tmp = Egk + call s_mpi_allreduce_sum(tmp, Egk) + tmp = Vb + call s_mpi_allreduce_sum(tmp, Vb) Elp = Elp + Vb From 6d47fed0e353c40e094c9f0b05b1f07c1ff7e504 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 12 Mar 2024 23:49:32 -0500 Subject: [PATCH 041/380] compiles simulation, m_variables_conversion is not complete --- src/common/m_variables_conversion.fpp | 72 +++++++++++++-------------- 1 file changed, 36 insertions(+), 36 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index d11a1a4b8e..d13f3458d4 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -173,27 +173,27 @@ contains end if - if (hyperelasticity .and. present(G)) then - ! calculate elastic contribution to Energy - E_e = 0d0 - do s = stress_idx%beg, stress_idx%end - if (G > 0) then - E_e = E_e + ((stress/rho)**2d0)/(4d0*G) - ! Additional terms in 2D and 3D - if ((s == stress_idx%beg + 1) .or. & - (s == stress_idx%beg + 3) .or. & - (s == stress_idx%beg + 4)) then - E_e = E_e + ((stress/rho)**2d0)/(4d0*G) - end if - end if - end do - - pres = ( & - energy - & - 0.5d0*(mom**2.d0)/rho - & - pi_inf - qv - E_e & - )/gamma - end if + !if (hyperelasticity .and. present(G)) then + ! ! calculate elastic contribution to Energy + ! E_e = 0d0 + ! do s = stress_idx%beg, stress_idx%end + ! if (G > 0) then + ! E_e = E_e + ((stress/rho)**2d0)/(4d0*G) + ! ! Additional terms in 2D and 3D + ! if ((s == stress_idx%beg + 1) .or. & + ! (s == stress_idx%beg + 3) .or. & + ! (s == stress_idx%beg + 4)) then + ! E_e = E_e + ((stress/rho)**2d0)/(4d0*G) + ! end if + ! end if + ! end do + + ! pres = ( & + ! energy - & + ! 0.5d0*(mom**2.d0)/rho - & + ! pi_inf - qv - E_e & + ! )/gamma + !end if end subroutine s_compute_pressure @@ -918,7 +918,7 @@ contains end if #else ! If pre-processing, use non acc mixture subroutines - if (hypoelasticity .or. hyperelasticity) then ! .or. hyperelasticity) then + if (hypoelasticity .or. hyperelasticity) then call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) else @@ -1008,12 +1008,12 @@ contains qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) end do - if (hyperelasticity .and. G_K .gt. 0.d0) then - call s_allocate_tensor(qK_prim_vf,j,k,l,gtensor) - call s_calculate_atransposea(gtensor,getge) ! getge is G^e - detG = f_determinant(getge) ! determinant of G^e - ghat(:) = getge(:)*detG**(-1.d0/3.d0) - e_e = (G_K/(4.d0*rho_K))*f_elastic_energy(ghat) + if (hyperelasticity) then + ! call s_allocate_tensor(qK_prim_vf,j,k,l,gtensor) + ! call s_calculate_atransposea(gtensor,getge) ! getge is G^e + ! detG = f_determinant(getge) ! determinant of G^e + ! ghat(:) = getge(:)*detG**(-1.d0/3.d0) + e_e = (G_K/(4.d0*rho_K))!*f_elastic_energy(ghat) qK_prim_vf(E_idx)%sf(j,k,l) = qK_prim_vf(E_idx)%sf(j,k,l) - e_e/gamma_k end if @@ -1171,14 +1171,14 @@ contains end do end if - if (hyperelasticity .and. G .gt. 0.d0 ) then - call s_allocate_tensor(q_cons_vf,j,k,l,gtensor) - call s_calculate_atransposea(gtensor,getge) ! getge is G^e - detG = f_determinant(getge) ! determinant of G^e - ghat(:) = getge(:)*detG**(-1.d0/3.d0) - e_e = (G/(4.d0*rho))*f_elastic_energy(ghat) - q_cons_vf(E_idx)%sf(j,k,l) = q_cons_vf(E_idx)%sf(j,k,l) + e_e - end if + !if (hyperelasticity .and. G .gt. 0.d0 ) then + ! call s_allocate_tensor(q_cons_vf,j,k,l,gtensor) + ! call s_calculate_atransposea(gtensor,getge) ! getge is G^e + ! detG = f_determinant(getge) ! determinant of G^e + ! ghat(:) = getge(:)*detG**(-1.d0/3.d0) + ! e_e = (G/(4.d0*rho))*f_elastic_energy(ghat) + ! q_cons_vf(E_idx)%sf(j,k,l) = q_cons_vf(E_idx)%sf(j,k,l) + e_e + !end if end do end do From bb4f50ee6381ed69684f311869693c34ece29e40 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Tue, 19 Mar 2024 13:27:56 -0500 Subject: [PATCH 042/380] Energy data file creation, writing, and closing has now been writen, not yet tested --- src/simulation/m_data_output.fpp | 94 +++++++++++++++++++++----- src/simulation/m_derived_variables.f90 | 3 + 2 files changed, 79 insertions(+), 18 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 3da8fa85c4..82d89849d1 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -49,7 +49,10 @@ module m_data_output s_close_probe_files, & s_finalize_data_output_module, & s_open_sim_data_file, & + s_open_eng_data_file, & s_write_sim_data_file, & + s_write_eng_data_file, & + s_close_eng_data_file, & s_close_sim_data_file abstract interface ! =================================================== @@ -220,13 +223,28 @@ contains FORM='formatted', & POSITION='append', & STATUS='unknown') -! call date_and_time(DATE=file_date) -! write (21519, '(A)') 'Date: '//file_date(5:6)//'/'// & -! file_date(7:8)//'/'// & -! file_date(3:4) + end subroutine s_open_sim_data_file ! --------------------------------------- + + + subroutine s_open_eng_data_file() ! ------------------------ + + character(LEN=path_len + 5*name_len) :: file_path !< + !! Relative path to a file in the case directory + character(LEN=8) :: file_date !< + !! Creation date of the run-time information file + + write (file_path, '(A)') '/eng_data.txt' + file_path = trim(case_dir)//trim(file_path) + + ! Opening the simulation data file + open (21520, FILE=trim(file_path), & + FORM='formatted', & + POSITION='append', & + STATUS='unknown') + + end subroutine s_open_eng_data_file ! ---------------------------------------- - end subroutine s_open_sim_data_file ! ---------------------------------------- !> This opens a formatted data file where the root processor !! can write out flow probe information @@ -505,7 +523,7 @@ contains integer :: i, j, k, l, w, cent !< Generic loop iterators integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations - real(kind(0d0)) :: u, eps + real(kind(0d0)) :: u, eps, Elk, Elp, Egk, Egie real(kind(0d0)), dimension(0:m, 0:n) :: rho real(kind(0d0)) :: nondim_time real(kind(0d0)), dimension(num_fluids) :: alpha, vol_fluid, xcom, ycom, zcom @@ -589,10 +607,37 @@ contains end if end if + end subroutine s_write_sim_data_file ! ----------------------------------- - subroutine s_calculate_energy_contributions(q_cons_vf, Elk, Elp, Egk, Egie) - type(scalar_field), dimension(sys_size), intent(IN) :: q_cons_vf + + subroutine s_write_eng_data_file(q_prim_vf, t_step) + + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + integer, intent(IN) :: t_step + integer :: i, j!< Generic loop iterators + integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations + + real(kind(0d0)) :: Elk, Elp, Egk, Egie + real(kind(0d0)) :: nondim_time + + if (t_step_old /= dflt_int) then + nondim_time = real(t_step + t_step_old, kind(0d0))*dt + else + nondim_time = real(t_step, kind(0d0))*dt + end if + root = 0 + + call s_calculate_energy_contributions(q_prim_vf, Elk, Elp, Egk, Egie) + + write (21520, '(F12.9,1X,F12.9,1X,F12.9,1X, F12.9, 1X, F12.9)') & + Elp, Elk, Egie, Egk, nondim_time + + + end subroutine s_write_eng_data_file + + subroutine s_calculate_energy_contributions(q_prim_vf, Elk, Elp, Egk, Egie) + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf real(kind(0d0)), intent(OUT) :: Elk, Elp, Egk, Egie real(kind(0d0)) :: rho, pres, pi_inf, qv, gamma, dV, Vb, tmp real(kind(0d0)), dimension(num_dims) :: vel @@ -613,26 +658,26 @@ contains do k = 0, p do j = 0, n do i = 0, m - do l = 0, num_fluids - rho = rho + q_cons_vf(l)%sf(i,j,k) + do l = 1, num_fluids + rho = rho + q_prim_vf(l)%sf(i,j,k) end do call s_compute_pressure( & - q_cons_vf(1)%sf(i, j, k), & - q_cons_vf(alf_idx)%sf(i, j, k), & - 0.5d0*(q_cons_vf(2)%sf(i, j, k)**2.d0)/ & - q_cons_vf(1)%sf(i, j, k), & + q_prim_vf(1)%sf(i, j, k), & + q_prim_vf(alf_idx)%sf(i, j, k), & + 0.5d0*(q_prim_vf(2)%sf(i, j, k)**2.d0)/ & + q_prim_vf(1)%sf(i, j, k), & pi_inf, gamma, rho, qv, pres) dV = dx(i)*dy(j)*dz(k) do s = 1, num_dims - vel(s) = q_cons_vf(cont_idx%end + s)%sf(i, j, k)/rho - if (q_cons_vf(E_idx + 1)%sf(i, j, k) > 0.9d0) then + vel(s) = q_prim_vf(cont_idx%end + s)%sf(i, j, k) + if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9d0) then Elk = Elk + 0.5d0*rho*vel(s)*vel(s) else Egk = Egk + 0.5d0*rho*vel(s)*vel(s) endif end do - if (q_cons_vf(E_idx + 1)%sf(i, j, k) .lt. 0.9d0) then + if (q_prim_vf(E_idx + 1)%sf(i, j, k) .lt. 0.9d0) then Vb = Vb + dV Egie = Egie + pres*dV/(gamma-1) else @@ -655,7 +700,6 @@ contains Elp = Elp + Vb - end subroutine s_calculate_energy_contributions subroutine s_calculate_numerical_schlieran(q_prim_vf, f_NS) @@ -2149,6 +2193,20 @@ contains end subroutine s_close_sim_data_file !--------------------- + subroutine s_close_eng_data_file() ! ----------------------- + + ! Writing the footer of and closing the run-time information file + write (21520, '(A)') '----------------------------------------'// & + '----------------------------------------' + write (21520, '(A)') '' + write (21520, '(A)') '' + write (21520, '(A)') '========================================'// & + '========================================' + close (21520) + + end subroutine s_close_eng_data_file !--------------------- + + !> Closes probe files subroutine s_close_probe_files() ! ------------------------------------- diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index e9ac8dabd0..3c73a46dfd 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -110,6 +110,7 @@ subroutine s_initialize_derived_variables() ! ----------------------------- if (sim_data .and. proc_rank == 0) then call s_open_sim_data_file() + call s_open_eng_data_file() end if end subroutine s_initialize_derived_variables ! ----------------------------- @@ -166,6 +167,7 @@ subroutine s_compute_derived_variables(q_prim_vf, t_step) ! -------------------- end if if (sim_data) then call s_write_sim_data_file(q_prim_vf, t_step) + call s_write_eng_data_file(q_prim_vf, t_step) end if end subroutine s_compute_derived_variables ! --------------------------- @@ -472,6 +474,7 @@ subroutine s_finalize_derived_variables_module() ! ------------------- if (proc_rank == 0) then if (sim_data) then call s_close_sim_data_file() + call s_close_eng_data_file() end if end if From fd03119b4eab787112dfce4bed4bd2c29a0a8d4e Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Wed, 20 Mar 2024 17:00:56 -0500 Subject: [PATCH 043/380] incremental --- src/simulation/m_data_output.fpp | 27 ++++++++++++-------------- src/simulation/m_derived_variables.f90 | 2 +- 2 files changed, 13 insertions(+), 16 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 82d89849d1..0d04b2b760 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -612,7 +612,6 @@ contains subroutine s_write_eng_data_file(q_prim_vf, t_step) - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer, intent(IN) :: t_step integer :: i, j!< Generic loop iterators @@ -648,29 +647,27 @@ contains Egk = 0d0 Egie = 0d0 rho = 0d0 - pi_inf = fluid_pp(1)%pi_inf - qv = fluid_pp(1)%qv - gamma = fluid_pp(1)%gamma + pi_inf = 0d0 + qv = 0d0 + gamma = 0d0 Vb = 0d0 - + pres = 0d0 if (p > 0) then do k = 0, p do j = 0, n do i = 0, m - do l = 1, num_fluids - rho = rho + q_prim_vf(l)%sf(i,j,k) - end do - - call s_compute_pressure( & - q_prim_vf(1)%sf(i, j, k), & - q_prim_vf(alf_idx)%sf(i, j, k), & - 0.5d0*(q_prim_vf(2)%sf(i, j, k)**2.d0)/ & - q_prim_vf(1)%sf(i, j, k), & + call s_convert_to_mixture_variables(q_prim_vf, j, k, l, & + rho, gamma, pi_inf, qv) + call s_compute_pressure( & + q_prim_vf(1)%sf(j, k, l), & + q_prim_vf(alf_idx)%sf(j, k, l), & + 0.5d0*(q_prim_vf(2)%sf(j, k, l)**2.d0), & pi_inf, gamma, rho, qv, pres) + dV = dx(i)*dy(j)*dz(k) do s = 1, num_dims - vel(s) = q_prim_vf(cont_idx%end + s)%sf(i, j, k) + vel(s) = q_prim_vf(cont_idx%end + s)%sf(j, k, l) if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9d0) then Elk = Elk + 0.5d0*rho*vel(s)*vel(s) else diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index 3c73a46dfd..3d252d1190 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -121,7 +121,7 @@ subroutine s_compute_derived_variables(q_prim_vf, t_step) ! -------------------- integer, intent(IN) :: t_step type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - + integer :: i, j, k !< Generic loop iterators if (probe_wrt) then From 67cebaba0eddf2d575d7411ee3929a170dd2684d Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Mon, 25 Mar 2024 11:24:26 -0500 Subject: [PATCH 044/380] energy output code up and running --- src/simulation/m_data_output.fpp | 21 ++++++--------------- 1 file changed, 6 insertions(+), 15 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 0d04b2b760..ed9ee64d3e 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -524,7 +524,6 @@ contains integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations real(kind(0d0)) :: u, eps, Elk, Elp, Egk, Egie - real(kind(0d0)), dimension(0:m, 0:n) :: rho real(kind(0d0)) :: nondim_time real(kind(0d0)), dimension(num_fluids) :: alpha, vol_fluid, xcom, ycom, zcom real(kind=8), parameter :: pi = 4.d0*datan(1.d0) @@ -647,9 +646,6 @@ contains Egk = 0d0 Egie = 0d0 rho = 0d0 - pi_inf = 0d0 - qv = 0d0 - gamma = 0d0 Vb = 0d0 pres = 0d0 @@ -657,17 +653,13 @@ contains do k = 0, p do j = 0, n do i = 0, m - call s_convert_to_mixture_variables(q_prim_vf, j, k, l, & - rho, gamma, pi_inf, qv) - call s_compute_pressure( & - q_prim_vf(1)%sf(j, k, l), & - q_prim_vf(alf_idx)%sf(j, k, l), & - 0.5d0*(q_prim_vf(2)%sf(j, k, l)**2.d0), & - pi_inf, gamma, rho, qv, pres) - + do l = 1, num_fluids + rho = rho + q_prim_vf(l)%sf(i, j, k) + end do + pres = q_prim_vf(E_idx)%sf(i, j, k) dV = dx(i)*dy(j)*dz(k) do s = 1, num_dims - vel(s) = q_prim_vf(cont_idx%end + s)%sf(j, k, l) + vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9d0) then Elk = Elk + 0.5d0*rho*vel(s)*vel(s) else @@ -676,7 +668,7 @@ contains end do if (q_prim_vf(E_idx + 1)%sf(i, j, k) .lt. 0.9d0) then Vb = Vb + dV - Egie = Egie + pres*dV/(gamma-1) + Egie = Egie + pres*dV else Elp = Elp + pres*dV endif @@ -696,7 +688,6 @@ contains call s_mpi_allreduce_sum(tmp, Vb) Elp = Elp + Vb - end subroutine s_calculate_energy_contributions subroutine s_calculate_numerical_schlieran(q_prim_vf, f_NS) From 9fc15f4193c5145a728f5fe672d06138fe39c4d0 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Tue, 16 Apr 2024 15:47:55 -0500 Subject: [PATCH 045/380] fixed energy outputting, should be comparable to ODE sol. now --- src/simulation/m_data_output.fpp | 49 ++++++++++++++++++-------------- 1 file changed, 27 insertions(+), 22 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index ed9ee64d3e..572c1e36ab 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -616,7 +616,7 @@ contains integer :: i, j!< Generic loop iterators integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations - real(kind(0d0)) :: Elk, Elp, Egk, Egie + real(kind(0d0)) :: Elk, Egk, Eint real(kind(0d0)) :: nondim_time if (t_step_old /= dflt_int) then @@ -626,37 +626,52 @@ contains end if root = 0 - call s_calculate_energy_contributions(q_prim_vf, Elk, Elp, Egk, Egie) + call s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Eint) - write (21520, '(F12.9,1X,F12.9,1X,F12.9,1X, F12.9, 1X, F12.9)') & - Elp, Elk, Egie, Egk, nondim_time + write (21520, '(F12.9,1X,F12.9,1X, F12.9, 1X, F12.9)') & + Eint, Elk, Egk, nondim_time end subroutine s_write_eng_data_file - subroutine s_calculate_energy_contributions(q_prim_vf, Elk, Elp, Egk, Egie) + subroutine s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Eint) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), intent(OUT) :: Elk, Elp, Egk, Egie - real(kind(0d0)) :: rho, pres, pi_inf, qv, gamma, dV, Vb, tmp + real(kind(0d0)), intent(OUT) :: Elk, Egk, Eint + real(kind(0d0)) :: rho, pres, pi_inf, qv, gamma, dV, Vb, tmp, pk, alph_k, gammak, pi_infk, rhoe real(kind(0d0)), dimension(num_dims) :: vel integer :: i, j, k, l, s !looping indicies Elk = 0d0 - Elp = 0d0 Egk = 0d0 - Egie = 0d0 rho = 0d0 Vb = 0d0 pres = 0d0 + rhoe = 0d0 + gamma = 0d0 + qv = 0d0 + pi_inf = 0d0 + pk = 0d0 + alph_k = 0d0 + Eint = 0d0 + gammak = 0d0 + pi_infk = 0d0 if (p > 0) then do k = 0, p do j = 0, n do i = 0, m + pres = q_prim_vf(E_idx)%sf(i, j, k) + do l = 1, num_fluids + call s_convert_to_mixture_variables(q_prim_vf, i, j, k, & + rhoe, gamma, pi_inf, qv) + alph_k = q_prim_vf(E_idx+l)%sf(i, j, k) + pk = alph_k*pres + gammak = alph_k*gamma + pi_infk = alph_k*pi_inf + Eint = Eint+alph_k*(pk-gammak*pi_infk)/(gammak-1) rho = rho + q_prim_vf(l)%sf(i, j, k) end do - pres = q_prim_vf(E_idx)%sf(i, j, k) dV = dx(i)*dy(j)*dz(k) do s = 1, num_dims vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) @@ -666,27 +681,17 @@ contains Egk = Egk + 0.5d0*rho*vel(s)*vel(s) endif end do - if (q_prim_vf(E_idx + 1)%sf(i, j, k) .lt. 0.9d0) then - Vb = Vb + dV - Egie = Egie + pres*dV - else - Elp = Elp + pres*dV - endif end do end do end do end if tmp = Elk call s_mpi_allreduce_sum(tmp, Elk) - tmp = Elp - call s_mpi_allreduce_sum(tmp, Elp) - tmp = Egie - call s_mpi_allreduce_sum(tmp, Egie) + tmp = Eint + call s_mpi_allreduce_sum(tmp, Eint) tmp = Egk call s_mpi_allreduce_sum(tmp, Egk) tmp = Vb - call s_mpi_allreduce_sum(tmp, Vb) - Elp = Elp + Vb end subroutine s_calculate_energy_contributions From 26d26cb295476b19985ea32eba3b496adebcc799 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Wed, 17 Apr 2024 12:30:32 -0500 Subject: [PATCH 046/380] fixed energy outputting code once again, this should be good now --- src/simulation/m_data_output.fpp | 14 ++------------ 1 file changed, 2 insertions(+), 12 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 572c1e36ab..c414966648 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -637,7 +637,7 @@ contains subroutine s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Eint) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf real(kind(0d0)), intent(OUT) :: Elk, Egk, Eint - real(kind(0d0)) :: rho, pres, pi_inf, qv, gamma, dV, Vb, tmp, pk, alph_k, gammak, pi_infk, rhoe + real(kind(0d0)) :: rho, pres, dV, Vb, tmp, pk, alph_k real(kind(0d0)), dimension(num_dims) :: vel integer :: i, j, k, l, s !looping indicies @@ -646,15 +646,9 @@ contains rho = 0d0 Vb = 0d0 pres = 0d0 - rhoe = 0d0 - gamma = 0d0 - qv = 0d0 - pi_inf = 0d0 pk = 0d0 alph_k = 0d0 Eint = 0d0 - gammak = 0d0 - pi_infk = 0d0 if (p > 0) then do k = 0, p @@ -663,13 +657,9 @@ contains pres = q_prim_vf(E_idx)%sf(i, j, k) do l = 1, num_fluids - call s_convert_to_mixture_variables(q_prim_vf, i, j, k, & - rhoe, gamma, pi_inf, qv) alph_k = q_prim_vf(E_idx+l)%sf(i, j, k) pk = alph_k*pres - gammak = alph_k*gamma - pi_infk = alph_k*pi_inf - Eint = Eint+alph_k*(pk-gammak*pi_infk)/(gammak-1) + Eint = Eint+alph_k*(pk-gammas(l)*pi_infs(l))/(gammas(l)-1) rho = rho + q_prim_vf(l)%sf(i, j, k) end do dV = dx(i)*dy(j)*dz(k) From 20cc5b8f415831553e407f8d19fdd4f5b8463f01 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Wed, 17 Apr 2024 13:02:34 -0500 Subject: [PATCH 047/380] should now be finalized --- src/simulation/m_data_output.fpp | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index c414966648..3aca3e8454 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -628,7 +628,7 @@ contains call s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Eint) - write (21520, '(F12.9,1X,F12.9,1X, F12.9, 1X, F12.9)') & + write (21520, '(F19.3,1X,F19.3,1X, F19.3, 1X, F12.9)') & Eint, Elk, Egk, nondim_time @@ -659,7 +659,7 @@ contains do l = 1, num_fluids alph_k = q_prim_vf(E_idx+l)%sf(i, j, k) pk = alph_k*pres - Eint = Eint+alph_k*(pk-gammas(l)*pi_infs(l))/(gammas(l)-1) + Eint = Eint+alph_k*(pk+gammas(l)*pi_infs(l))/(gammas(l)-1) rho = rho + q_prim_vf(l)%sf(i, j, k) end do dV = dx(i)*dy(j)*dz(k) @@ -681,7 +681,6 @@ contains call s_mpi_allreduce_sum(tmp, Eint) tmp = Egk call s_mpi_allreduce_sum(tmp, Egk) - tmp = Vb end subroutine s_calculate_energy_contributions From efd87ae0ffed81a1df7494d90d5f67c939692f93 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Wed, 17 Apr 2024 16:20:31 -0500 Subject: [PATCH 048/380] all fixed energy outputting code, matches manual calc at initial timestep --- src/simulation/m_data_output.fpp | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 3aca3e8454..c3275654ab 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -637,7 +637,7 @@ contains subroutine s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Eint) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf real(kind(0d0)), intent(OUT) :: Elk, Egk, Eint - real(kind(0d0)) :: rho, pres, dV, Vb, tmp, pk, alph_k + real(kind(0d0)) :: rho, pres, dV, Vb, tmp, pk, alph_k, Elks, Egks, Eints real(kind(0d0)), dimension(num_dims) :: vel integer :: i, j, k, l, s !looping indicies @@ -654,23 +654,29 @@ contains do k = 0, p do j = 0, n do i = 0, m + Elks = 0d0 + Egks = 0d0 + Eints = 0d0 pres = q_prim_vf(E_idx)%sf(i, j, k) - + do l = 1, num_fluids alph_k = q_prim_vf(E_idx+l)%sf(i, j, k) pk = alph_k*pres - Eint = Eint+alph_k*(pk+gammas(l)*pi_infs(l))/(gammas(l)-1) + Eints = Eints + alph_k*(pk+gammas(l)*pi_infs(l))/(gammas(l)-1) rho = rho + q_prim_vf(l)%sf(i, j, k) end do dV = dx(i)*dy(j)*dz(k) do s = 1, num_dims vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) - if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9d0) then - Elk = Elk + 0.5d0*rho*vel(s)*vel(s) + if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9) then + Elks = Elks + 0.5d0*rho*vel(s)*vel(s) else - Egk = Egk + 0.5d0*rho*vel(s)*vel(s) + Egks = Egks + 0.5d0*rho*vel(s)*vel(s) endif end do + Elk = Elk + Elks*dV + Egk = Egk + Egks*dV + Eint = Eint + Eints*dV end do end do end do From bdefc1c0fc224b0c848cdde47b600772421c4706 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Tue, 23 Apr 2024 09:28:45 -0500 Subject: [PATCH 049/380] was using wrong form of gamma and pi_inf, needed capital versions, this is now correct, pending testing --- src/simulation/m_data_output.fpp | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index c3275654ab..7d16bba1fa 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -637,18 +637,18 @@ contains subroutine s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Eint) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf real(kind(0d0)), intent(OUT) :: Elk, Egk, Eint - real(kind(0d0)) :: rho, pres, dV, Vb, tmp, pk, alph_k, Elks, Egks, Eints + real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, qv, Elks, Egks, Eints real(kind(0d0)), dimension(num_dims) :: vel integer :: i, j, k, l, s !looping indicies Elk = 0d0 Egk = 0d0 rho = 0d0 - Vb = 0d0 pres = 0d0 - pk = 0d0 - alph_k = 0d0 Eint = 0d0 + gamma = 0d0 + pi_inf = 0d0 + qv = 0d0 if (p > 0) then do k = 0, p @@ -658,13 +658,9 @@ contains Egks = 0d0 Eints = 0d0 pres = q_prim_vf(E_idx)%sf(i, j, k) - - do l = 1, num_fluids - alph_k = q_prim_vf(E_idx+l)%sf(i, j, k) - pk = alph_k*pres - Eints = Eints + alph_k*(pk+gammas(l)*pi_infs(l))/(gammas(l)-1) - rho = rho + q_prim_vf(l)%sf(i, j, k) - end do + call s_convert_to_mixture_variables(q_prim_vf, i, j, k, & + rho, gamma, pi_inf, qv) + Eints = gamma*pres+pi_inf dV = dx(i)*dy(j)*dz(k) do s = 1, num_dims vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) From 29d252e74e0695fee01608efbf4627f3494ec726 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Wed, 24 Apr 2024 14:08:02 -0500 Subject: [PATCH 050/380] added code to only out interface and energy when restart files are being written to save time. --- src/simulation/m_derived_variables.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index 3d252d1190..9b911f8372 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -165,7 +165,8 @@ subroutine s_compute_derived_variables(q_prim_vf, t_step) ! -------------------- call s_write_probe_files(t_step, q_cons_ts(1)%vf, accel_mag) call s_write_com_files(t_step, c_mass) end if - if (sim_data) then + if ((sim_data) .and. (mod(t_step - t_step_start, t_step_save) == 0 & + .or. t_step > t_step_stop)) then call s_write_sim_data_file(q_prim_vf, t_step) call s_write_eng_data_file(q_prim_vf, t_step) end if From eb85b201b815b73d5e8c33665825e130fd4bf567 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Wed, 24 Apr 2024 15:24:29 -0500 Subject: [PATCH 051/380] fixed seg fault issue, tested energy outputting, correct at initial time --- src/simulation/m_data_output.fpp | 23 ++++++++++++----------- src/simulation/m_derived_variables.f90 | 5 +++-- 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 7d16bba1fa..0fb8a361a1 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -627,10 +627,10 @@ contains root = 0 call s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Eint) - - write (21520, '(F19.3,1X,F19.3,1X, F19.3, 1X, F12.9)') & + if (t_step > t_step_start) then + write (21520, '(F19.3,1X,F19.3,1X, F19.3, 1X, F12.9)') & Eint, Elk, Egk, nondim_time - + end if end subroutine s_write_eng_data_file @@ -643,13 +643,7 @@ contains Elk = 0d0 Egk = 0d0 - rho = 0d0 - pres = 0d0 Eint = 0d0 - gamma = 0d0 - pi_inf = 0d0 - qv = 0d0 - if (p > 0) then do k = 0, p do j = 0, n @@ -657,9 +651,16 @@ contains Elks = 0d0 Egks = 0d0 Eints = 0d0 + pres = 0d0 + rho = 0d0 + gamma = 0d0 + pi_inf = 0d0 + do l = 1, num_fluids + rho = rho + q_prim_vf(E_idx+l)%sf(i, j, k)*q_prim_vf(l)%sf(i, j, k) + gamma = gamma + q_prim_vf(E_idx+l)%sf(i, j, k)*gammas(l) + pi_inf = pi_inf + q_prim_vf(E_idx+l)%sf(i, j, k)*pi_infs(l) + end do pres = q_prim_vf(E_idx)%sf(i, j, k) - call s_convert_to_mixture_variables(q_prim_vf, i, j, k, & - rho, gamma, pi_inf, qv) Eints = gamma*pres+pi_inf dV = dx(i)*dy(j)*dz(k) do s = 1, num_dims diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index 9b911f8372..67e25ea4c4 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -165,8 +165,9 @@ subroutine s_compute_derived_variables(q_prim_vf, t_step) ! -------------------- call s_write_probe_files(t_step, q_cons_ts(1)%vf, accel_mag) call s_write_com_files(t_step, c_mass) end if - if ((sim_data) .and. (mod(t_step - t_step_start, t_step_save) == 0 & - .or. t_step > t_step_stop)) then + + if ((sim_data) .and. (mod(t_step - t_step_start, t_step_save) == 0 .or. & + t_step > t_step_stop)) then call s_write_sim_data_file(q_prim_vf, t_step) call s_write_eng_data_file(q_prim_vf, t_step) end if From da7364f1f720d90de1a58963b8b0c5ff5094d6df Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Mon, 29 Apr 2024 11:49:31 -0500 Subject: [PATCH 052/380] Incremental --- src/simulation/m_data_output.fpp | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 0fb8a361a1..27915ddca1 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -542,13 +542,19 @@ contains allocate (x_d1(m*n)) allocate (y_d1(m*n)) counter = 0 - if (mod(p, 2) > 0) then - cent = p/2 + 1/2 - elseif (mod(p, 2) == 0) then - cent = p/2 + +! if () +! if (mod(p, 2) > 0) then +! ! cent = p/2 + 1/2 +! elseif (mod(p, 2) == 0) then +! cent = p/2 + if (p > 0) then + cent = 0 elseif (p == 0) then cent = 0 endif + !$acc data copyin(x_d1, y_d1) copy(counter) + !$acc parallel loop gang default(present) private(axp, axm, ayp, aym, i) do k = 0, n OLoop: do j = 0, m axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) @@ -564,6 +570,7 @@ contains x_d1(counter) = x_cc(j) y_d1(counter) = y_cc(k) else + !$acc loop vector do i = 1, counter if (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & y_d1(i))**2) <= 2*sqrt(dx(j)**2 & @@ -581,6 +588,8 @@ contains end if end do OLoop end do + !$acc end parallel loop + !$acc end data ! endif ! end do @@ -645,6 +654,7 @@ contains Egk = 0d0 Eint = 0d0 if (p > 0) then + !$acc parallel loop collapse(3) gang vector default(present) private(Elks, Egks, Eints, pres, rho, gamma, pi_inf, vel, dV) do k = 0, p do j = 0, n do i = 0, m @@ -655,6 +665,7 @@ contains rho = 0d0 gamma = 0d0 pi_inf = 0d0 + !$acc loop seq do l = 1, num_fluids rho = rho + q_prim_vf(E_idx+l)%sf(i, j, k)*q_prim_vf(l)%sf(i, j, k) gamma = gamma + q_prim_vf(E_idx+l)%sf(i, j, k)*gammas(l) @@ -663,6 +674,7 @@ contains pres = q_prim_vf(E_idx)%sf(i, j, k) Eints = gamma*pres+pi_inf dV = dx(i)*dy(j)*dz(k) + !$acc loop vector do s = 1, num_dims vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9) then @@ -677,6 +689,7 @@ contains end do end do end do + !$acc end parallel loop end if tmp = Elk call s_mpi_allreduce_sum(tmp, Elk) From 132a283e8c059a65d1e2c37d76cddff6455efd53 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Tue, 30 Apr 2024 09:08:43 -0500 Subject: [PATCH 053/380] both energy and interface outputting working --- src/simulation/m_data_output.fpp | 39 ++++++++++++++++---------------- submit_gpu.sh | 1 + 2 files changed, 20 insertions(+), 20 deletions(-) create mode 100755 submit_gpu.sh diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 27915ddca1..6b95adfbf1 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -548,19 +548,22 @@ contains ! ! cent = p/2 + 1/2 ! elseif (mod(p, 2) == 0) then ! cent = p/2 - if (p > 0) then - cent = 0 - elseif (p == 0) then - cent = 0 - endif - !$acc data copyin(x_d1, y_d1) copy(counter) - !$acc parallel loop gang default(present) private(axp, axm, ayp, aym, i) +! if (p > 0) then +! cent = 0 +! elseif (p == 0) then +! cent = 0 +! endif + do l = 0,p + if (z_cc(l) .lt. dz(l) .and. z_cc(l) .gt. 0) then + cent = l + endif + enddo do k = 0, n - OLoop: do j = 0, m - axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) - axm = q_prim_vf(E_idx + 2)%sf(j - 1, k, cent) - ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, cent) - aym = q_prim_vf(E_idx + 2)%sf(j, k - 1, cent) + OLoop: do j = 0, m + axp = q_prim_vf(E_idx + 1)%sf(j + 1, k, cent) + axm = q_prim_vf(E_idx + 1)%sf(j - 1, k, cent) + ayp = q_prim_vf(E_idx + 1)%sf(j, k + 1, cent) + aym = q_prim_vf(E_idx + 1)%sf(j, k - 1, cent) if ((axp > 0.9 .and. axm < 0.9) .or. (axp < 0.9 .and. axm > 0.9) & @@ -570,7 +573,6 @@ contains x_d1(counter) = x_cc(j) y_d1(counter) = y_cc(k) else - !$acc loop vector do i = 1, counter if (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & y_d1(i))**2) <= 2*sqrt(dx(j)**2 & @@ -588,10 +590,7 @@ contains end if end do OLoop end do - !$acc end parallel loop - !$acc end data - ! endif - ! end do + allocate (y_d(counter)) allocate (x_d(counter)) @@ -599,7 +598,7 @@ contains y_d(i) = y_d1(i) x_d(i) = x_d1(i) end do - if (num_procs > 1) then + ! if (num_procs > 1) then call s_mpi_gather_data(x_d, counter, x_td, root) call s_mpi_gather_data(y_d, counter, y_td, root) if (proc_rank == 0) then @@ -613,8 +612,8 @@ contains end if end do end if - end if - + ! end if + print*, x_d end subroutine s_write_sim_data_file ! ----------------------------------- diff --git a/submit_gpu.sh b/submit_gpu.sh new file mode 100755 index 0000000000..4626512e23 --- /dev/null +++ b/submit_gpu.sh @@ -0,0 +1 @@ + ./mfc.sh run /scratch/bciv/sremillard/sph_col_5MPa/3Dshinput_new.py -e batch -p gpuA40x4 -N 3 -n 4 -g 4 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta From 2b79eb87ec64d1e941fa2fa12f7bb072854b82b1 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Tue, 30 Apr 2024 12:03:02 -0500 Subject: [PATCH 054/380] added input file and working on adding patch smoothing for spherical_harmonic, only on axissymetric --- 3Dshinput_new.py | 205 +++++++++++++++++++++++++ src/pre_process/m_patches.fpp | 18 +++ src/simulation/m_data_output.fpp | 147 +++++++++--------- src/simulation/m_derived_variables.f90 | 6 +- 4 files changed, 296 insertions(+), 80 deletions(-) create mode 100644 3Dshinput_new.py diff --git a/3Dshinput_new.py b/3Dshinput_new.py new file mode 100644 index 0000000000..bd7c64947e --- /dev/null +++ b/3Dshinput_new.py @@ -0,0 +1,205 @@ +import math +import json + + +## Deine characteristic values for the sim +Ri = 500E-6 +rhol = 1051 +rhog = 0.027 +Pb = 3550 +Pl = 5.0E+06 +#mulc = 9E-04 +#mubc = 1.0E-05 +domain_length = 4*Ri + + +## fluid properties +Pi_inf_l = 702.8E+06 +Pi_inf_b = 0.0E+00 +nl = 1.19 +nb = 1.47 +bl = 6.61E-04 +bb = 0.0E+00 +alpha1 = 1.0E+00 +alpha2 = alpha1 +cl = (nl*(Pl+Pi_inf_l)/(rhol*(1-rhol*bl)))**(0.5) + +## Defining Characteristic Values +Rc = Ri +rhoc = rhol +uc = (Pl/rhol)**(0.5E+00) +tc = Ri/uc +Pc = rhoc*uc**(2.0E+00) + +## Non-Dimensionalizing values using characteristic values +Rin = Ri/Rc +rholn = rhol/rhoc +rhogn = rhog/rhoc +Pln = Pl/Pc +Pbn = Pb/Pc +tcn = tc/tc +Pi_inf_ln = Pi_inf_l/Pc +leng = domain_length/Rc +clc = cl/uc + + +## Non-Dimensional Numbers +#Rel = rhol*uc*2*Rin/mulc +#Reb = rhog*uc*2*Rin/mubc +Ma = uc/cl + +## Grid Specifications +CFL = 0.005 +PpBr = 48 +Nx = PpBr*leng +Ny = Nx +Nz = Nx +x_beg = 0.0E+00*leng +x_end = 0.5E+00*leng +y_beg = 0.0E+00 +y_end = 0.5E+00*leng +z_beg = 0.0E+00 +z_end = 0.5E+00*leng +delta_x = leng/Nx +delta_t = CFL*delta_x/clc +Nt = int(1.0*tcn/delta_t) +x_centroidl = (x_end+x_beg)/(2.0E+00) +y_centroidl = (y_end+y_beg)/(2.0E+00) +z_centroidl = (z_end+z_beg)/(2.0E+00) +x_centroidb = 0.0E+00 +y_centroidb = 0.0E+00 +z_centroidb = 0.0E+00 + + +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================ + 'run_time_info' : 'T', + 'sim_data' : 'F', + # ========================================================== + + # Computational Domain Parameters ========================== + 'x_domain%beg' : x_beg, + 'x_domain%end' : x_end, + 'y_domain%beg' : y_beg, + 'y_domain%end' : y_end, + 'z_domain%beg' : z_beg, + 'z_domain%end' : z_end, + 'm' : int(Nx), + 'n' : int(Ny), + 'p' : int(Nz), + 'cyl_coord' : 'F', + 'dt' : delta_t, + 't_step_start' : 0, + 't_step_stop' : Nt, + 't_step_save' : 1, +# ========================================================== + + # Simulation Algorithm Parameters ========================== + 'num_patches' : 2, + 'model_eqns' : 3, + 'alt_soundspeed' : 'F', + 'num_fluids' : 2, + 'adv_alphan' : 'T', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'time_stepper' : 3, + 'weno_order' : 5, + 'weno_eps' : 1.E-100, + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'F', + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -2, + 'bc_x%end' : -6, + 'bc_y%beg' : -2, + 'bc_y%end' : -6, + 'bc_z%beg' : -2, + 'bc_z%end' : -6, + 'stretch_x' : 'T', + 'stretch_y' : 'T', + 'stretch_z' : 'T', + 'a_x' : 4.0E+00, + 'x_a' : -1.5E+00, + 'x_b' : 1.5E+00, + 'a_y' : 4.0E+00, + 'y_a' : -1.5E+00, + 'y_b' : 1.5E+00, + 'a_z' : 4.0E+00, + 'z_a' : -1.5E+00, + 'z_b' : 1.5E+00, + # ========================================================== + + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'T', + 'fd_order' :'1', + 'probe_wrt' :'T', + 'num_probes' : 1, + 'probe(1)%x' : 0., + 'probe(1)%y' : 0., + 'probe(1)%z' : 0., + # ========================================================== + + # Patch 1: Background ============================ + 'patch_icpp(1)%geometry' : 9, + 'patch_icpp(1)%x_centroid' : 40*x_centroidl, + 'patch_icpp(1)%y_centroid' : 40*y_centroidl, + 'patch_icpp(1)%z_centroid' : 40*z_centroidl, + 'patch_icpp(1)%length_x' : 40*leng, + 'patch_icpp(1)%length_y' : 40*leng, + 'patch_icpp(1)%length_z' : 40*leng, + 'patch_icpp(1)%vel(1)' : 0.E+00, + 'patch_icpp(1)%vel(2)' : 0.E+00, + 'patch_icpp(1)%vel(3)' : 0.E+00, + 'patch_icpp(1)%pres' : Pln, + 'patch_icpp(1)%alpha_rho(1)' : alpha1*rholn, + 'patch_icpp(1)%alpha_rho(2)' : 0.0E+00, + 'patch_icpp(1)%alpha(1)' : alpha1, + 'patch_icpp(1)%alpha(2)' : 0.0E+00, + # ========================================================== + # Patch 2: Bubble ====================================== + 'patch_icpp(2)%geometry' : 8,#14, + 'patch_icpp(2)%x_centroid' : x_centroidb, + 'patch_icpp(2)%y_centroid' : y_centroidb, + 'patch_icpp(2)%z_centroid' : z_centroidb, + 'patch_icpp(2)%radius' : Rin, + 'patch_icpp(2)%smoothen' : 'T', + 'patch_icpp(2)%smooth_patch_id': 1, + 'patch_icpp(2)%smooth_coeff' : 0.5E+00, +# 'patch_icpp(2)%non_axis_sym' : 'F', +# 'patch_icpp(2)%a2' : 0.0E+00, +# 'patch_icpp(2)%a3' : 0.0E+00, +# 'patch_icpp(2)%a4' : 0.0E+00, +# 'patch_icpp(2)%a5' : 0.0E+00, +# 'patch_icpp(2)%a6' : 0.0E+00, +# 'patch_icpp(2)%a7' : 0.0E+00, + 'patch_icpp(2)%alter_patch(1)' : 'T', + 'patch_icpp(2)%vel(1)' : 0.E+00, + 'patch_icpp(2)%vel(2)' : 0.E+00, + 'patch_icpp(2)%vel(3)' : 0.E+00, + 'patch_icpp(2)%pres' : Pbn, + 'patch_icpp(2)%alpha_rho(1)' : 0.0E+00, + 'patch_icpp(2)%alpha_rho(2)' : alpha2*rhogn, + 'patch_icpp(2)%alpha(1)' : 0.0E+00, + 'patch_icpp(2)%alpha(2)' : alpha2, + # ========================================================== + + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1/(nl-1), + 'fluid_pp(1)%pi_inf' : nl*Pi_inf_ln/(nl-1), + 'fluid_pp(2)%gamma' : 1/(nb-1), + 'fluid_pp(2)%pi_inf' : 0.0E+00, +# 'fluid_pp(1)%Re(1)' : Rel, +# 'fluid_pp(2)%Re(1)' : Reb, + # ========================================================== +})) + +# ============================================================================== + diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index 7acb4d9240..b256a0116f 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -1374,6 +1374,8 @@ contains 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 radius = patch_icpp(patch_id)%radius a2 = patch_icpp(patch_id)%a2 a3 = patch_icpp(patch_id)%a3 @@ -1425,6 +1427,14 @@ contains .and. & patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) & 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 & + + (cart_z - z_centroid)**2) & + -(r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7)))*(-0.5d0) + 0.5d0 + end if + call s_assign_patch_primitive_variables(patch_id, i, j, k, & eta, q_prim_vf, patch_id_fp) @@ -1434,6 +1444,14 @@ contains .and. & patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) & 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 & + + (cart_z - z_centroid)**2) & + -(r - a2*P2 + a3*P3 - a4*P4 + a5*P5 - a6*P6 + a7*P7)))*(-0.5d0) + 0.5d0 + end if + call s_assign_patch_primitive_variables(patch_id, i, j, k, & eta, q_prim_vf, patch_id_fp) end if diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 6b95adfbf1..b9f1391c1c 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -225,8 +225,7 @@ contains STATUS='unknown') end subroutine s_open_sim_data_file ! --------------------------------------- - - + subroutine s_open_eng_data_file() ! ------------------------ character(LEN=path_len + 5*name_len) :: file_path !< @@ -245,7 +244,6 @@ contains end subroutine s_open_eng_data_file ! ---------------------------------------- - !> This opens a formatted data file where the root processor !! can write out flow probe information subroutine s_open_probe_files() ! -------------------------------------- @@ -524,7 +522,7 @@ contains integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations real(kind(0d0)) :: u, eps, Elk, Elp, Egk, Egie - real(kind(0d0)) :: nondim_time + real(kind(0d0)) :: nondim_time real(kind(0d0)), dimension(num_fluids) :: alpha, vol_fluid, xcom, ycom, zcom real(kind=8), parameter :: pi = 4.d0*datan(1.d0) real(kind(0d0)), allocatable :: x_td(:), y_td(:), x_d1(:), y_d1(:), y_d(:), x_d(:) @@ -536,13 +534,13 @@ contains if (t_step_old /= dflt_int) then nondim_time = real(t_step + t_step_old, kind(0d0))*dt else - nondim_time = real(t_step, kind(0d0))*dt + nondim_time = real(t_step, kind(0d0))*dt end if root = 0 allocate (x_d1(m*n)) allocate (y_d1(m*n)) counter = 0 - + ! if () ! if (mod(p, 2) > 0) then ! ! cent = p/2 + 1/2 @@ -553,44 +551,42 @@ contains ! elseif (p == 0) then ! cent = 0 ! endif - do l = 0,p - if (z_cc(l) .lt. dz(l) .and. z_cc(l) .gt. 0) then - cent = l - endif - enddo - do k = 0, n - OLoop: do j = 0, m - axp = q_prim_vf(E_idx + 1)%sf(j + 1, k, cent) - axm = q_prim_vf(E_idx + 1)%sf(j - 1, k, cent) - ayp = q_prim_vf(E_idx + 1)%sf(j, k + 1, cent) - aym = q_prim_vf(E_idx + 1)%sf(j, k - 1, cent) - - - if ((axp > 0.9 .and. axm < 0.9) .or. (axp < 0.9 .and. axm > 0.9) & - .or. (ayp > 0.9 .and. aym < 0.9) .or. (ayp < 0.9 .and. aym > 0.9)) then - if (counter == 0) then - counter = counter + 1 - x_d1(counter) = x_cc(j) - y_d1(counter) = y_cc(k) - else - do i = 1, counter - if (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & - y_d1(i))**2) <= 2*sqrt(dx(j)**2 & - + dy(k)**2)) then - cycle OLoop - elseif (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & - y_d1(i))**2) > 2*sqrt(dx(j)**2 & - + dy(k)**2) .and. i == counter) then - counter = counter + 1 - x_d1(counter) = x_cc(j) - y_d1(counter) = y_cc(k) - end if - end do - end if + do l = 0, p + if (z_cc(l) < dz(l) .and. z_cc(l) > 0) then + cent = l + end if + end do + do k = 0, n + OLoop: do j = 0, m + axp = q_prim_vf(E_idx + 1)%sf(j + 1, k, cent) + axm = q_prim_vf(E_idx + 1)%sf(j - 1, k, cent) + ayp = q_prim_vf(E_idx + 1)%sf(j, k + 1, cent) + aym = q_prim_vf(E_idx + 1)%sf(j, k - 1, cent) + + if ((axp > 0.9 .and. axm < 0.9) .or. (axp < 0.9 .and. axm > 0.9) & + .or. (ayp > 0.9 .and. aym < 0.9) .or. (ayp < 0.9 .and. aym > 0.9)) then + if (counter == 0) then + counter = counter + 1 + x_d1(counter) = x_cc(j) + y_d1(counter) = y_cc(k) + else + do i = 1, counter + if (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & + y_d1(i))**2) <= 2*sqrt(dx(j)**2 & + + dy(k)**2)) then + cycle OLoop + elseif (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & + y_d1(i))**2) > 2*sqrt(dx(j)**2 & + + dy(k)**2) .and. i == counter) then + counter = counter + 1 + x_d1(counter) = x_cc(j) + y_d1(counter) = y_cc(k) + end if + end do end if - end do OLoop - end do - + end if + end do OLoop + end do allocate (y_d(counter)) allocate (x_d(counter)) @@ -598,57 +594,55 @@ contains y_d(i) = y_d1(i) x_d(i) = x_d1(i) end do - ! if (num_procs > 1) then - call s_mpi_gather_data(x_d, counter, x_td, root) - call s_mpi_gather_data(y_d, counter, y_td, root) - if (proc_rank == 0) then - do i = 1, size(x_td) - if (i == size(x_td)) then - write (21519, '(F12.9,1X,F12.9,1X,I4, 1X, F12.9, 1X, F12.9)') & - x_td(i), y_td(i), size(x_td), xcom(2), nondim_time - else - write (21519, '(F12.9,1X,F12.9,1X,F3.1,1X,F3.1,1X,F3.1)') & - x_td(i), y_td(i), 0d0, 0d0, 0d0 - end if - end do - end if - ! end if - print*, x_d + ! if (num_procs > 1) then + call s_mpi_gather_data(x_d, counter, x_td, root) + call s_mpi_gather_data(y_d, counter, y_td, root) + if (proc_rank == 0) then + do i = 1, size(x_td) + if (i == size(x_td)) then + write (21519, '(F12.9,1X,F12.9,1X,I4, 1X, F12.9, 1X, F12.9)') & + x_td(i), y_td(i), size(x_td), xcom(2), nondim_time + else + write (21519, '(F12.9,1X,F12.9,1X,F3.1,1X,F3.1,1X,F3.1)') & + x_td(i), y_td(i), 0d0, 0d0, 0d0 + end if + end do + end if + ! end if end subroutine s_write_sim_data_file ! ----------------------------------- - subroutine s_write_eng_data_file(q_prim_vf, t_step) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer, intent(IN) :: t_step integer :: i, j!< Generic loop iterators integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations - real(kind(0d0)) :: Elk, Egk, Eint - real(kind(0d0)) :: nondim_time + real(kind(0d0)) :: Elk, Egk, Eint + real(kind(0d0)) :: nondim_time if (t_step_old /= dflt_int) then nondim_time = real(t_step + t_step_old, kind(0d0))*dt else - nondim_time = real(t_step, kind(0d0))*dt + nondim_time = real(t_step, kind(0d0))*dt end if root = 0 - + call s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Eint) - if (t_step > t_step_start) then + if (t_step > t_step_start) then write (21520, '(F19.3,1X,F19.3,1X, F19.3, 1X, F12.9)') & - Eint, Elk, Egk, nondim_time - end if + Eint, Elk, Egk, nondim_time + end if + + end subroutine s_write_eng_data_file - end subroutine s_write_eng_data_file - subroutine s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Eint) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf real(kind(0d0)), intent(OUT) :: Elk, Egk, Eint real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, qv, Elks, Egks, Eints real(kind(0d0)), dimension(num_dims) :: vel integer :: i, j, k, l, s !looping indicies - + Elk = 0d0 Egk = 0d0 Eint = 0d0 @@ -666,21 +660,21 @@ contains pi_inf = 0d0 !$acc loop seq do l = 1, num_fluids - rho = rho + q_prim_vf(E_idx+l)%sf(i, j, k)*q_prim_vf(l)%sf(i, j, k) - gamma = gamma + q_prim_vf(E_idx+l)%sf(i, j, k)*gammas(l) - pi_inf = pi_inf + q_prim_vf(E_idx+l)%sf(i, j, k)*pi_infs(l) + rho = rho + q_prim_vf(E_idx + l)%sf(i, j, k)*q_prim_vf(l)%sf(i, j, k) + gamma = gamma + q_prim_vf(E_idx + l)%sf(i, j, k)*gammas(l) + pi_inf = pi_inf + q_prim_vf(E_idx + l)%sf(i, j, k)*pi_infs(l) end do pres = q_prim_vf(E_idx)%sf(i, j, k) - Eints = gamma*pres+pi_inf + Eints = gamma*pres + pi_inf dV = dx(i)*dy(j)*dz(k) !$acc loop vector do s = 1, num_dims - vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) + vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9) then Elks = Elks + 0.5d0*rho*vel(s)*vel(s) else Egks = Egks + 0.5d0*rho*vel(s)*vel(s) - endif + end if end do Elk = Elk + Elks*dV Egk = Egk + Egks*dV @@ -2203,7 +2197,6 @@ contains end subroutine s_close_eng_data_file !--------------------- - !> Closes probe files subroutine s_close_probe_files() ! ------------------------------------- diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index 67e25ea4c4..6e3dc6bbb8 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -121,7 +121,7 @@ subroutine s_compute_derived_variables(q_prim_vf, t_step) ! -------------------- integer, intent(IN) :: t_step type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - + integer :: i, j, k !< Generic loop iterators if (probe_wrt) then @@ -165,9 +165,9 @@ subroutine s_compute_derived_variables(q_prim_vf, t_step) ! -------------------- call s_write_probe_files(t_step, q_cons_ts(1)%vf, accel_mag) call s_write_com_files(t_step, c_mass) end if - + if ((sim_data) .and. (mod(t_step - t_step_start, t_step_save) == 0 .or. & - t_step > t_step_stop)) then + t_step > t_step_stop)) then call s_write_sim_data_file(q_prim_vf, t_step) call s_write_eng_data_file(q_prim_vf, t_step) end if From 9fbb59827de3a1d4e53cafc8f20b8cd8dd382688 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Tue, 30 Apr 2024 13:44:31 -0500 Subject: [PATCH 055/380] patch smoothing for spherical harmonic is now working --- src/pre_process/m_check_patches.fpp | 3 +- src/pre_process/m_patches.fpp | 75 ++++++++++++++++++----------- 2 files changed, 50 insertions(+), 28 deletions(-) diff --git a/src/pre_process/m_check_patches.fpp b/src/pre_process/m_check_patches.fpp index 72452ba6d3..464ba531d5 100644 --- a/src/pre_process/m_check_patches.fpp +++ b/src/pre_process/m_check_patches.fpp @@ -117,7 +117,8 @@ contains patch_icpp(i)%geometry == 8 .or. & patch_icpp(i)%geometry == 10 .or. & patch_icpp(i)%geometry == 11 .or. & - patch_icpp(i)%geometry == 12)) then + patch_icpp(i)%geometry == 12 .or. & + patch_icpp(i)%geometry == 14)) then call s_check_supported_patch_smoothing(i) else call s_check_unsupported_patch_smoothing(i) diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index b256a0116f..e345c8f883 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -1365,7 +1365,7 @@ contains real(kind(0d0)) :: r, x_p, P2, P3, P4, P5, P6, P7, P8, P9, P10, P11, P12, eps, phi real(kind(0d0)) :: a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 - real(kind(0d0)) :: radius, x_centroid, y_centroid, z_centroid + real(kind(0d0)) :: radius, x_centroid, y_centroid, z_centroid, eta, smooth_coeff logical :: non_axis_sym integer :: i, j, k !< generic loop iterators @@ -1401,7 +1401,7 @@ contains ! 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) then + if (p > 0 .and. .not. non_axis_sym) then do k = 0, p do j = 0, n do i = 0, m @@ -1413,48 +1413,69 @@ contains end if r = dsqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) + eps - x_p = dabs(x_cc(i) - x_centroid + eps)/r + if (x_cc(i)-x_centroid <= 0) then + x_p = -dabs(x_cc(i) - x_centroid + eps)/r + else + x_p = dabs(x_cc(i) - x_centroid + eps)/r + end if + P2 = unassociated_legendre(x_p, 2) P3 = unassociated_legendre(x_p, 3) P4 = unassociated_legendre(x_p, 4) P5 = unassociated_legendre(x_p, 5) P6 = unassociated_legendre(x_p, 6) P7 = unassociated_legendre(x_p, 7) - - if (x_cc(i) - x_centroid >= 0 & + if ((x_cc(i) - x_centroid >= 0 & .and. & r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7 <= radius & .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) & - 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 & - + (cart_z - z_centroid)**2) & - -(r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7)))*(-0.5d0) + 0.5d0 - end if - - call s_assign_patch_primitive_variables(patch_id, i, j, k, & - eta, q_prim_vf, patch_id_fp) - - elseif (x_cc(i) - x_centroid < 0 & - .and. & - r - a2*P2 + a3*P3 - a4*P4 + a5*P5 - a6*P6 + a7*P7 <= radius & - .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) & + 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 = tanh(smooth_coeff/min(dx, dy, dz)* & - (sqrt((x_cc(i) - x_centroid)**2 & - + (cart_y - y_centroid)**2 & - + (cart_z - z_centroid)**2) & - -(r - a2*P2 + a3*P3 - a4*P4 + a5*P5 - a6*P6 + a7*P7)))*(-0.5d0) + 0.5d0 + ((r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7) & + - radius))*(-0.5d0) + 0.5d0 end if call s_assign_patch_primitive_variables(patch_id, i, j, k, & eta, q_prim_vf, patch_id_fp) end if + ! if ((x_cc(i) - x_centroid >= 0 & + ! .and. & + ! r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7 <= 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 = tanh(smooth_coeff/min(dx, dy, dz)* & + ! ((r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7) & + ! - radius))*(-0.5d0) + 0.5d0 + ! end if +! + ! call s_assign_patch_primitive_variables(patch_id, i, j, k, & + ! eta, q_prim_vf, patch_id_fp) + ! @:analytical() + + ! elseif ((x_cc(i) - x_centroid < 0 & + ! .and. & + ! r - a2*P2 + a3*P3 - a4*P4 + a5*P5 - a6*P6 + a7*P7 <= 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 = tanh(smooth_coeff/min(dx, dy, dz)* & + ! ((r - a2*P2 + a3*P3 - a4*P4 + a5*P5 - a6*P6 + a7*P7) & + ! - radius))*(-0.5d0) + 0.5d0 + ! end if + + ! call s_assign_patch_primitive_variables(patch_id, i, j, k, & + ! eta, q_prim_vf, patch_id_fp) + ! @:analytical() + + ! end if end do end do end do From 40be12a984280de055515ce17d8e860512b832eb Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Mon, 6 May 2024 07:12:10 -0500 Subject: [PATCH 056/380] Incremental --- src/simulation/m_data_output.fpp | 39 +++++++++++++++++++------------- submit_gpu.sh | 2 +- 2 files changed, 24 insertions(+), 17 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index b9f1391c1c..b697f8a6c5 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -587,7 +587,6 @@ contains end if end do OLoop end do - allocate (y_d(counter)) allocate (x_d(counter)) do i = 1, counter @@ -608,7 +607,6 @@ contains end if end do end if - ! end if end subroutine s_write_sim_data_file ! ----------------------------------- @@ -618,7 +616,7 @@ contains integer :: i, j!< Generic loop iterators integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations - real(kind(0d0)) :: Elk, Egk, Eint + real(kind(0d0)) :: Elk, Egk, Elint, Egint real(kind(0d0)) :: nondim_time if (t_step_old /= dflt_int) then @@ -628,32 +626,34 @@ contains end if root = 0 - call s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Eint) + call s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Elint, Egint) if (t_step > t_step_start) then - write (21520, '(F19.3,1X,F19.3,1X, F19.3, 1X, F12.9)') & - Eint, Elk, Egk, nondim_time + write (21520, '(F19.3,1X,F19.3,1X, F19.3,1X,F19.3, 1X, F12.9)') & + Elint, Egint, Elk, Egk, nondim_time end if end subroutine s_write_eng_data_file - subroutine s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Eint) + subroutine s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Elint, Egint) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), intent(OUT) :: Elk, Egk, Eint - real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, qv, Elks, Egks, Eints + real(kind(0d0)), intent(OUT) :: Elk, Egk, Elint, Egint + real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, qv, Elks, Egks, Elints, Egints real(kind(0d0)), dimension(num_dims) :: vel integer :: i, j, k, l, s !looping indicies Elk = 0d0 Egk = 0d0 - Eint = 0d0 + Elint = 0d0 + Egint = 0d0 if (p > 0) then - !$acc parallel loop collapse(3) gang vector default(present) private(Elks, Egks, Eints, pres, rho, gamma, pi_inf, vel, dV) + !$acc parallel loop collapse(3) gang vector default(present) private(Elks, Egks, Egints, Elints, pres, rho, gamma, pi_inf, vel, dV) do k = 0, p do j = 0, n do i = 0, m Elks = 0d0 Egks = 0d0 - Eints = 0d0 + Elints = 0d0 + Egints = 0d0 pres = 0d0 rho = 0d0 gamma = 0d0 @@ -665,7 +665,6 @@ contains pi_inf = pi_inf + q_prim_vf(E_idx + l)%sf(i, j, k)*pi_infs(l) end do pres = q_prim_vf(E_idx)%sf(i, j, k) - Eints = gamma*pres + pi_inf dV = dx(i)*dy(j)*dz(k) !$acc loop vector do s = 1, num_dims @@ -676,9 +675,15 @@ contains Egks = Egks + 0.5d0*rho*vel(s)*vel(s) end if end do + if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9) then + Elints = gamma*pres + pi_inf + else + Egints = gamma*pres + pi_inf + end if Elk = Elk + Elks*dV Egk = Egk + Egks*dV - Eint = Eint + Eints*dV + Egint = Egint + Egints*dV + Elint = Elint + Elints*dV end do end do end do @@ -686,8 +691,10 @@ contains end if tmp = Elk call s_mpi_allreduce_sum(tmp, Elk) - tmp = Eint - call s_mpi_allreduce_sum(tmp, Eint) + tmp = Elint + call s_mpi_allreduce_sum(tmp, Elint) + tmp = Egint + call s_mpi_allreduce_sum(tmp, Egint) tmp = Egk call s_mpi_allreduce_sum(tmp, Egk) diff --git a/submit_gpu.sh b/submit_gpu.sh index 4626512e23..11bbca2b41 100755 --- a/submit_gpu.sh +++ b/submit_gpu.sh @@ -1 +1 @@ - ./mfc.sh run /scratch/bciv/sremillard/sph_col_5MPa/3Dshinput_new.py -e batch -p gpuA40x4 -N 3 -n 4 -g 4 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta + ./mfc.sh run /scratch/bciv/sremillard/sph_col_1atm/3Dshinput_new.py -e batch -p gpuA40x4 -N 5 -n 4 -g 4 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta From 35a35250d47c99147b5cd0e7bd87d8d509d6cbf8 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Mon, 6 May 2024 08:37:43 -0500 Subject: [PATCH 057/380] added sim_data flag --- src/simulation/m_start_up.fpp | 2 +- submit_gpu.sh | 2 +- toolchain/mfc/run/case_dicts.py | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 89465b26c0..22235da660 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -124,7 +124,7 @@ contains character(len=1000) :: line ! Namelist of the global parameters which may be specified by user - namelist /user_inputs/ case_dir, run_time_info, m, n, p, dt, & + namelist /user_inputs/ case_dir, run_time_info, sim_data, m, n, p, dt, & t_step_start, t_step_stop, t_step_save, t_step_print, & model_eqns, num_fluids, adv_alphan, & mpp_lim, time_stepper, weno_eps, weno_flat, & diff --git a/submit_gpu.sh b/submit_gpu.sh index 11bbca2b41..2df5bd8c36 100755 --- a/submit_gpu.sh +++ b/submit_gpu.sh @@ -1 +1 @@ - ./mfc.sh run /scratch/bciv/sremillard/sph_col_1atm/3Dshinput_new.py -e batch -p gpuA40x4 -N 5 -n 4 -g 4 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta + ./mfc.sh run /scratch/bciv/sremillard/sph_col_1atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index fb9b3acc0c..769ae021d1 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -84,7 +84,7 @@ PRE_PROCESS.append(f'patch_icpp({p_id})%alter_patch({alter_id})') SIMULATION = COMMON + [ - 'run_time_info', 't_step_old', 't_tol', 'dt', 't_step_start', + 'run_time_info','sim_data', 't_step_old', 't_tol', 'dt', 't_step_start', 't_step_stop', 't_step_save', 't_step_print', 'time_stepper', 'weno_eps', 'mapped_weno', 'mp_weno', 'weno_avg', 'weno_Re_flux', 'riemann_solver', 'wave_speeds', 'avg_state', 'prim_vars_wrt', From 5260bba02f60312a6f1c4fe36b30e2c7590654e0 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 6 May 2024 08:38:45 -0500 Subject: [PATCH 058/380] merged again with energy code --- 3Dshinput_new.py | 205 ----------------------------------------------- 1 file changed, 205 deletions(-) delete mode 100644 3Dshinput_new.py diff --git a/3Dshinput_new.py b/3Dshinput_new.py deleted file mode 100644 index bd7c64947e..0000000000 --- a/3Dshinput_new.py +++ /dev/null @@ -1,205 +0,0 @@ -import math -import json - - -## Deine characteristic values for the sim -Ri = 500E-6 -rhol = 1051 -rhog = 0.027 -Pb = 3550 -Pl = 5.0E+06 -#mulc = 9E-04 -#mubc = 1.0E-05 -domain_length = 4*Ri - - -## fluid properties -Pi_inf_l = 702.8E+06 -Pi_inf_b = 0.0E+00 -nl = 1.19 -nb = 1.47 -bl = 6.61E-04 -bb = 0.0E+00 -alpha1 = 1.0E+00 -alpha2 = alpha1 -cl = (nl*(Pl+Pi_inf_l)/(rhol*(1-rhol*bl)))**(0.5) - -## Defining Characteristic Values -Rc = Ri -rhoc = rhol -uc = (Pl/rhol)**(0.5E+00) -tc = Ri/uc -Pc = rhoc*uc**(2.0E+00) - -## Non-Dimensionalizing values using characteristic values -Rin = Ri/Rc -rholn = rhol/rhoc -rhogn = rhog/rhoc -Pln = Pl/Pc -Pbn = Pb/Pc -tcn = tc/tc -Pi_inf_ln = Pi_inf_l/Pc -leng = domain_length/Rc -clc = cl/uc - - -## Non-Dimensional Numbers -#Rel = rhol*uc*2*Rin/mulc -#Reb = rhog*uc*2*Rin/mubc -Ma = uc/cl - -## Grid Specifications -CFL = 0.005 -PpBr = 48 -Nx = PpBr*leng -Ny = Nx -Nz = Nx -x_beg = 0.0E+00*leng -x_end = 0.5E+00*leng -y_beg = 0.0E+00 -y_end = 0.5E+00*leng -z_beg = 0.0E+00 -z_end = 0.5E+00*leng -delta_x = leng/Nx -delta_t = CFL*delta_x/clc -Nt = int(1.0*tcn/delta_t) -x_centroidl = (x_end+x_beg)/(2.0E+00) -y_centroidl = (y_end+y_beg)/(2.0E+00) -z_centroidl = (z_end+z_beg)/(2.0E+00) -x_centroidb = 0.0E+00 -y_centroidb = 0.0E+00 -z_centroidb = 0.0E+00 - - -# Configuring case dictionary -print(json.dumps({ - # Logistics ================================================ - 'run_time_info' : 'T', - 'sim_data' : 'F', - # ========================================================== - - # Computational Domain Parameters ========================== - 'x_domain%beg' : x_beg, - 'x_domain%end' : x_end, - 'y_domain%beg' : y_beg, - 'y_domain%end' : y_end, - 'z_domain%beg' : z_beg, - 'z_domain%end' : z_end, - 'm' : int(Nx), - 'n' : int(Ny), - 'p' : int(Nz), - 'cyl_coord' : 'F', - 'dt' : delta_t, - 't_step_start' : 0, - 't_step_stop' : Nt, - 't_step_save' : 1, -# ========================================================== - - # Simulation Algorithm Parameters ========================== - 'num_patches' : 2, - 'model_eqns' : 3, - 'alt_soundspeed' : 'F', - 'num_fluids' : 2, - 'adv_alphan' : 'T', - 'mpp_lim' : 'T', - 'mixture_err' : 'T', - 'time_stepper' : 3, - 'weno_order' : 5, - 'weno_eps' : 1.E-100, - 'mapped_weno' : 'T', - 'null_weights' : 'F', - 'mp_weno' : 'F', - 'weno_Re_flux' : 'F', - 'weno_avg' : 'F', - 'riemann_solver' : 2, - 'wave_speeds' : 1, - 'avg_state' : 2, - 'bc_x%beg' : -2, - 'bc_x%end' : -6, - 'bc_y%beg' : -2, - 'bc_y%end' : -6, - 'bc_z%beg' : -2, - 'bc_z%end' : -6, - 'stretch_x' : 'T', - 'stretch_y' : 'T', - 'stretch_z' : 'T', - 'a_x' : 4.0E+00, - 'x_a' : -1.5E+00, - 'x_b' : 1.5E+00, - 'a_y' : 4.0E+00, - 'y_a' : -1.5E+00, - 'y_b' : 1.5E+00, - 'a_z' : 4.0E+00, - 'z_a' : -1.5E+00, - 'z_b' : 1.5E+00, - # ========================================================== - - # Formatted Database Files Structure Parameters ============ - 'format' : 1, - 'precision' : 2, - 'prim_vars_wrt' :'T', - 'parallel_io' :'T', - 'fd_order' :'1', - 'probe_wrt' :'T', - 'num_probes' : 1, - 'probe(1)%x' : 0., - 'probe(1)%y' : 0., - 'probe(1)%z' : 0., - # ========================================================== - - # Patch 1: Background ============================ - 'patch_icpp(1)%geometry' : 9, - 'patch_icpp(1)%x_centroid' : 40*x_centroidl, - 'patch_icpp(1)%y_centroid' : 40*y_centroidl, - 'patch_icpp(1)%z_centroid' : 40*z_centroidl, - 'patch_icpp(1)%length_x' : 40*leng, - 'patch_icpp(1)%length_y' : 40*leng, - 'patch_icpp(1)%length_z' : 40*leng, - 'patch_icpp(1)%vel(1)' : 0.E+00, - 'patch_icpp(1)%vel(2)' : 0.E+00, - 'patch_icpp(1)%vel(3)' : 0.E+00, - 'patch_icpp(1)%pres' : Pln, - 'patch_icpp(1)%alpha_rho(1)' : alpha1*rholn, - 'patch_icpp(1)%alpha_rho(2)' : 0.0E+00, - 'patch_icpp(1)%alpha(1)' : alpha1, - 'patch_icpp(1)%alpha(2)' : 0.0E+00, - # ========================================================== - # Patch 2: Bubble ====================================== - 'patch_icpp(2)%geometry' : 8,#14, - 'patch_icpp(2)%x_centroid' : x_centroidb, - 'patch_icpp(2)%y_centroid' : y_centroidb, - 'patch_icpp(2)%z_centroid' : z_centroidb, - 'patch_icpp(2)%radius' : Rin, - 'patch_icpp(2)%smoothen' : 'T', - 'patch_icpp(2)%smooth_patch_id': 1, - 'patch_icpp(2)%smooth_coeff' : 0.5E+00, -# 'patch_icpp(2)%non_axis_sym' : 'F', -# 'patch_icpp(2)%a2' : 0.0E+00, -# 'patch_icpp(2)%a3' : 0.0E+00, -# 'patch_icpp(2)%a4' : 0.0E+00, -# 'patch_icpp(2)%a5' : 0.0E+00, -# 'patch_icpp(2)%a6' : 0.0E+00, -# 'patch_icpp(2)%a7' : 0.0E+00, - 'patch_icpp(2)%alter_patch(1)' : 'T', - 'patch_icpp(2)%vel(1)' : 0.E+00, - 'patch_icpp(2)%vel(2)' : 0.E+00, - 'patch_icpp(2)%vel(3)' : 0.E+00, - 'patch_icpp(2)%pres' : Pbn, - 'patch_icpp(2)%alpha_rho(1)' : 0.0E+00, - 'patch_icpp(2)%alpha_rho(2)' : alpha2*rhogn, - 'patch_icpp(2)%alpha(1)' : 0.0E+00, - 'patch_icpp(2)%alpha(2)' : alpha2, - # ========================================================== - - # Fluids Physical Parameters =============================== - 'fluid_pp(1)%gamma' : 1/(nl-1), - 'fluid_pp(1)%pi_inf' : nl*Pi_inf_ln/(nl-1), - 'fluid_pp(2)%gamma' : 1/(nb-1), - 'fluid_pp(2)%pi_inf' : 0.0E+00, -# 'fluid_pp(1)%Re(1)' : Rel, -# 'fluid_pp(2)%Re(1)' : Reb, - # ========================================================== -})) - -# ============================================================================== - From 9939abe70d58d4ac852ceb689bcc460afdfc15c5 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Mon, 6 May 2024 08:42:41 -0500 Subject: [PATCH 059/380] added input file --- 3Dshinput_new.py | 205 ----------------------------------------------- 1 file changed, 205 deletions(-) delete mode 100644 3Dshinput_new.py diff --git a/3Dshinput_new.py b/3Dshinput_new.py deleted file mode 100644 index bd7c64947e..0000000000 --- a/3Dshinput_new.py +++ /dev/null @@ -1,205 +0,0 @@ -import math -import json - - -## Deine characteristic values for the sim -Ri = 500E-6 -rhol = 1051 -rhog = 0.027 -Pb = 3550 -Pl = 5.0E+06 -#mulc = 9E-04 -#mubc = 1.0E-05 -domain_length = 4*Ri - - -## fluid properties -Pi_inf_l = 702.8E+06 -Pi_inf_b = 0.0E+00 -nl = 1.19 -nb = 1.47 -bl = 6.61E-04 -bb = 0.0E+00 -alpha1 = 1.0E+00 -alpha2 = alpha1 -cl = (nl*(Pl+Pi_inf_l)/(rhol*(1-rhol*bl)))**(0.5) - -## Defining Characteristic Values -Rc = Ri -rhoc = rhol -uc = (Pl/rhol)**(0.5E+00) -tc = Ri/uc -Pc = rhoc*uc**(2.0E+00) - -## Non-Dimensionalizing values using characteristic values -Rin = Ri/Rc -rholn = rhol/rhoc -rhogn = rhog/rhoc -Pln = Pl/Pc -Pbn = Pb/Pc -tcn = tc/tc -Pi_inf_ln = Pi_inf_l/Pc -leng = domain_length/Rc -clc = cl/uc - - -## Non-Dimensional Numbers -#Rel = rhol*uc*2*Rin/mulc -#Reb = rhog*uc*2*Rin/mubc -Ma = uc/cl - -## Grid Specifications -CFL = 0.005 -PpBr = 48 -Nx = PpBr*leng -Ny = Nx -Nz = Nx -x_beg = 0.0E+00*leng -x_end = 0.5E+00*leng -y_beg = 0.0E+00 -y_end = 0.5E+00*leng -z_beg = 0.0E+00 -z_end = 0.5E+00*leng -delta_x = leng/Nx -delta_t = CFL*delta_x/clc -Nt = int(1.0*tcn/delta_t) -x_centroidl = (x_end+x_beg)/(2.0E+00) -y_centroidl = (y_end+y_beg)/(2.0E+00) -z_centroidl = (z_end+z_beg)/(2.0E+00) -x_centroidb = 0.0E+00 -y_centroidb = 0.0E+00 -z_centroidb = 0.0E+00 - - -# Configuring case dictionary -print(json.dumps({ - # Logistics ================================================ - 'run_time_info' : 'T', - 'sim_data' : 'F', - # ========================================================== - - # Computational Domain Parameters ========================== - 'x_domain%beg' : x_beg, - 'x_domain%end' : x_end, - 'y_domain%beg' : y_beg, - 'y_domain%end' : y_end, - 'z_domain%beg' : z_beg, - 'z_domain%end' : z_end, - 'm' : int(Nx), - 'n' : int(Ny), - 'p' : int(Nz), - 'cyl_coord' : 'F', - 'dt' : delta_t, - 't_step_start' : 0, - 't_step_stop' : Nt, - 't_step_save' : 1, -# ========================================================== - - # Simulation Algorithm Parameters ========================== - 'num_patches' : 2, - 'model_eqns' : 3, - 'alt_soundspeed' : 'F', - 'num_fluids' : 2, - 'adv_alphan' : 'T', - 'mpp_lim' : 'T', - 'mixture_err' : 'T', - 'time_stepper' : 3, - 'weno_order' : 5, - 'weno_eps' : 1.E-100, - 'mapped_weno' : 'T', - 'null_weights' : 'F', - 'mp_weno' : 'F', - 'weno_Re_flux' : 'F', - 'weno_avg' : 'F', - 'riemann_solver' : 2, - 'wave_speeds' : 1, - 'avg_state' : 2, - 'bc_x%beg' : -2, - 'bc_x%end' : -6, - 'bc_y%beg' : -2, - 'bc_y%end' : -6, - 'bc_z%beg' : -2, - 'bc_z%end' : -6, - 'stretch_x' : 'T', - 'stretch_y' : 'T', - 'stretch_z' : 'T', - 'a_x' : 4.0E+00, - 'x_a' : -1.5E+00, - 'x_b' : 1.5E+00, - 'a_y' : 4.0E+00, - 'y_a' : -1.5E+00, - 'y_b' : 1.5E+00, - 'a_z' : 4.0E+00, - 'z_a' : -1.5E+00, - 'z_b' : 1.5E+00, - # ========================================================== - - # Formatted Database Files Structure Parameters ============ - 'format' : 1, - 'precision' : 2, - 'prim_vars_wrt' :'T', - 'parallel_io' :'T', - 'fd_order' :'1', - 'probe_wrt' :'T', - 'num_probes' : 1, - 'probe(1)%x' : 0., - 'probe(1)%y' : 0., - 'probe(1)%z' : 0., - # ========================================================== - - # Patch 1: Background ============================ - 'patch_icpp(1)%geometry' : 9, - 'patch_icpp(1)%x_centroid' : 40*x_centroidl, - 'patch_icpp(1)%y_centroid' : 40*y_centroidl, - 'patch_icpp(1)%z_centroid' : 40*z_centroidl, - 'patch_icpp(1)%length_x' : 40*leng, - 'patch_icpp(1)%length_y' : 40*leng, - 'patch_icpp(1)%length_z' : 40*leng, - 'patch_icpp(1)%vel(1)' : 0.E+00, - 'patch_icpp(1)%vel(2)' : 0.E+00, - 'patch_icpp(1)%vel(3)' : 0.E+00, - 'patch_icpp(1)%pres' : Pln, - 'patch_icpp(1)%alpha_rho(1)' : alpha1*rholn, - 'patch_icpp(1)%alpha_rho(2)' : 0.0E+00, - 'patch_icpp(1)%alpha(1)' : alpha1, - 'patch_icpp(1)%alpha(2)' : 0.0E+00, - # ========================================================== - # Patch 2: Bubble ====================================== - 'patch_icpp(2)%geometry' : 8,#14, - 'patch_icpp(2)%x_centroid' : x_centroidb, - 'patch_icpp(2)%y_centroid' : y_centroidb, - 'patch_icpp(2)%z_centroid' : z_centroidb, - 'patch_icpp(2)%radius' : Rin, - 'patch_icpp(2)%smoothen' : 'T', - 'patch_icpp(2)%smooth_patch_id': 1, - 'patch_icpp(2)%smooth_coeff' : 0.5E+00, -# 'patch_icpp(2)%non_axis_sym' : 'F', -# 'patch_icpp(2)%a2' : 0.0E+00, -# 'patch_icpp(2)%a3' : 0.0E+00, -# 'patch_icpp(2)%a4' : 0.0E+00, -# 'patch_icpp(2)%a5' : 0.0E+00, -# 'patch_icpp(2)%a6' : 0.0E+00, -# 'patch_icpp(2)%a7' : 0.0E+00, - 'patch_icpp(2)%alter_patch(1)' : 'T', - 'patch_icpp(2)%vel(1)' : 0.E+00, - 'patch_icpp(2)%vel(2)' : 0.E+00, - 'patch_icpp(2)%vel(3)' : 0.E+00, - 'patch_icpp(2)%pres' : Pbn, - 'patch_icpp(2)%alpha_rho(1)' : 0.0E+00, - 'patch_icpp(2)%alpha_rho(2)' : alpha2*rhogn, - 'patch_icpp(2)%alpha(1)' : 0.0E+00, - 'patch_icpp(2)%alpha(2)' : alpha2, - # ========================================================== - - # Fluids Physical Parameters =============================== - 'fluid_pp(1)%gamma' : 1/(nl-1), - 'fluid_pp(1)%pi_inf' : nl*Pi_inf_ln/(nl-1), - 'fluid_pp(2)%gamma' : 1/(nb-1), - 'fluid_pp(2)%pi_inf' : 0.0E+00, -# 'fluid_pp(1)%Re(1)' : Rel, -# 'fluid_pp(2)%Re(1)' : Reb, - # ========================================================== -})) - -# ============================================================================== - From 5e5df16e844cab32bc2346548473c55b6ba3f643 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Mon, 6 May 2024 09:57:06 -0500 Subject: [PATCH 060/380] incremental --- examples/3D_CAV/3D_CAV_sph_col.py | 205 ++++++++++++++++++++++++++++++ submit_gpu.sh | 2 +- 2 files changed, 206 insertions(+), 1 deletion(-) create mode 100644 examples/3D_CAV/3D_CAV_sph_col.py diff --git a/examples/3D_CAV/3D_CAV_sph_col.py b/examples/3D_CAV/3D_CAV_sph_col.py new file mode 100644 index 0000000000..a54df0a5b6 --- /dev/null +++ b/examples/3D_CAV/3D_CAV_sph_col.py @@ -0,0 +1,205 @@ +import math +import json + + +## Deine characteristic values for the sim +Ri = 50E-6 +T = 407.9 +rhog = 0.027 +Pb = 3550 +Pl = 101325 +#mulc = 9E-04 +#mubc = 1.0E-05 +domain_length = 3*Ri + + +## fluid properties +Pi_inf_l = 1.0E+09 +Pi_inf_b = 0.0E+00 +nl = 2.35 +nb = 1.47 +alpha1 = 1.0E+00 +Cv_l = 1816 +rhol = (Pl+Pi_inf_l)/((nl-1)*Cv_l*T) +alpha2 = alpha1 +cl = (nl*(Pl+Pi_inf_l)/rhol)**(0.5) + +## Defining Characteristic Values +Rc = Ri +rhoc = rhol +uc = (Pl/rhol)**(0.5E+00) +tc = Ri/uc +Pc = rhoc*uc**(2.0E+00) + +## Non-Dimensionalizing values using characteristic values +Rin = Ri/Rc +rholn = rhol/rhoc +rhogn = rhog/rhoc +Pln = Pl/Pc +Pbn = Pb/Pc +tcn = tc/tc +Pi_inf_ln = Pi_inf_l/Pc +leng = domain_length/Rc +clc = cl/uc + + +## Non-Dimensional Numbers +#Rel = rhol*uc*2*Rin/mulc +#Reb = rhog*uc*2*Rin/mubc +Ma = uc/cl + +## Grid Specifications +CFL = 0.1 +PpBr = 192 +Nx = PpBr*leng +Ny = Nx +Nz = Nx +x_beg = 0.0E+00 +x_end = leng +y_beg = 0.0E+00 +y_end = leng +z_beg = 0.0E+00 +z_end = leng +delta_x = leng/Nx +delta_t = CFL*delta_x/clc +Nt = int(1.1*tcn/delta_t) +x_centroidl = (x_end+x_beg)/(2.0E+00) +y_centroidl = (y_end+y_beg)/(2.0E+00) +z_centroidl = (z_end+z_beg)/(2.0E+00) +x_centroidb = 0.0E+00 +y_centroidb = 0.0E+00 +z_centroidb = 0.0E+00 + + +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================ + 'run_time_info' : 'T', + 'sim_data' : 'T', + # ========================================================== + + # Computational Domain Parameters ========================== + 'x_domain%beg' : x_beg, + 'x_domain%end' : x_end, + 'y_domain%beg' : y_beg, + 'y_domain%end' : y_end, + 'z_domain%beg' : z_beg, + 'z_domain%end' : z_end, + 'm' : int(Nx), + 'n' : int(Ny), + 'p' : int(Nz), + 'cyl_coord' : 'F', + 'dt' : delta_t, + 't_step_start' : 0, + 't_step_stop' : Nt, + 't_step_save' : int(Nt/360), +# ========================================================== + + # Simulation Algorithm Parameters ========================== + 'num_patches' : 2, + 'model_eqns' : 2, + 'alt_soundspeed' : 'F', + 'num_fluids' : 2, + 'adv_alphan' : 'T', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'time_stepper' : 3, + 'weno_order' : 5, + 'weno_eps' : 1.E-100, + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'F', + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -2, + 'bc_x%end' : -6, + 'bc_y%beg' : -2, + 'bc_y%end' : -6, + 'bc_z%beg' : -2, + 'bc_z%end' : -6, + 'stretch_x' : 'T', + 'stretch_y' : 'T', + 'stretch_z' : 'T', + 'a_x' : 4.0E+00, + 'x_a' : -1.5E+00, + 'x_b' : 1.5E+00, + 'a_y' : 4.0E+00, + 'y_a' : -1.5E+00, + 'y_b' : 1.5E+00, + 'a_z' : 4.0E+00, + 'z_a' : -1.5E+00, + 'z_b' : 1.5E+00, + # ========================================================== + + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'T', + 'fd_order' :'1', + 'probe_wrt' :'T', + 'num_probes' : 1, + 'probe(1)%x' : 0., + 'probe(1)%y' : 0., + 'probe(1)%z' : 0., + # ========================================================== + + # Patch 1: Background ============================ + 'patch_icpp(1)%geometry' : 9, + 'patch_icpp(1)%x_centroid' : 40*x_centroidl, + 'patch_icpp(1)%y_centroid' : 40*y_centroidl, + 'patch_icpp(1)%z_centroid' : 40*z_centroidl, + 'patch_icpp(1)%length_x' : 40*leng, + 'patch_icpp(1)%length_y' : 40*leng, + 'patch_icpp(1)%length_z' : 40*leng, + 'patch_icpp(1)%vel(1)' : 0.E+00, + 'patch_icpp(1)%vel(2)' : 0.E+00, + 'patch_icpp(1)%vel(3)' : 0.E+00, + 'patch_icpp(1)%pres' : Pln, + 'patch_icpp(1)%alpha_rho(1)' : alpha1*rholn, + 'patch_icpp(1)%alpha_rho(2)' : 0.0E+00, + 'patch_icpp(1)%alpha(1)' : alpha1, + 'patch_icpp(1)%alpha(2)' : 0.0E+00, + # ========================================================== + # Patch 2: Bubble ====================================== + 'patch_icpp(2)%geometry' : 14, + 'patch_icpp(2)%x_centroid' : x_centroidb, + 'patch_icpp(2)%y_centroid' : y_centroidb, + 'patch_icpp(2)%z_centroid' : z_centroidb, + 'patch_icpp(2)%radius' : Rin, + 'patch_icpp(2)%smoothen' : 'T', + 'patch_icpp(2)%smooth_patch_id': 1, + 'patch_icpp(2)%smooth_coeff' : 1.5E+00, + 'patch_icpp(2)%non_axis_sym' : 'F', + 'patch_icpp(2)%a2' : 0.0E+00, + 'patch_icpp(2)%a3' : 0.0E+00, + 'patch_icpp(2)%a4' : 0.0E+00, + 'patch_icpp(2)%a5' : 0.0E+00, + 'patch_icpp(2)%a6' : 0.0E+00, + 'patch_icpp(2)%a7' : 0.0E+00, + 'patch_icpp(2)%alter_patch(1)' : 'T', + 'patch_icpp(2)%vel(1)' : 0.E+00, + 'patch_icpp(2)%vel(2)' : 0.E+00, + 'patch_icpp(2)%vel(3)' : 0.E+00, + 'patch_icpp(2)%pres' : Pbn, + 'patch_icpp(2)%alpha_rho(1)' : 0.0E+00, + 'patch_icpp(2)%alpha_rho(2)' : alpha2*rhogn, + 'patch_icpp(2)%alpha(1)' : 0.0E+00, + 'patch_icpp(2)%alpha(2)' : alpha2, + # ========================================================== + + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1/(nl-1), + 'fluid_pp(1)%pi_inf' : nl*Pi_inf_ln/(nl-1), + 'fluid_pp(2)%gamma' : 1/(nb-1), + 'fluid_pp(2)%pi_inf' : 0.0E+00, +# 'fluid_pp(1)%Re(1)' : Rel, +# 'fluid_pp(2)%Re(1)' : Reb, + # ========================================================== +})) + +# ============================================================================== + diff --git a/submit_gpu.sh b/submit_gpu.sh index 2df5bd8c36..7ac8be3aa7 100755 --- a/submit_gpu.sh +++ b/submit_gpu.sh @@ -1 +1 @@ - ./mfc.sh run /scratch/bciv/sremillard/sph_col_1atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta + ./mfc.sh run /scratch/bciv/sremillard/sph_col_1atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 18:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta From 01e807ae973d6e9dd0606e70369704635fd39b0b Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Mon, 6 May 2024 15:25:33 -0500 Subject: [PATCH 061/380] Incremental --- src/pre_process/m_patches.fpp | 50 ++-------- src/simulation/m_data_output.fpp | 131 ++++++++++++++++--------- src/simulation/m_derived_variables.f90 | 13 +-- submit_gpu.sh | 8 +- 4 files changed, 106 insertions(+), 96 deletions(-) diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index 83e07c8cf7..5e51650ea6 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -1437,7 +1437,7 @@ contains end if r = dsqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) + eps - if (x_cc(i)-x_centroid <= 0) then + if (x_cc(i) - x_centroid <= 0) then x_p = -dabs(x_cc(i) - x_centroid + eps)/r else x_p = dabs(x_cc(i) - x_centroid + eps)/r @@ -1450,56 +1450,22 @@ contains P6 = unassociated_legendre(x_p, 6) P7 = unassociated_legendre(x_p, 7) if ((x_cc(i) - x_centroid >= 0 & - .and. & - r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7 <= radius & - .and. & - patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. & + .and. & + r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7 <= 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 = tanh(smooth_coeff/min(dx, dy, dz)* & - ((r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7) & - - radius))*(-0.5d0) + 0.5d0 + ((r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7) & + - radius))*(-0.5d0) + 0.5d0 end if call s_assign_patch_primitive_variables(patch_id, i, j, k, & eta, q_prim_vf, patch_id_fp) end if - ! if ((x_cc(i) - x_centroid >= 0 & - ! .and. & - ! r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7 <= 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 = tanh(smooth_coeff/min(dx, dy, dz)* & - ! ((r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7) & - ! - radius))*(-0.5d0) + 0.5d0 - ! end if -! - ! call s_assign_patch_primitive_variables(patch_id, i, j, k, & - ! eta, q_prim_vf, patch_id_fp) - ! @:analytical() - - ! elseif ((x_cc(i) - x_centroid < 0 & - ! .and. & - ! r - a2*P2 + a3*P3 - a4*P4 + a5*P5 - a6*P6 + a7*P7 <= 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 = tanh(smooth_coeff/min(dx, dy, dz)* & - ! ((r - a2*P2 + a3*P3 - a4*P4 + a5*P5 - a6*P6 + a7*P7) & - ! - radius))*(-0.5d0) + 0.5d0 - ! end if - - ! call s_assign_patch_primitive_variables(patch_id, i, j, k, & - ! eta, q_prim_vf, patch_id_fp) - ! @:analytical() - - ! end if + end do end do end do diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index a7a20dd954..6533295eff 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -218,16 +218,14 @@ contains subroutine s_open_sim_data_file() ! ------------------------ - character(LEN=path_len + 5*name_len) :: file_path !< + character(LEN=path_len + 3*name_len) :: file_path !< !! Relative path to a file in the case directory - character(LEN=8) :: file_date !< - !! Creation date of the run-time information file - write (file_path, '(A)') '/sim_data.txt' + write (file_path, '(A)') '/sim_data.dat' file_path = trim(case_dir)//trim(file_path) ! Opening the simulation data file - open (21519, FILE=trim(file_path), & + open (211, FILE=trim(file_path), & FORM='formatted', & POSITION='append', & STATUS='unknown') @@ -236,16 +234,14 @@ contains subroutine s_open_eng_data_file() ! ------------------------ - character(LEN=path_len + 5*name_len) :: file_path !< + character(LEN=path_len + 3*name_len) :: file_path !< !! Relative path to a file in the case directory - character(LEN=8) :: file_date !< - !! Creation date of the run-time information file - write (file_path, '(A)') '/eng_data.txt' + write (file_path, '(A)') '/eng_data.dat' file_path = trim(case_dir)//trim(file_path) ! Opening the simulation data file - open (21520, FILE=trim(file_path), & + open (251, FILE=trim(file_path), & FORM='formatted', & POSITION='append', & STATUS='unknown') @@ -564,16 +560,6 @@ contains allocate (y_d1(m*n)) counter = 0 -! if () -! if (mod(p, 2) > 0) then -! ! cent = p/2 + 1/2 -! elseif (mod(p, 2) == 0) then -! cent = p/2 -! if (p > 0) then -! cent = 0 -! elseif (p == 0) then -! cent = 0 -! endif do l = 0, p if (z_cc(l) < dz(l) .and. z_cc(l) > 0) then cent = l @@ -622,10 +608,10 @@ contains if (proc_rank == 0) then do i = 1, size(x_td) if (i == size(x_td)) then - write (21519, '(F12.9,1X,F12.9,1X,I4, 1X, F12.9, 1X, F12.9)') & + write (211, '(F12.9,1X,F12.9,1X,I4, 1X, F12.9, 1X, F12.9)') & x_td(i), y_td(i), size(x_td), xcom(2), nondim_time else - write (21519, '(F12.9,1X,F12.9,1X,F3.1,1X,F3.1,1X,F3.1)') & + write (211, '(F12.9,1X,F12.9,1X,F3.1,1X,F3.1,1X,F3.1)') & x_td(i), y_td(i), 0d0, 0d0, 0d0 end if end do @@ -636,10 +622,11 @@ contains subroutine s_write_eng_data_file(q_prim_vf, t_step) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer, intent(IN) :: t_step - integer :: i, j!< Generic loop iterators - integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations - real(kind(0d0)) :: Elk, Egk, Elint, Egint + real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, qv, Elks, Egks, Elints, Egints + real(kind(0d0)), dimension(num_dims) :: vel + integer :: i, j, k, l, s !looping indicies + integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations real(kind(0d0)) :: nondim_time if (t_step_old /= dflt_int) then @@ -649,10 +636,68 @@ contains end if root = 0 - call s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Elint, Egint) - if (t_step > t_step_start) then - write (21520, '(F19.3,1X,F19.3,1X, F19.3,1X,F19.3, 1X, F12.9)') & - Elint, Egint, Elk, Egk, nondim_time +! call s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Elint, Egint) + + Elk = 0d0 + Egk = 0d0 + Elint = 0d0 + Egint = 0d0 + if (p > 0) then + do k = 0, p + do j = 0, n + do i = 0, m + Elks = 0d0 + Egks = 0d0 + Elints = 0d0 + Egints = 0d0 + pres = 0d0 + rho = 0d0 + gamma = 0d0 + pi_inf = 0d0 + do l = 1, num_fluids + rho = rho + q_prim_vf(E_idx + l)%sf(i, j, k)*q_prim_vf(l)%sf(i, j, k) + gamma = gamma + q_prim_vf(E_idx + l)%sf(i, j, k)*gammas(l) + pi_inf = pi_inf + q_prim_vf(E_idx + l)%sf(i, j, k)*pi_infs(l) + end do + pres = q_prim_vf(E_idx)%sf(i, j, k) + dV = dx(i)*dy(j)*dz(k) + do s = 1, num_dims + vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) + if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9) then + Elks = Elks + 0.5d0*rho*vel(s)*vel(s) + else + Egks = Egks + 0.5d0*rho*vel(s)*vel(s) + end if + end do + if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9) then + Elints = gamma*pres + pi_inf + else + Egints = gamma*pres + pi_inf + end if + Elk = Elk + Elks*dV + Egk = Egk + Egks*dV + Egint = Egint + Egints*dV + Elint = Elint + Elints*dV + end do + end do + end do + end if + tmp = Elk + call s_mpi_allreduce_sum(tmp, Elk) + tmp = Elint + call s_mpi_allreduce_sum(tmp, Elint) + tmp = Egint + call s_mpi_allreduce_sum(tmp, Egint) + tmp = Egk + call s_mpi_allreduce_sum(tmp, Egk) + call s_mpi_barrier() + if (proc_rank == 0) then + write (251, '(6X, 6F24.12)') & + Elint, & + Egint, & + Elk, & + Egk, & + nondim_time end if end subroutine s_write_eng_data_file @@ -669,7 +714,6 @@ contains Elint = 0d0 Egint = 0d0 if (p > 0) then - !$acc parallel loop collapse(3) gang vector default(present) private(Elks, Egks, Egints, Elints, pres, rho, gamma, pi_inf, vel, dV) do k = 0, p do j = 0, n do i = 0, m @@ -681,7 +725,6 @@ contains rho = 0d0 gamma = 0d0 pi_inf = 0d0 - !$acc loop seq do l = 1, num_fluids rho = rho + q_prim_vf(E_idx + l)%sf(i, j, k)*q_prim_vf(l)%sf(i, j, k) gamma = gamma + q_prim_vf(E_idx + l)%sf(i, j, k)*gammas(l) @@ -689,7 +732,6 @@ contains end do pres = q_prim_vf(E_idx)%sf(i, j, k) dV = dx(i)*dy(j)*dz(k) - !$acc loop vector do s = 1, num_dims vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9) then @@ -699,9 +741,9 @@ contains end if end do if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9) then - Elints = gamma*pres + pi_inf + Elints = gamma*pres + pi_inf else - Egints = gamma*pres + pi_inf + Egints = gamma*pres + pi_inf end if Elk = Elk + Elks*dV Egk = Egk + Egks*dV @@ -710,7 +752,6 @@ contains end do end do end do - !$acc end parallel loop end if tmp = Elk call s_mpi_allreduce_sum(tmp, Elk) @@ -2195,26 +2236,26 @@ contains subroutine s_close_sim_data_file() ! ----------------------- ! Writing the footer of and closing the run-time information file - write (21519, '(A)') '----------------------------------------'// & + write (211, '(A)') '----------------------------------------'// & '----------------------------------------' - write (21519, '(A)') '' - write (21519, '(A)') '' - write (21519, '(A)') '========================================'// & + write (211, '(A)') '' + write (211, '(A)') '' + write (211, '(A)') '========================================'// & '========================================' - close (21519) + close (211) end subroutine s_close_sim_data_file !--------------------- subroutine s_close_eng_data_file() ! ----------------------- ! Writing the footer of and closing the run-time information file - write (21520, '(A)') '----------------------------------------'// & + write (251, '(A)') '----------------------------------------'// & '----------------------------------------' - write (21520, '(A)') '' - write (21520, '(A)') '' - write (21520, '(A)') '========================================'// & + write (251, '(A)') '' + write (251, '(A)') '' + write (251, '(A)') '========================================'// & '========================================' - close (21520) + close (251) end subroutine s_close_eng_data_file !--------------------- diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index 9a2c74a054..07b788ef87 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -165,9 +165,8 @@ subroutine s_compute_derived_variables(q_prim_vf, t_step) ! -------------------- call s_write_probe_files(t_step, q_cons_ts(1)%vf, accel_mag) call s_write_com_files(t_step, c_mass) end if - - if ((sim_data) .and. (mod(t_step - t_step_start, t_step_save) == 0 .or. & - t_step > t_step_stop)) then + if (sim_data .and. mod(t_step - t_step_start, t_step_save) == 0 .or. & + t_step > t_step_stop) then call s_write_sim_data_file(q_prim_vf, t_step) call s_write_eng_data_file(q_prim_vf, t_step) end if @@ -474,11 +473,9 @@ subroutine s_finalize_derived_variables_module() ! ------------------- end if end if - if (proc_rank == 0) then - if (sim_data) then - call s_close_sim_data_file() - call s_close_eng_data_file() - end if + if (proc_rank == 0 .and. sim_data) then + call s_close_sim_data_file() + call s_close_eng_data_file() end if if (probe_wrt) then diff --git a/submit_gpu.sh b/submit_gpu.sh index 7ac8be3aa7..c03eff7bcc 100755 --- a/submit_gpu.sh +++ b/submit_gpu.sh @@ -1 +1,7 @@ - ./mfc.sh run /scratch/bciv/sremillard/sph_col_1atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 18:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/sph_col_32/3Dshinput_new.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 1:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta + +## Pre-process +./mfc.sh run /scratch/bciv/sremillard/sph_col_2atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# sph2 -t pre_process -a bciv-delta-gpu -c delta +./mfc.sh run /scratch/bciv/sremillard/sph_col_5atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# sph5 -t pre_process -a bciv-delta-gpu -c delta +./mfc.sh run /scratch/bciv/sremillard/pert_col_2atm_tenth/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# base -t pre_process -a bciv-delta-gpu -c delta +./mfc.sh run /scratch/bciv/sremillard/sph_col_1atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# sph_1 -t pre_process -a bciv-delta-gpu -c delta From 6c4d953d346cd10a73687a43044510b804352f30 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 6 May 2024 16:12:18 -0500 Subject: [PATCH 062/380] fixed post processing issue --- src/post_process/m_global_parameters.fpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 5b0c477e0f..8a2b16efca 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -280,7 +280,7 @@ contains relax_model = dflt_int hypoelasticity = .false. - hyperelastictiy = .false. + hyperelasticity = .false. bc_x%beg = dflt_int; bc_x%end = dflt_int bc_y%beg = dflt_int; bc_y%end = dflt_int From 465bfe250e9cd4d8fe63aa24b4dedc894bab9976 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Tue, 7 May 2024 15:46:01 -0500 Subject: [PATCH 063/380] moved interface output and energy output to post_process, pending testing --- src/post_process/m_data_output.fpp | 216 +++++++++ src/post_process/m_global_parameters.fpp | 2 + src/post_process/m_mpi_proxy.fpp | 34 +- src/post_process/m_start_up.f90 | 16 + src/simulation/m_data_output.fpp | 530 +---------------------- src/simulation/m_derived_variables.f90 | 15 - src/simulation/m_global_parameters.fpp | 2 - src/simulation/m_mpi_proxy.fpp | 2 +- src/simulation/m_start_up.fpp | 2 +- toolchain/mfc/run/case_dicts.py | 4 +- 10 files changed, 275 insertions(+), 548 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 7f3d7d9bdf..fe40b931ab 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -27,9 +27,15 @@ module m_data_output private; public :: s_initialize_data_output_module, & s_open_formatted_database_file, & + s_open_intf_data_file, & + s_open_energy_data_file, & s_write_grid_to_formatted_database_file, & s_write_variable_to_formatted_database_file, & + s_write_intf_data_file, & + s_write_energy_data_file, & s_close_formatted_database_file, & + s_close_intf_data_file, & + s_close_energy_data_file, & s_finalize_data_output_module ! Including the Silo Fortran interface library that features the subroutines @@ -531,6 +537,41 @@ contains end subroutine s_open_formatted_database_file ! ------------------------ + + subroutine s_open_intf_data_file() ! ------------------------ + + character(LEN=path_len + 3*name_len) :: file_path !< + !! Relative path to a file in the case directory + + write (file_path, '(A)') '/intf_data.dat' + file_path = trim(case_dir)//trim(file_path) + + ! Opening the simulation data file + open (211, FILE=trim(file_path), & + FORM='formatted', & + POSITION='append', & + STATUS='unknown') + + end subroutine s_open_intf_data_file ! --------------------------------------- + + subroutine s_open_energy_data_file() ! ------------------------ + + character(LEN=path_len + 3*name_len) :: file_path !< + !! Relative path to a file in the case directory + + write (file_path, '(A)') '/eng_data.dat' + file_path = trim(case_dir)//trim(file_path) + + ! Opening the simulation data file + open (251, FILE=trim(file_path), & + FORM='formatted', & + POSITION='append', & + STATUS='unknown') + + end subroutine s_open_energy_data_file ! ---------------------------------------- + + + subroutine s_write_grid_to_formatted_database_file(t_step) ! ----------- ! Description: The general objective of this subroutine is to write the ! necessary grid data to the formatted database file, for @@ -939,6 +980,153 @@ contains end subroutine s_write_variable_to_formatted_database_file ! ----------- + + subroutine s_write_intf_data_file(q_prim_vf, t_step) + + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + integer, intent(IN) :: t_step + integer :: i, j, k, l, w, cent !< Generic loop iterators + integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations + real(kind(0d0)), dimension(num_fluids) :: alpha, vol_fluid, xcom, ycom, zcom + real(kind=8), parameter :: pi = 4.d0*datan(1.d0) + real(kind(0d0)), allocatable :: x_td(:), y_td(:), x_d1(:), y_d1(:), y_d(:), x_d(:) + real(kind(0d0)) :: axp, axm, ayp, aym, azm, azp + + allocate (x_d1(m*n)) + allocate (y_d1(m*n)) + counter = 0 + + do l = 0, p + if (z_cc(l) < dz(l) .and. z_cc(l) > 0) then + cent = l + end if + end do + do k = 0, n + OLoop: do j = 0, m + axp = q_prim_vf(E_idx + 1)%sf(j + 1, k, cent) + axm = q_prim_vf(E_idx + 1)%sf(j - 1, k, cent) + ayp = q_prim_vf(E_idx + 1)%sf(j, k + 1, cent) + aym = q_prim_vf(E_idx + 1)%sf(j, k - 1, cent) + + if ((axp > 0.9 .and. axm < 0.9) .or. (axp < 0.9 .and. axm > 0.9) & + .or. (ayp > 0.9 .and. aym < 0.9) .or. (ayp < 0.9 .and. aym > 0.9)) then + if (counter == 0) then + counter = counter + 1 + x_d1(counter) = x_cc(j) + y_d1(counter) = y_cc(k) + else + do i = 1, counter + if (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & + y_d1(i))**2) <= 2*sqrt(dx(j)**2 & + + dy(k)**2)) then + cycle OLoop + elseif (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & + y_d1(i))**2) > 2*sqrt(dx(j)**2 & + + dy(k)**2) .and. i == counter) then + counter = counter + 1 + x_d1(counter) = x_cc(j) + y_d1(counter) = y_cc(k) + end if + end do + end if + end if + end do OLoop + end do + allocate (y_d(counter)) + allocate (x_d(counter)) + do i = 1, counter + y_d(i) = y_d1(i) + x_d(i) = x_d1(i) + end do + ! if (num_procs > 1) then + call s_mpi_gather_data(x_d, counter, x_td, root) + call s_mpi_gather_data(y_d, counter, y_td, root) + if (proc_rank == 0) then + do i = 1, size(x_td) + if (i == size(x_td)) then + write (211, '(F12.9,1X,F12.9,1X,I4)') & + x_td(i), y_td(i), size(x_td) + else + write (211, '(F12.9,1X,F12.9,1X,F3.1)') & + x_td(i), y_td(i), 0d0 + end if + end do + endif + + end subroutine s_write_intf_data_file ! ----------------------------------- + + subroutine s_write_energy_data_file(q_prim_vf, t_step) + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + integer, intent(IN) :: t_step + real(kind(0d0)) :: Elk, Egk, Elint, Egint, Vb + real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf + real(kind(0d0)), dimension(num_dims) :: vel + real(kind(0d0)), dimension(num_fluids) :: gammas, pi_infs + integer :: i, j, k, l, s !looping indicies + integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations + + Elk = 0d0 + Egk = 0d0 + Elint = 0d0 + Egint = 0d0 + Vb = 0d0 + if (p > 0) then + do k = 0, p + do j = 0, n + do i = 0, m + pres = 0d0 + dV = dx(i)*dy(j)*dz(k) + rho = 0d0 + gamma = 0d0 + pi_inf = 0d0 + do l = 1, num_fluids + gammas(l) = fluid_pp(l)%gamma + pi_infs(l) = fluid_pp(l)%pi_inf + rho = rho + q_prim_vf(E_idx + l)%sf(i, j, k)*q_prim_vf(l)%sf(i, j, k) + gamma = gamma + q_prim_vf(E_idx + l)%sf(i, j, k)*gammas(l) + pi_inf = pi_inf + q_prim_vf(E_idx + l)%sf(i, j, k)*pi_infs(l) + end do + pres = q_prim_vf(E_idx)%sf(i, j, k) + do s = 1, num_dims + vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) + if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9) then + Elk = Elk + 0.5d0*rho*vel(s)*vel(s)*dV + else + Egk = Egk + 0.5d0*rho*vel(s)*vel(s)*dV + end if + end do + if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9) then + Elint = Elint + (gamma*pres + pi_inf)*dV + else + Egint = Egint + (gamma*pres + pi_inf)*dV + Vb = Vb + dV + end if + end do + end do + end do + end if + tmp = Elk + call s_mpi_allreduce_sum(tmp, Elk) + tmp = Elint + call s_mpi_allreduce_sum(tmp, Elint) + tmp = Egint + call s_mpi_allreduce_sum(tmp, Egint) + tmp = Egk + call s_mpi_allreduce_sum(tmp, Egk) + tmp = Vb + call s_mpi_allreduce_sum(tmp, Vb) + if (proc_rank == 0) then + write (251, '(6X, 5F24.12)') & + Elint, & + Egint, & + Elk, & + Egk, & + Vb + end if + + end subroutine s_write_energy_data_file + + subroutine s_close_formatted_database_file() ! ------------------------- ! Description: The purpose of this subroutine is to close any formatted ! database file(s) that may be opened at the time-step that @@ -966,6 +1154,34 @@ contains end subroutine s_close_formatted_database_file ! ----------------------- + subroutine s_close_intf_data_file() ! ----------------------- + + ! Writing the footer of and closing the run-time information file + write (211, '(A)') '----------------------------------------'// & + '----------------------------------------' + write (211, '(A)') '' + write (211, '(A)') '' + write (211, '(A)') '========================================'// & + '========================================' + close (211) + + end subroutine s_close_intf_data_file !--------------------- + + subroutine s_close_energy_data_file() ! ----------------------- + + ! Writing the footer of and closing the run-time information file + write (251, '(A)') '----------------------------------------'// & + '----------------------------------------' + write (251, '(A)') '' + write (251, '(A)') '' + write (251, '(A)') '========================================'// & + '========================================' + close (251) + + end subroutine s_close_energy_data_file !--------------------- + + + subroutine s_finalize_data_output_module() ! ------------------------- ! Description: Deallocation procedures for the module diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 15993d1241..7009741ebd 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -116,6 +116,7 @@ module m_global_parameters !> @} logical :: parallel_io !< Format of the data files + logical :: sim_data logical :: file_per_process !< output format integer, allocatable, dimension(:) :: proc_coords !< @@ -326,6 +327,7 @@ contains omega_wrt = .false. qm_wrt = .false. schlieren_wrt = .false. + sim_data = .false. schlieren_alpha = dflt_real diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp index 618648c92f..79686abb0e 100644 --- a/src/post_process/m_mpi_proxy.fpp +++ b/src/post_process/m_mpi_proxy.fpp @@ -141,6 +141,38 @@ contains end subroutine s_initialize_mpi_proxy_module ! ---------------------------- + subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root) + +#ifdef MFC_MPI + + implicit none + integer, intent(in) :: counts ! Array of vector lengths for each process + real(kind(0d0)), intent(in), dimension(counts) :: my_vector ! Input vector on each process + integer, intent(in) :: root ! Rank of the root process + real(kind(0d0)), allocatable, intent(out) :: gathered_vector(:) ! Gathered vector on the root process + + integer :: i, offset, ierr + integer, allocatable :: recounts(:), displs(:) + + allocate (recounts(num_procs)) + + call MPI_GATHER(counts, 1, MPI_INTEGER, recounts, 1, MPI_INTEGER, root, & + MPI_COMM_WORLD, ierr) + + allocate (displs(size(recounts))) + + displs(1) = 0 + + do i = 2, size(recounts) + displs(i) = displs(i - 1) + recounts(i - 1) + end do + + allocate (gathered_vector(sum(recounts))) + call MPI_GATHERV(my_vector, counts, MPI_DOUBLE_PRECISION, gathered_vector, recounts, displs, MPI_DOUBLE_PRECISION, & + root, MPI_COMM_WORLD, ierr) +#endif + end subroutine s_mpi_gather_data + !> Since only processor with rank 0 is in charge of reading !! and checking the consistency of the user provided inputs, !! these are not available to the remaining processors. This @@ -164,7 +196,7 @@ contains #:for VAR in [ 'cyl_coord', 'adv_alphan', 'mpp_lim', 'mixture_err', & & 'alt_soundspeed', 'hypoelasticity', 'parallel_io', 'rho_wrt', & - & 'E_wrt', 'pres_wrt', 'gamma_wrt', & + & 'E_wrt', 'pres_wrt', 'gamma_wrt', 'sim_data', & & 'heat_ratio_wrt', 'pi_inf_wrt', 'pres_inf_wrt', 'cons_vars_wrt', & & 'prim_vars_wrt', 'c_wrt', 'qm_wrt','schlieren_wrt', 'bubbles', & & 'polytropic', 'polydisperse', 'file_per_process', 'relax', & diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 70bdd54936..d0c38f8a78 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -173,6 +173,16 @@ subroutine s_save_data(t_step, varname, pres, c, H) ! Opening a new formatted database file call s_open_formatted_database_file(t_step) + if (sim_data .and. proc_rank == 0) then + call s_open_intf_data_file() + call s_open_energy_data_file() + endif + + if (sim_data) then + call s_write_intf_data_file(q_prim_vf, t_step) + call s_write_energy_data_file(q_prim_vf, t_step) + endif + ! Adding the grid to the formatted database file call s_write_grid_to_formatted_database_file(t_step) @@ -592,6 +602,12 @@ subroutine s_save_data(t_step, varname, pres, c, H) ! Closing the formatted database file call s_close_formatted_database_file() + + if (sim_data .and. proc_rank == 0) then + call s_close_intf_data_file() + call s_close_energy_data_file() + end if + end subroutine s_save_data subroutine s_initialize_modules() diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 6533295eff..2f98c4fd20 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -47,14 +47,8 @@ module m_data_output s_close_run_time_information_file, & s_close_com_files, & s_close_probe_files, & - s_finalize_data_output_module, & - s_open_sim_data_file, & - s_open_eng_data_file, & - s_write_sim_data_file, & - s_write_eng_data_file, & - s_close_eng_data_file, & - s_close_sim_data_file - abstract interface ! =================================================== + s_finalize_data_output_module + abstract interface ! =================================================== !> Write data files !! @param q_cons_vf Conservative variables @@ -216,38 +210,6 @@ contains end do end subroutine s_open_com_files ! -------------------------------------- - subroutine s_open_sim_data_file() ! ------------------------ - - character(LEN=path_len + 3*name_len) :: file_path !< - !! Relative path to a file in the case directory - - write (file_path, '(A)') '/sim_data.dat' - file_path = trim(case_dir)//trim(file_path) - - ! Opening the simulation data file - open (211, FILE=trim(file_path), & - FORM='formatted', & - POSITION='append', & - STATUS='unknown') - - end subroutine s_open_sim_data_file ! --------------------------------------- - - subroutine s_open_eng_data_file() ! ------------------------ - - character(LEN=path_len + 3*name_len) :: file_path !< - !! Relative path to a file in the case directory - - write (file_path, '(A)') '/eng_data.dat' - file_path = trim(case_dir)//trim(file_path) - - ! Opening the simulation data file - open (251, FILE=trim(file_path), & - FORM='formatted', & - POSITION='append', & - STATUS='unknown') - - end subroutine s_open_eng_data_file ! ---------------------------------------- - !> This opens a formatted data file where the root processor !! can write out flow probe information subroutine s_open_probe_files() ! -------------------------------------- @@ -533,465 +495,7 @@ contains end subroutine s_write_run_time_information ! -------------------------- - subroutine s_write_sim_data_file(q_prim_vf, t_step) - - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - integer, intent(IN) :: t_step - integer :: i, j, k, l, w, cent !< Generic loop iterators - integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations - - real(kind(0d0)) :: u, eps, Elk, Elp, Egk, Egie - real(kind(0d0)) :: nondim_time - real(kind(0d0)), dimension(num_fluids) :: alpha, vol_fluid, xcom, ycom, zcom - real(kind=8), parameter :: pi = 4.d0*datan(1.d0) - real(kind(0d0)), allocatable :: x_td(:), y_td(:), x_d1(:), y_d1(:), y_d(:), x_d(:) - - real(kind(0d0)) :: axp, axm, ayp, aym, azm, azp - - call s_calculate_COM(q_prim_vf, xcom, ycom, vol_fluid) - - if (t_step_old /= dflt_int) then - nondim_time = real(t_step + t_step_old, kind(0d0))*dt - else - nondim_time = real(t_step, kind(0d0))*dt - end if - root = 0 - allocate (x_d1(m*n)) - allocate (y_d1(m*n)) - counter = 0 - - do l = 0, p - if (z_cc(l) < dz(l) .and. z_cc(l) > 0) then - cent = l - end if - end do - do k = 0, n - OLoop: do j = 0, m - axp = q_prim_vf(E_idx + 1)%sf(j + 1, k, cent) - axm = q_prim_vf(E_idx + 1)%sf(j - 1, k, cent) - ayp = q_prim_vf(E_idx + 1)%sf(j, k + 1, cent) - aym = q_prim_vf(E_idx + 1)%sf(j, k - 1, cent) - - if ((axp > 0.9 .and. axm < 0.9) .or. (axp < 0.9 .and. axm > 0.9) & - .or. (ayp > 0.9 .and. aym < 0.9) .or. (ayp < 0.9 .and. aym > 0.9)) then - if (counter == 0) then - counter = counter + 1 - x_d1(counter) = x_cc(j) - y_d1(counter) = y_cc(k) - else - do i = 1, counter - if (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & - y_d1(i))**2) <= 2*sqrt(dx(j)**2 & - + dy(k)**2)) then - cycle OLoop - elseif (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & - y_d1(i))**2) > 2*sqrt(dx(j)**2 & - + dy(k)**2) .and. i == counter) then - counter = counter + 1 - x_d1(counter) = x_cc(j) - y_d1(counter) = y_cc(k) - end if - end do - end if - end if - end do OLoop - end do - allocate (y_d(counter)) - allocate (x_d(counter)) - do i = 1, counter - y_d(i) = y_d1(i) - x_d(i) = x_d1(i) - end do - ! if (num_procs > 1) then - call s_mpi_gather_data(x_d, counter, x_td, root) - call s_mpi_gather_data(y_d, counter, y_td, root) - if (proc_rank == 0) then - do i = 1, size(x_td) - if (i == size(x_td)) then - write (211, '(F12.9,1X,F12.9,1X,I4, 1X, F12.9, 1X, F12.9)') & - x_td(i), y_td(i), size(x_td), xcom(2), nondim_time - else - write (211, '(F12.9,1X,F12.9,1X,F3.1,1X,F3.1,1X,F3.1)') & - x_td(i), y_td(i), 0d0, 0d0, 0d0 - end if - end do - end if - - end subroutine s_write_sim_data_file ! ----------------------------------- - - subroutine s_write_eng_data_file(q_prim_vf, t_step) - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - integer, intent(IN) :: t_step - real(kind(0d0)) :: Elk, Egk, Elint, Egint - real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, qv, Elks, Egks, Elints, Egints - real(kind(0d0)), dimension(num_dims) :: vel - integer :: i, j, k, l, s !looping indicies - integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations - real(kind(0d0)) :: nondim_time - - if (t_step_old /= dflt_int) then - nondim_time = real(t_step + t_step_old, kind(0d0))*dt - else - nondim_time = real(t_step, kind(0d0))*dt - end if - root = 0 - -! call s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Elint, Egint) - - Elk = 0d0 - Egk = 0d0 - Elint = 0d0 - Egint = 0d0 - if (p > 0) then - do k = 0, p - do j = 0, n - do i = 0, m - Elks = 0d0 - Egks = 0d0 - Elints = 0d0 - Egints = 0d0 - pres = 0d0 - rho = 0d0 - gamma = 0d0 - pi_inf = 0d0 - do l = 1, num_fluids - rho = rho + q_prim_vf(E_idx + l)%sf(i, j, k)*q_prim_vf(l)%sf(i, j, k) - gamma = gamma + q_prim_vf(E_idx + l)%sf(i, j, k)*gammas(l) - pi_inf = pi_inf + q_prim_vf(E_idx + l)%sf(i, j, k)*pi_infs(l) - end do - pres = q_prim_vf(E_idx)%sf(i, j, k) - dV = dx(i)*dy(j)*dz(k) - do s = 1, num_dims - vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) - if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9) then - Elks = Elks + 0.5d0*rho*vel(s)*vel(s) - else - Egks = Egks + 0.5d0*rho*vel(s)*vel(s) - end if - end do - if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9) then - Elints = gamma*pres + pi_inf - else - Egints = gamma*pres + pi_inf - end if - Elk = Elk + Elks*dV - Egk = Egk + Egks*dV - Egint = Egint + Egints*dV - Elint = Elint + Elints*dV - end do - end do - end do - end if - tmp = Elk - call s_mpi_allreduce_sum(tmp, Elk) - tmp = Elint - call s_mpi_allreduce_sum(tmp, Elint) - tmp = Egint - call s_mpi_allreduce_sum(tmp, Egint) - tmp = Egk - call s_mpi_allreduce_sum(tmp, Egk) - call s_mpi_barrier() - if (proc_rank == 0) then - write (251, '(6X, 6F24.12)') & - Elint, & - Egint, & - Elk, & - Egk, & - nondim_time - end if - - end subroutine s_write_eng_data_file - - subroutine s_calculate_energy_contributions(q_prim_vf, Elk, Egk, Elint, Egint) - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), intent(OUT) :: Elk, Egk, Elint, Egint - real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, qv, Elks, Egks, Elints, Egints - real(kind(0d0)), dimension(num_dims) :: vel - integer :: i, j, k, l, s !looping indicies - - Elk = 0d0 - Egk = 0d0 - Elint = 0d0 - Egint = 0d0 - if (p > 0) then - do k = 0, p - do j = 0, n - do i = 0, m - Elks = 0d0 - Egks = 0d0 - Elints = 0d0 - Egints = 0d0 - pres = 0d0 - rho = 0d0 - gamma = 0d0 - pi_inf = 0d0 - do l = 1, num_fluids - rho = rho + q_prim_vf(E_idx + l)%sf(i, j, k)*q_prim_vf(l)%sf(i, j, k) - gamma = gamma + q_prim_vf(E_idx + l)%sf(i, j, k)*gammas(l) - pi_inf = pi_inf + q_prim_vf(E_idx + l)%sf(i, j, k)*pi_infs(l) - end do - pres = q_prim_vf(E_idx)%sf(i, j, k) - dV = dx(i)*dy(j)*dz(k) - do s = 1, num_dims - vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) - if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9) then - Elks = Elks + 0.5d0*rho*vel(s)*vel(s) - else - Egks = Egks + 0.5d0*rho*vel(s)*vel(s) - end if - end do - if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9) then - Elints = gamma*pres + pi_inf - else - Egints = gamma*pres + pi_inf - end if - Elk = Elk + Elks*dV - Egk = Egk + Egks*dV - Egint = Egint + Egints*dV - Elint = Elint + Elints*dV - end do - end do - end do - end if - tmp = Elk - call s_mpi_allreduce_sum(tmp, Elk) - tmp = Elint - call s_mpi_allreduce_sum(tmp, Elint) - tmp = Egint - call s_mpi_allreduce_sum(tmp, Egint) - tmp = Egk - call s_mpi_allreduce_sum(tmp, Egk) - - end subroutine s_calculate_energy_contributions - - subroutine s_calculate_numerical_schlieran(q_prim_vf, f_NS) - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - integer :: i, j, k, l - real(kind(0d0)), dimension(0:m, 0:n), intent(OUT) :: f_NS - real(kind(0d0)), dimension(0:m, 0:n) :: d_rho_mag, a, b, c, d, d_a_mag - real(kind(0d0)) :: rhoxp, rhoxm, rhoyp, rhoym, rhop, d_rhox, d_rhoy, mag_max - real(kind(0d0)) :: axp, axm, ayp, aym, ap, d_ax, d_ay, maga_max - - rhop = 0d0 - rhoxp = 0d0 - rhoxm = 0d0 - rhoyp = 0d0 - rhoym = 0d0 - ap = 0d0 - axp = 0d0 - axm = 0d0 - ayp = 0d0 - aym = 0d0 - - do k = 0, n - do j = 0, m - do i = 1, num_fluids - rhop = rhop + q_prim_vf(i)%sf(j, k, 0) - rhoxp = rhoxp + q_prim_vf(i)%sf(j + 1, k, 0) - rhoxm = rhoxm + q_prim_vf(i)%sf(j - 1, k, 0) - rhoyp = rhoyp + q_prim_vf(i)%sf(j, k + 1, 0) - rhoym = rhoym + q_prim_vf(i)%sf(j, k - 1, 0) - end do - ap = q_prim_vf(E_idx + 2)%sf(j, k, 0) - axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, 0) - axm = q_prim_vf(E_idx + 2)%sf(j - 1, k, 0) - ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, 0) - aym = q_prim_vf(E_idx + 2)%sf(j, k - 1, 0) - if (j == m) then - d_rhox = dabs((rhop - rhoxm)/(x_cc(j) - x_cc(j - 1))) - d_ax = dabs((ap - axm)/(x_cc(j) - x_cc(j - 1))) - else if (k == n) then - d_rhoy = dabs((rhop - rhoym)/(y_cc(k) - y_cc(k - 1))) - d_ay = dabs((ap - aym)/(y_cc(k) - y_cc(k - 1))) - else if (j == 0) then - d_rhox = dabs((rhoxp - rhop)/(x_cc(j + 1) - x_cc(j))) - d_ax = dabs((axp - ap)/(x_cc(j + 1) - x_cc(j))) - else if (k == 0) then - d_rhoy = dabs((rhoyp - rhop)/(y_cc(k + 1) - y_cc(k))) - d_ay = dabs((ayp - ap)/(y_cc(k + 1) - y_cc(k))) - else - d_rhox = dabs((rhoxp - rhoxm)/(x_cc(j + 1) - x_cc(j - 1))) - d_rhoy = dabs((rhoyp - rhoym)/(y_cc(k + 1) - y_cc(k - 1))) - d_ax = dabs((axp - axm)/(x_cc(j + 1) - x_cc(j - 1))) - d_ay = dabs((ayp - aym)/(y_cc(k + 1) - y_cc(k - 1))) - - end if - d_rho_mag(j, k) = dsqrt((d_rhox**2 + d_rhoy**2)) - d_a_mag(j, k) = dsqrt((d_ax**2 + d_ay**2)) - rhop = 0d0 - rhoxp = 0d0 - rhoxm = 0d0 - rhoyp = 0d0 - rhoym = 0d0 - ap = 0d0 - axp = 0d0 - axm = 0d0 - ayp = 0d0 - aym = 0d0 - end do - end do - -! if (maxval(d_rho_mag) < 1/(100*maxval(dx)) .or. maxval(d_rho_mag) < 1/(100*maxval(dy))) then -! d_rho_mag(0:m,0:n) = 0d0 -! else -! d_rho_mag(0:m,0:n) = d_rho_mag(0:m,0:n)/maxval(d_rho_mag) -! end if - call s_mpi_allreduce_max(maxval(d_rho_mag), mag_max) - call s_mpi_allreduce_max(maxval(d_a_mag), maga_max) - ! print *, "d_rho_max =", mag_max - ! print*, "d_rho_mag =", d_rho_mag - d_rho_mag(0:m, 0:n) = d_rho_mag(0:m, 0:n)/mag_max - d_a_mag(0:m, 0:n) = d_a_mag(0:m, 0:n)/maga_max -! print*, d_rho_mag - a = 0.5 - b = 9 - c = 0.65 - d = 1 - ! f_NS(0:m,0:n) = d_a_mag(0:m,0:n)*(EXP(-b**2*(d_rho_mag(0:m,0:n)& - ! -d_a_mag(0:m,0:n))**2/(d_a_mag(0:m,0:n))**2)+ & - ! c*EXP(-b**2*(d_rho_mag(0:m,0:n)-(d_a_mag(0:m,0:n)-a))**2/& - ! (d_a_mag(0:m,0:n))**2)+d*d_rho_mag(0:m,0:n)/d_a_mag(0:m,0:n)*& - ! EXP(-b**2*(d_rho_mag(0:m,0:n)-(0.9))**2/(25**2*(d_a_mag(0:m,0:n))**2))) - - f_NS(0:m, 0:n) = q_prim_vf(E_idx + 2)%sf(0:m, 0:n, 0)*(exp(-b**2*(d_rho_mag(0:m, 0:n) & - - q_prim_vf(E_idx + 2)%sf(0:m, 0:n, 0))**2/(q_prim_vf(E_idx + 2)%sf(0:m, 0:n, 0))**2) + & - c*exp(-b**2*(d_rho_mag(0:m, 0:n) - (q_prim_vf(E_idx + 2)%sf(0:m, 0:n, 0) - a))**2/ & - (q_prim_vf(E_idx + 2)%sf(0:m, 0:n, 0))**2) + d*d_rho_mag(0:m, 0:n)/q_prim_vf(E_idx + 2)%sf(0:m, 0:n, 0)* & - exp(-b**2*(d_rho_mag(0:m, 0:n) - (0.9))**2/(25**2*(q_prim_vf(E_idx + 2)%sf(0:m, 0:n, 0))**2))) - - ! f_NS(0:m,0:n) = d*dsqrt(d_rho_mag(0:m,0:n))*& -! EXP(-b**2*(d_rho_mag(0:m,0:n)-(0.9))**2/(25**2*(q_prim_vf(E_idx + 2)%sf(0:m,0:n,0))**2)) -! f_NS(0:m,0:n) = d*(d_rho_mag(0:m,0:n)+d_a_mag(0:m,0:n))*& -! EXP(-b**2*(d_rho_mag(0:m,0:n)-(1+d_a_mag(0:m,0:n)))**2/(30**2*(d_a_mag(0:m,0:n))**2)) - -!1-EXP(-(0.1+0.9*q_prim_vf(E_idx + 2)%sf(0:m,0:n, 0))*dsqrt(d_rho_mag(0:m,0:n))*q_prim_vf(E_idx + 2)%sf(0:m,0:n, 0)) - - end subroutine s_calculate_numerical_schlieran - - subroutine s_calculate_COM(q_prim_vf, xcom, ycom, vol_fluid) - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - integer :: i, j, k, l !< Generic loop iterators - real(kind(0d0)), dimension(num_fluids), intent(OUT) :: vol_fluid - real(kind(0d0)), dimension(num_fluids) :: ms, ym, xm, zm - real(kind(0d0)), dimension(num_fluids), intent(OUT) :: xcom, ycom - real(kind(0d0)) :: ybeg, xend, xbeg, zbeg, zend, tmp, dV, yend - - xm = 0d0 - ms = 0d0 - ym = 0d0 - ! zm = 0d0 - - do l = 0, p - do k = 0, n - do j = 0, m - if (p > 0) then - dV = dx(j)*dy(k)*dz(l) - else if (p == 0) then - dV = dx(j)*dy(k) - else if (n == 0) then - dV = dx(j) - end if - do i = 1, num_fluids - if (q_prim_vf(E_idx + i)%sf(j, k, l) > 0.6) then - vol_fluid(i) = vol_fluid(i) + q_prim_vf(E_idx + i)%sf(j, k, l)*dV - end if - if (p > 0) then - ms(i) = ms(i) + q_prim_vf(i)%sf(j, k, l)*dV - xm(i) = xm(i) + q_prim_vf(i)%sf(j, k, l)*dV*x_cc(j) - ym(i) = ym(i) + q_prim_vf(i)%sf(j, k, l)*dV*y_cc(k) - ! zm(i) = zm(i) + q_prim_vf(i)%sf(j,k,l)*dV*z_cc(l) - else if (p == 0 .and. & - q_prim_vf(E_idx + 2)%sf(j, k, l) > 0.9) then - ms(i) = ms(i) + q_prim_vf(i)%sf(j, k, l)*dV - xm(i) = xm(i) + q_prim_vf(i)%sf(j, k, l)*dV*x_cc(j) - ym(i) = ym(i) + q_prim_vf(i)%sf(j, k, l)*dV*y_cc(k) - end if - end do - end do - end do - end do - do i = 1, num_fluids - if (num_procs > 1) then - tmp = vol_fluid(i) - call s_mpi_allreduce_sum(tmp, vol_fluid(i)) - if (p > 0) then - tmp = xm(i) - call s_mpi_allreduce_sum(tmp, xm(i)) - tmp = ym(i) - ! call s_mpi_allreduce_sum(tmp, ym(i)) - ! tmp = zm(i) - ! call s_mpi_allreduce_sum(tmp,zm(i)) - tmp = ms(i) - call s_mpi_allreduce_sum(tmp, ms(i)) - ! call s_mpi_allreduce_min(minval(x_cb(-1:m)), xbeg) - ! call s_mpi_allreduce_max(maxval(x_cb(-1:m)), xend) - ! call s_mpi_allreduce_min(minval(y_cb(-1:n)), ybeg) - ! call s_mpi_allreduce_max(maxval(y_cb(-1:n)), yend) - ! call s_mpi_allreduce_min(minval(z_cb(-1:p)), zbeg) - ! call s_mpi_allreduce_max(maxval(z_cb(-1:p)), zend) - else if (p == 0) then - tmp = xm(i) - call s_mpi_allreduce_sum(tmp, xm(i)) - tmp = ym(i) - ! call s_mpi_allreduce_sum(tmp, ym(i)) - tmp = ms(i) - call s_mpi_allreduce_sum(tmp, ms(i)) - ! call s_mpi_allreduce_min(minval(x_cb(-1:m)), xbeg) - ! call s_mpi_allreduce_max(maxval(x_cb(-1:m)), xend) - ! call s_mpi_allreduce_min(minval(y_cb(-1:n)), ybeg) - ! call s_mpi_allreduce_max(maxval(y_cb(-1:n)), yend) - end if - end if - - ! if (p > 1) then - ! xcom(i) = xm(i)/ms(i) - ycom(i) = 0d0 - ! zcom(i) = zm(i)/ms(i) - ! if (bc_x_glb%beg == -2) then -! ms(i) = 2*ms(i) - ! xcom(i) = xbeg - ! else if (bc_x_glb%end == -2) then -! ms(i) = 2*ms(i) -! xcom(i) = xend -! else if (bc_y_glb%beg == -2) then -! ms(i) = 2*ms(i) -! ycom(i) = ybeg -! else if (bc_y_glb%end == -2) then -! ms(i) = 2*ms(i) -! ycom(i) = yend - ! else if (bc_z_glb%beg == -2) then - ! ms(i) = 2*ms(i) - ! zcom(i) = zbeg - ! else if (bc_z_glb%end == -2) then - ! ms(i) = 2*ms(i) - ! zcom(i) = zend - ! end if - ! else if (p == 0) then - xcom(i) = xm(i)/ms(i) - ! ycom(i) = ym(i)/ms(i) - ! if (bc_x_glb%beg == -2) then - ! ms(i) = 2*ms(i) - ! xcom(i) = xbeg - ! else if (bc_x_glb%end == -2) then - ! ms(i) = 2*ms(i) - ! xcom(i) = xend - ! else if (bc_y_glb%beg == -2) then - ! ms(i) = 2*ms(i) - ! ycom(i) = ybeg - ! else if (bc_y_glb%end == -2) then - ! ms(i) = 2*ms(i) - ! ycom(i) = yend - ! end if - ! end if - end do - - end subroutine s_calculate_COM - - !> The goal of this subroutine is to output the grid and - !! conservative variables data files for given time-step. - !! @param q_cons_vf Cell-average conservative variables - !! @param t_step Current time-step - subroutine s_write_serial_data_files(q_cons_vf, q_prim_vf, t_step) ! --------------------- + subroutine s_write_serial_data_files(q_cons_vf, q_prim_vf, t_step) ! --------------------- type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf type(scalar_field), dimension(sys_size), intent(inOUT) :: q_prim_vf @@ -2233,33 +1737,7 @@ contains end subroutine s_close_com_files ! ------------------------------------- - subroutine s_close_sim_data_file() ! ----------------------- - - ! Writing the footer of and closing the run-time information file - write (211, '(A)') '----------------------------------------'// & - '----------------------------------------' - write (211, '(A)') '' - write (211, '(A)') '' - write (211, '(A)') '========================================'// & - '========================================' - close (211) - - end subroutine s_close_sim_data_file !--------------------- - - subroutine s_close_eng_data_file() ! ----------------------- - - ! Writing the footer of and closing the run-time information file - write (251, '(A)') '----------------------------------------'// & - '----------------------------------------' - write (251, '(A)') '' - write (251, '(A)') '' - write (251, '(A)') '========================================'// & - '========================================' - close (251) - - end subroutine s_close_eng_data_file !--------------------- - - !> Closes probe files + !> Closes probe files subroutine s_close_probe_files() ! ------------------------------------- integer :: i !< Generic loop iterator diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index 07b788ef87..9c1a01e22a 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -108,11 +108,6 @@ subroutine s_initialize_derived_variables() ! ----------------------------- end if end if - if (sim_data .and. proc_rank == 0) then - call s_open_sim_data_file() - call s_open_eng_data_file() - end if - end subroutine s_initialize_derived_variables ! ----------------------------- !> Writes coherent body information, communication files, and probes. @@ -165,11 +160,6 @@ subroutine s_compute_derived_variables(q_prim_vf, t_step) ! -------------------- call s_write_probe_files(t_step, q_cons_ts(1)%vf, accel_mag) call s_write_com_files(t_step, c_mass) end if - if (sim_data .and. mod(t_step - t_step_start, t_step_save) == 0 .or. & - t_step > t_step_stop) then - call s_write_sim_data_file(q_prim_vf, t_step) - call s_write_eng_data_file(q_prim_vf, t_step) - end if end subroutine s_compute_derived_variables ! --------------------------- @@ -473,11 +463,6 @@ subroutine s_finalize_derived_variables_module() ! ------------------- end if end if - if (proc_rank == 0 .and. sim_data) then - call s_close_sim_data_file() - call s_close_eng_data_file() - end if - if (probe_wrt) then deallocate (accel_mag, x_accel) if (n > 0) then diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 6580f5e0b2..8416e0f2e1 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -34,7 +34,6 @@ module m_global_parameters integer :: num_procs !< Number of processors character(LEN=path_len) :: case_dir !< Case folder location logical :: run_time_info !< Run-time output flag - logical :: sim_data !< Simulation data output flag integer :: t_step_old !< Existing IC/grid folder ! ========================================================================== @@ -447,7 +446,6 @@ contains ! Logistics case_dir = '.' run_time_info = .false. - sim_data = .false. t_step_old = dflt_int ! Computational domain parameters diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index 7b8804e40a..74e2a6dd10 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -182,7 +182,7 @@ contains call MPI_BCAST(${VAR}$, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) #:endfor - #:for VAR in [ 'run_time_info','sim_data','cyl_coord', 'adv_alphan', 'mpp_lim', & + #:for VAR in [ 'run_time_info','cyl_coord', 'adv_alphan', 'mpp_lim', & & 'mapped_weno', 'mp_weno', 'cu_mpi', 'weno_flat', 'riemann_flat', & & 'weno_Re_flux', 'alt_soundspeed', 'null_weights', 'mixture_err', & & 'parallel_io', 'hypoelasticity', 'bubbles', 'polytropic', & diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 22235da660..89465b26c0 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -124,7 +124,7 @@ contains character(len=1000) :: line ! Namelist of the global parameters which may be specified by user - namelist /user_inputs/ case_dir, run_time_info, sim_data, m, n, p, dt, & + namelist /user_inputs/ case_dir, run_time_info, m, n, p, dt, & t_step_start, t_step_stop, t_step_save, t_step_print, & model_eqns, num_fluids, adv_alphan, & mpp_lim, time_stepper, weno_eps, weno_flat, & diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index 769ae021d1..efaa406174 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -84,7 +84,7 @@ PRE_PROCESS.append(f'patch_icpp({p_id})%alter_patch({alter_id})') SIMULATION = COMMON + [ - 'run_time_info','sim_data', 't_step_old', 't_tol', 'dt', 't_step_start', + 'run_time_info', 't_step_old', 't_tol', 'dt', 't_step_start', 't_step_stop', 't_step_save', 't_step_print', 'time_stepper', 'weno_eps', 'mapped_weno', 'mp_weno', 'weno_avg', 'weno_Re_flux', 'riemann_solver', 'wave_speeds', 'avg_state', 'prim_vars_wrt', @@ -151,7 +151,7 @@ 'mom_wrt', 'vel_wrt', 'flux_lim', 'flux_wrt', 'E_wrt', 'pres_wrt', 'alpha_wrt', 'kappa_wrt', 'gamma_wrt', 'heat_ratio_wrt', 'pi_inf_wrt', 'pres_inf_wrt', 'cons_vars_wrt', 'prim_vars_wrt', 'c_wrt', 'omega_wrt','qbmm', - 'qm_wrt' + 'qm_wrt', 'sim_data' ] for cmp_id in range(1,3+1): From 1e95c7f0f390347e6c2e6d40e697aacdf635a8ff Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Tue, 7 May 2024 17:24:27 -0500 Subject: [PATCH 064/380] interface and energy outputting code now working in post_process!!! --- src/post_process/m_data_output.fpp | 1 + src/post_process/m_start_up.f90 | 18 +++++++++++------- 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index fe40b931ab..8ef0eefe22 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -1038,6 +1038,7 @@ contains y_d(i) = y_d1(i) x_d(i) = x_d1(i) end do + root = 0 ! if (num_procs > 1) then call s_mpi_gather_data(x_d, counter, x_td, root) call s_mpi_gather_data(y_d, counter, y_td, root) diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index d0c38f8a78..a52cc4ffa4 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -72,7 +72,7 @@ subroutine s_read_input_file() ! --------------------------------------- parallel_io, rhoref, pref, bubbles, qbmm, sigR, & R0ref, nb, polytropic, thermal, Ca, Web, Re_inv, & polydisperse, poly_sigma, file_per_process, relax, relax_model, & - adv_n + adv_n, sim_data ! Inquiring the status of the post_process.inp file file_loc = 'post_process.inp' @@ -599,15 +599,14 @@ subroutine s_save_data(t_step, varname, pres, c, H) varname(:) = ' ' end if end if - + + if (proc_rank == 0 .and. sim_data) then + close(211) + close(251) + endif ! Closing the formatted database file call s_close_formatted_database_file() - if (sim_data .and. proc_rank == 0) then - call s_close_intf_data_file() - call s_close_energy_data_file() - end if - end subroutine s_save_data subroutine s_initialize_modules() @@ -663,6 +662,11 @@ subroutine s_finalize_modules() ! Disassociate pointers for serial and parallel I/O s_read_data_files => null() + if (sim_data .and. proc_rank == 0) then + call s_close_intf_data_file() + call s_close_energy_data_file() + endif + ! Deallocation procedures for the modules call s_finalize_data_output_module() call s_finalize_derived_variables_module() From 3c5b9d57f75e18a975b85f6137e11b7b2ab3757c Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 7 May 2024 21:09:42 -0500 Subject: [PATCH 065/380] formatted the code --- src/post_process/m_data_output.fpp | 53 +++++++++++++----------------- src/post_process/m_start_up.f90 | 20 +++++------ src/simulation/m_data_output.fpp | 6 ++-- 3 files changed, 36 insertions(+), 43 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 8ef0eefe22..9ce06c56a6 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -537,40 +537,37 @@ contains end subroutine s_open_formatted_database_file ! ------------------------ + subroutine s_open_intf_data_file() ! ------------------------ - subroutine s_open_intf_data_file() ! ------------------------ - - character(LEN=path_len + 3*name_len) :: file_path !< + character(LEN=path_len + 3*name_len) :: file_path !< !! Relative path to a file in the case directory - write (file_path, '(A)') '/intf_data.dat' - file_path = trim(case_dir)//trim(file_path) + write (file_path, '(A)') '/intf_data.dat' + file_path = trim(case_dir)//trim(file_path) - ! Opening the simulation data file - open (211, FILE=trim(file_path), & - FORM='formatted', & - POSITION='append', & - STATUS='unknown') + ! Opening the simulation data file + open (211, FILE=trim(file_path), & + FORM='formatted', & + POSITION='append', & + STATUS='unknown') - end subroutine s_open_intf_data_file ! --------------------------------------- + end subroutine s_open_intf_data_file ! --------------------------------------- - subroutine s_open_energy_data_file() ! ------------------------ + subroutine s_open_energy_data_file() ! ------------------------ - character(LEN=path_len + 3*name_len) :: file_path !< + character(LEN=path_len + 3*name_len) :: file_path !< !! Relative path to a file in the case directory - write (file_path, '(A)') '/eng_data.dat' - file_path = trim(case_dir)//trim(file_path) + write (file_path, '(A)') '/eng_data.dat' + file_path = trim(case_dir)//trim(file_path) - ! Opening the simulation data file - open (251, FILE=trim(file_path), & + ! Opening the simulation data file + open (251, FILE=trim(file_path), & FORM='formatted', & - POSITION='append', & - STATUS='unknown') - - end subroutine s_open_energy_data_file ! ---------------------------------------- - + POSITION='append', & + STATUS='unknown') + end subroutine s_open_energy_data_file ! ---------------------------------------- subroutine s_write_grid_to_formatted_database_file(t_step) ! ----------- ! Description: The general objective of this subroutine is to write the @@ -980,7 +977,6 @@ contains end subroutine s_write_variable_to_formatted_database_file ! ----------- - subroutine s_write_intf_data_file(q_prim_vf, t_step) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf @@ -1051,8 +1047,8 @@ contains write (211, '(F12.9,1X,F12.9,1X,F3.1)') & x_td(i), y_td(i), 0d0 end if - end do - endif + end do + end if end subroutine s_write_intf_data_file ! ----------------------------------- @@ -1060,7 +1056,7 @@ contains type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer, intent(IN) :: t_step real(kind(0d0)) :: Elk, Egk, Elint, Egint, Vb - real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf + real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf real(kind(0d0)), dimension(num_dims) :: vel real(kind(0d0)), dimension(num_fluids) :: gammas, pi_infs integer :: i, j, k, l, s !looping indicies @@ -1115,7 +1111,7 @@ contains tmp = Egk call s_mpi_allreduce_sum(tmp, Egk) tmp = Vb - call s_mpi_allreduce_sum(tmp, Vb) + call s_mpi_allreduce_sum(tmp, Vb) if (proc_rank == 0) then write (251, '(6X, 5F24.12)') & Elint, & @@ -1127,7 +1123,6 @@ contains end subroutine s_write_energy_data_file - subroutine s_close_formatted_database_file() ! ------------------------- ! Description: The purpose of this subroutine is to close any formatted ! database file(s) that may be opened at the time-step that @@ -1181,8 +1176,6 @@ contains end subroutine s_close_energy_data_file !--------------------- - - subroutine s_finalize_data_output_module() ! ------------------------- ! Description: Deallocation procedures for the module diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index a52cc4ffa4..a801fa50f3 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -176,12 +176,12 @@ subroutine s_save_data(t_step, varname, pres, c, H) if (sim_data .and. proc_rank == 0) then call s_open_intf_data_file() call s_open_energy_data_file() - endif + end if if (sim_data) then - call s_write_intf_data_file(q_prim_vf, t_step) - call s_write_energy_data_file(q_prim_vf, t_step) - endif + call s_write_intf_data_file(q_prim_vf, t_step) + call s_write_energy_data_file(q_prim_vf, t_step) + end if ! Adding the grid to the formatted database file call s_write_grid_to_formatted_database_file(t_step) @@ -599,14 +599,14 @@ subroutine s_save_data(t_step, varname, pres, c, H) varname(:) = ' ' end if end if - + if (proc_rank == 0 .and. sim_data) then - close(211) - close(251) - endif + close (211) + close (251) + end if ! Closing the formatted database file call s_close_formatted_database_file() - + end subroutine s_save_data subroutine s_initialize_modules() @@ -665,7 +665,7 @@ subroutine s_finalize_modules() if (sim_data .and. proc_rank == 0) then call s_close_intf_data_file() call s_close_energy_data_file() - endif + end if ! Deallocation procedures for the modules call s_finalize_data_output_module() diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 2f98c4fd20..bcef507b94 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -48,7 +48,7 @@ module m_data_output s_close_com_files, & s_close_probe_files, & s_finalize_data_output_module - abstract interface ! =================================================== + abstract interface ! =================================================== !> Write data files !! @param q_cons_vf Conservative variables @@ -495,7 +495,7 @@ contains end subroutine s_write_run_time_information ! -------------------------- - subroutine s_write_serial_data_files(q_cons_vf, q_prim_vf, t_step) ! --------------------- + subroutine s_write_serial_data_files(q_cons_vf, q_prim_vf, t_step) ! --------------------- type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf type(scalar_field), dimension(sys_size), intent(inOUT) :: q_prim_vf @@ -1737,7 +1737,7 @@ contains end subroutine s_close_com_files ! ------------------------------------- - !> Closes probe files + !> Closes probe files subroutine s_close_probe_files() ! ------------------------------------- integer :: i !< Generic loop iterator From 95f2422193d9fb0bbd4fa7526bc752c921a33d7f Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 8 May 2024 23:54:05 -0500 Subject: [PATCH 066/380] added neo-Hookean internal energy and Cauchy stress, need to compute F tensor from grad xi, compiles --- src/common/m_finger_tensor_calc.f90 | 129 ----------------- src/common/m_rmt_tensor_calc.f90 | 195 ++++++++++++++++++++++++++ src/common/m_variables_conversion.fpp | 22 +-- 3 files changed, 206 insertions(+), 140 deletions(-) delete mode 100644 src/common/m_finger_tensor_calc.f90 create mode 100644 src/common/m_rmt_tensor_calc.f90 diff --git a/src/common/m_finger_tensor_calc.f90 b/src/common/m_finger_tensor_calc.f90 deleted file mode 100644 index 2b2955bffa..0000000000 --- a/src/common/m_finger_tensor_calc.f90 +++ /dev/null @@ -1,129 +0,0 @@ -!> -!! @file m_variables_conversion.f90 -!! @brief Contains module m_variables_conversion - -!> @brief This module consists of subroutines used in the calculation of matrix -!! operations for the finger tensor - -module m_finger_tensor_calc - - ! Dependencies ============================================================= - use m_derived_types !< Definitions of the derived types - - use m_global_parameters !< Definitions of the global parameters - - use m_mpi_proxy !< Message passing interface (MPI) module proxy - - use m_helper - ! ========================================================================== - - implicit none - - private; public :: s_allocate_tensor, & - f_determinant, & - s_calculate_deviatoric, & - s_calculate_atransposea, & - f_elastic_energy - - contains - - subroutine s_allocate_tensor(q_cons_vf,j,k,l,tensor) - - type(scalar_field), dimension(sys_size), intent(IN) :: q_cons_vf - integer, intent(IN) :: j, k, l - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: tensor - - integer :: i !< Generic loop iterators - - ! Converting the primitive variables to the conservative variables - do i = 1, num_dims**2 - tensor(i) = q_cons_vf(stress_idx%beg+i-1)%sf(j,k,l) - end do - end subroutine s_allocate_tensor - - function f_determinant(tensor) - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)) :: f_determinant - - if (num_dims .eq. 1) then - f_determinant = tensor(1) ! TODO: Mirelys: does this make sense? - elseif (num_dims .eq. 2) then - f_determinant = tensor(1)*tensor(4) - tensor(2)*tensor(3) - else - f_determinant = tensor(1)*(tensor(5)*tensor(9) - tensor(6)*tensor(8)) & - - tensor(2)*(tensor(4)*tensor(9) - tensor(6)*tensor(7)) & - + tensor(3)*(tensor(4)*tensor(8) - tensor(5)*tensor(7)) - end if - - end function f_determinant - - subroutine s_calculate_deviatoric(tensor,deviatoric) - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: deviatoric - real(kind(0d0)) :: trace13 - - deviatoric = tensor - trace13 = f_trace(tensor) - trace13 = (1.0/3.0)*trace13 - deviatoric(1) = tensor(1) - trace13 - if (num_dims .eq. 2) then - deviatoric(4) = tensor(4) - trace13 - elseif (num_dims .eq. 3) then - deviatoric(5) = tensor(5) - trace13 - deviatoric(9) = tensor(9) - trace13 - end if - end subroutine s_calculate_deviatoric - - subroutine s_calculate_atransposea(tensor,ata) - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ata - - ata(1) = tensor(1)**2 ! TODO: Mirelys: Does this make sense? - if (num_dims .eq. 2) then - ata(1) = ata(1) + tensor(3)**2 - ata(2) = tensor(1)*tensor(2) + tensor(3)*tensor(4) - ata(3) = ata(2) - ata(4) = tensor(2)**2 + tensor(4)**2 - elseif (num_dims .eq. 3) then - ata(1) = ata(1) + tensor(4)**2 + tensor(7)**2 - ata(5) = tensor(2) + tensor(5)**2 + tensor(8)**2 - ata(9) = tensor(3) + tensor(6)**2 + tensor(9)**2 - ata(2) = tensor(1)*tensor(2) + tensor(4)*tensor(5) + tensor(7)*tensor(8) - ata(3) = tensor(1)*tensor(3) + tensor(4)*tensor(6) + tensor(7)*tensor(9) - ata(6) = tensor(2)*tensor(3) + tensor(5)*tensor(6) + tensor(8)*tensor(9) - ata(4) = ata(2) - ata(7) = ata(3) - ata(8) = ata(4) - end if - end subroutine s_calculate_atransposea - - function f_elastic_energy(ghat) - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: ghat - real(kind(0d0)), dimension(num_dims**2) :: matrix - real(kind(0d0)) :: f_elastic_energy - ! remove the identity and square - matrix = ghat - matrix(1) = matrix(1) - 1d0 - if (num_dims .eq. 2) then - matrix(4) = matrix(4) - 1d0 - elseif (num_dims .eq. 3) then - matrix(5) = matrix(5) - 1d0 - matrix(9) = matrix(9) - 1d0 - end if - matrix(:) = matrix(:)**2 - ! compute the trace - f_elastic_energy = f_trace(matrix) - end function f_elastic_energy - - function f_trace(tensor) - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)) :: f_trace - f_trace = tensor(1) - if (num_dims .eq. 2) then - f_trace = f_trace + tensor(4) - elseif (num_dims .eq. 3) then - f_trace = f_trace + tensor(5) + tensor(9) - end if - end function f_trace - -end module m_finger_tensor_calc diff --git a/src/common/m_rmt_tensor_calc.f90 b/src/common/m_rmt_tensor_calc.f90 new file mode 100644 index 0000000000..0c680e6b26 --- /dev/null +++ b/src/common/m_rmt_tensor_calc.f90 @@ -0,0 +1,195 @@ +!> +!! @file m_variables_conversion.f90 +!! @brief Contains module m_variables_conversion + +!> @brief This module consists of subroutines used in the calculation of matrix +!! operations for the reference map tensor + +module m_rmt_tensor_calc + + ! Dependencies ============================================================= + use m_derived_types !< Definitions of the derived types + + use m_global_parameters !< Definitions of the global parameters + + use m_mpi_proxy !< Message passing interface (MPI) module proxy + + use m_helper + ! ========================================================================== + + implicit none + + private; public :: s_calculate_btensor, & + s_calculate_cauchy_stress, & + f_elastic_energy + +contains + + subroutine s_calculate_btensor(q_cons_vf, j, k, l, btensor) + + type(scalar_field), dimension(sys_size), intent(IN) :: q_cons_vf + type(scalar_field), dimension(num_dims**2 + 1), intent(OUT) :: btensor + integer, intent(IN) :: j, k, l + + real(kind(0d0)), dimension(num_dims**2) :: ftensor, ftransposef, tensorb, tensor + integer :: i !< Generic loop iterators + + ! Converting the primitive variables to the conservative variables + do i = 1, num_dims + tensor(i) = q_cons_vf(stress_idx%beg + i - 1)%sf(j, k, l) + end do + ! need to calculate gradxi then calculate btensor and J = det(F) + + ! extracting the nxn tensor for the calculation + !do i = 1, num_dims**2 + ! ftensor(i) = gradxitensor(i)%sf(j, k, l) + !end do + !call s_calculate_atransposea(ftensor,ftransposef) + !call s_calculate_ainverse(ftransposef,btensor) + !jacobian = f_determinant(ftensor) + + end subroutine s_calculate_btensor + + function f_determinant(tensor) + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)) :: f_determinant + + if (num_dims == 1) then + f_determinant = tensor(1) ! TODO: Mirelys: does this make sense? + elseif (num_dims == 2) then + f_determinant = tensor(1)*tensor(4) - tensor(2)*tensor(3) + else + f_determinant = tensor(1)*(tensor(5)*tensor(9) - tensor(6)*tensor(8)) & + - tensor(2)*(tensor(4)*tensor(9) - tensor(6)*tensor(7)) & + + tensor(3)*(tensor(4)*tensor(8) - tensor(5)*tensor(7)) + end if + ! error checking + if (f_determinant == 0) then + print *, 'ERROR: Determinant was zero' + call s_mpi_abort() + end if + end function f_determinant + + subroutine s_calculate_deviatoric(tensor, deviatoric) + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: deviatoric + real(kind(0d0)) :: trace13 + deviatoric = tensor + trace13 = f_trace(tensor) + trace13 = (1.0/3.0)*trace13 + deviatoric(1) = tensor(1) - trace13 + if (num_dims == 2) then + deviatoric(4) = tensor(4) - trace13 + elseif (num_dims == 3) then + deviatoric(5) = tensor(5) - trace13 + deviatoric(9) = tensor(9) - trace13 + end if + end subroutine s_calculate_deviatoric + + function f_trace(tensor) + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)) :: f_trace + f_trace = tensor(1) + if (num_dims == 2) then + f_trace = f_trace + tensor(4) + elseif (num_dims == 3) then + f_trace = f_trace + tensor(5) + tensor(9) + end if + end function f_trace + + subroutine s_calculate_atransposea(tensor, ata) + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ata + + ata(1) = tensor(1)**2 ! TODO: Mirelys: Does this make sense? + if (num_dims == 2) then + ata(1) = ata(1) + tensor(3)**2 + ata(2) = tensor(1)*tensor(2) + tensor(3)*tensor(4) + ata(3) = ata(2) + ata(4) = tensor(2)**2 + tensor(4)**2 + elseif (num_dims == 3) then + ata(1) = ata(1) + tensor(4)**2 + tensor(7)**2 + ata(5) = tensor(2) + tensor(5)**2 + tensor(8)**2 + ata(9) = tensor(3) + tensor(6)**2 + tensor(9)**2 + ata(2) = tensor(1)*tensor(2) + tensor(4)*tensor(5) + tensor(7)*tensor(8) + ata(3) = tensor(1)*tensor(3) + tensor(4)*tensor(6) + tensor(7)*tensor(9) + ata(6) = tensor(2)*tensor(3) + tensor(5)*tensor(6) + tensor(8)*tensor(9) + ata(4) = ata(2) + ata(7) = ata(3) + ata(8) = ata(4) + end if + end subroutine s_calculate_atransposea + + subroutine s_calculate_adjointa(tensor, dja) + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: dja + + if (num_dims == 1) then + dja(1) = 1 + elseif (num_dims == 2) then + dja(1) = tensor(4) + dja(2) = -tensor(3) + dja(3) = -tensor(2) + dja(4) = tensor(1) + elseif (num_dims == 3) then + dja(1) = tensor(5)*tensor(9) - tensor(6)*tensor(8) + dja(2) = -(tensor(2)*tensor(9) - tensor(3)*tensor(8)) + dja(3) = tensor(2)*tensor(6) - tensor(3)*tensor(5) + dja(4) = -(tensor(4)*tensor(9) - tensor(6)*tensor(7)) + dja(5) = tensor(1)*tensor(9) - tensor(3)*tensor(7) + dja(6) = -(tensor(1)*tensor(6) - tensor(4)*tensor(3)) + dja(7) = tensor(4)*tensor(8) - tensor(5)*tensor(7) + dja(8) = -(tensor(1)*tensor(8) - tensor(2)*tensor(7)) + dja(9) = tensor(1)*tensor(5) - tensor(2)*tensor(4) + end if + end subroutine s_calculate_adjointa + + subroutine s_calculate_ainverse(tensor, ainv) + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ainv + real(kind(0d0)), dimension(num_dims**2) :: dja + real(kind(0d0)) :: det + + call s_calculate_adjointa(tensor,dja) + det = f_determinant(tensor) + ainv(:) = tensor(:)/det + end subroutine s_calculate_ainverse + + function f_elastic_energy(btensor, j, k, l) + type(scalar_field), dimension(num_dims**2 + 1), intent(IN) :: btensor + integer, intent(IN) :: j, k, l + + real(kind(0d0)), dimension(num_dims**2) :: ftransposef, tensorb + real(kind(0d0)) :: invariant1, jacobian, f_elastic_energy + integer :: i !< Generic loop iterators + + ! extracting the nxn tensor for the calculation + do i = 1, num_dims**2 + tensorb(i) = btensor(i)%sf(j, k, l) + end do + jacobian = btensor(num_dims**2+1)%sf(j,k,l) + invariant1 = f_trace(tensorb) + ! compute the invariant without the elastic modulus + f_elastic_energy = 0.5d0*(invariant1-3)/jacobian + end function f_elastic_energy + + subroutine s_calculate_cauchy_stress(btensor, j, k, l, sigma) + type(scalar_field), dimension(num_dims**2 + 1), intent(IN) :: btensor + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: sigma + integer, intent(IN) :: j, k, l + + real(kind(0d0)), dimension(num_dims**2) :: tensorb, devbtensor + real(kind(0d0)) :: jacobian + integer :: i !< Generic loop iterators + + ! extracting the nxn tensor for the calculation + do i = 1, num_dims**2 + tensorb(i) = btensor(i)%sf(j, k, l) + end do + jacobian = btensor(num_dims**2+1)%sf(j,k,l) + call s_calculate_deviatoric(tensorb,devbtensor) + sigma(:) = devbtensor(:)/jacobian + + end subroutine s_calculate_cauchy_stress + +end module m_rmt_tensor_calc diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index c25e55c03a..c52a0902ba 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -19,7 +19,7 @@ module m_variables_conversion use m_mpi_proxy !< Message passing interface (MPI) module proxy - use m_finger_tensor_calc !< Using finger matrix calculations + use m_rmt_tensor_calc !< Using reference map matrix calculations use m_helper ! ========================================================================== @@ -198,7 +198,7 @@ contains ! energy - & ! 0.5d0*(mom**2.d0)/rho - & ! pi_inf - qv - E_e & - ! )/gamma + ! )/gamma !end if end subroutine s_compute_pressure @@ -457,7 +457,7 @@ contains #endif if (present(G_K)) then - !TODO Check our mixture rule? Replace with Cauchy numbers, make code nondimensional + !TODO Check our mixture rule? Replace with Cauchy numbers, make code nondimensional G_K = 0d0 do i = 1, num_fluids G_K = G_K + alpha_K(i)*G(i) @@ -948,7 +948,7 @@ contains end if #else ! If pre-processing, use non acc mixture subroutines - if (hypoelasticity .or. hyperelasticity) then + if (hypoelasticity .or. hyperelasticity) then call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) else @@ -1044,12 +1044,12 @@ contains end do if (hyperelasticity) then - ! call s_allocate_tensor(qK_prim_vf,j,k,l,gtensor) - ! call s_calculate_atransposea(gtensor,getge) ! getge is G^e - ! detG = f_determinant(getge) ! determinant of G^e - ! ghat(:) = getge(:)*detG**(-1.d0/3.d0) - e_e = (G_K/(4.d0*rho_K))!*f_elastic_energy(ghat) - qK_prim_vf(E_idx)%sf(j,k,l) = qK_prim_vf(E_idx)%sf(j,k,l) - e_e/gamma_k + ! call s_allocate_tensor(qK_prim_vf,j,k,l,gtensor) + ! call s_calculate_atransposea(gtensor,getge) ! getge is G^e + ! detG = f_determinant(getge) ! determinant of G^e + ! ghat(:) = getge(:)*detG**(-1.d0/3.d0) + e_e = (G_K/(4.d0*rho_K))!*f_elastic_energy(ghat) + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - e_e/gamma_k end if !$acc loop seq @@ -1208,7 +1208,7 @@ contains end if end do end if - + !if (hyperelasticity .and. G .gt. 0.d0 ) then ! call s_allocate_tensor(q_cons_vf,j,k,l,gtensor) ! call s_calculate_atransposea(gtensor,getge) ! getge is G^e From 6b35533732c42b204d0c6cb465391d256b8b3cea Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 9 May 2024 20:35:00 -0500 Subject: [PATCH 067/380] working up RMT into MFC, built most structures, not fully implemented, fully compiles on CPUs, testing GPUs --- src/common/m_rmt_tensor_calc.f90 | 50 ++++++++++++------------ src/common/m_variables_conversion.fpp | 44 +++++++++++++++------ src/post_process/m_global_parameters.fpp | 3 +- src/pre_process/m_global_parameters.fpp | 4 +- src/simulation/m_global_parameters.fpp | 6 +-- src/simulation/m_rhs.fpp | 42 +++++++++++++++++++- 6 files changed, 103 insertions(+), 46 deletions(-) diff --git a/src/common/m_rmt_tensor_calc.f90 b/src/common/m_rmt_tensor_calc.f90 index 0c680e6b26..ce76c0c0a6 100644 --- a/src/common/m_rmt_tensor_calc.f90 +++ b/src/common/m_rmt_tensor_calc.f90 @@ -25,9 +25,9 @@ module m_rmt_tensor_calc contains - subroutine s_calculate_btensor(q_cons_vf, j, k, l, btensor) + subroutine s_calculate_btensor(q_prim_vf, j, k, l, btensor) - type(scalar_field), dimension(sys_size), intent(IN) :: q_cons_vf + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf type(scalar_field), dimension(num_dims**2 + 1), intent(OUT) :: btensor integer, intent(IN) :: j, k, l @@ -36,7 +36,7 @@ subroutine s_calculate_btensor(q_cons_vf, j, k, l, btensor) ! Converting the primitive variables to the conservative variables do i = 1, num_dims - tensor(i) = q_cons_vf(stress_idx%beg + i - 1)%sf(j, k, l) + tensor(i) = q_prim_vf(stress_idx%beg + i - 1)%sf(j, k, l) end do ! need to calculate gradxi then calculate btensor and J = det(F) @@ -64,7 +64,7 @@ function f_determinant(tensor) + tensor(3)*(tensor(4)*tensor(8) - tensor(5)*tensor(7)) end if ! error checking - if (f_determinant == 0) then + if (f_determinant == 0) then print *, 'ERROR: Determinant was zero' call s_mpi_abort() end if @@ -125,22 +125,22 @@ subroutine s_calculate_adjointa(tensor, dja) real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: dja if (num_dims == 1) then - dja(1) = 1 + dja(1) = 1 elseif (num_dims == 2) then - dja(1) = tensor(4) - dja(2) = -tensor(3) - dja(3) = -tensor(2) - dja(4) = tensor(1) + dja(1) = tensor(4) + dja(2) = -tensor(3) + dja(3) = -tensor(2) + dja(4) = tensor(1) elseif (num_dims == 3) then - dja(1) = tensor(5)*tensor(9) - tensor(6)*tensor(8) - dja(2) = -(tensor(2)*tensor(9) - tensor(3)*tensor(8)) - dja(3) = tensor(2)*tensor(6) - tensor(3)*tensor(5) - dja(4) = -(tensor(4)*tensor(9) - tensor(6)*tensor(7)) - dja(5) = tensor(1)*tensor(9) - tensor(3)*tensor(7) - dja(6) = -(tensor(1)*tensor(6) - tensor(4)*tensor(3)) - dja(7) = tensor(4)*tensor(8) - tensor(5)*tensor(7) - dja(8) = -(tensor(1)*tensor(8) - tensor(2)*tensor(7)) - dja(9) = tensor(1)*tensor(5) - tensor(2)*tensor(4) + dja(1) = tensor(5)*tensor(9) - tensor(6)*tensor(8) + dja(2) = -(tensor(2)*tensor(9) - tensor(3)*tensor(8)) + dja(3) = tensor(2)*tensor(6) - tensor(3)*tensor(5) + dja(4) = -(tensor(4)*tensor(9) - tensor(6)*tensor(7)) + dja(5) = tensor(1)*tensor(9) - tensor(3)*tensor(7) + dja(6) = -(tensor(1)*tensor(6) - tensor(4)*tensor(3)) + dja(7) = tensor(4)*tensor(8) - tensor(5)*tensor(7) + dja(8) = -(tensor(1)*tensor(8) - tensor(2)*tensor(7)) + dja(9) = tensor(1)*tensor(5) - tensor(2)*tensor(4) end if end subroutine s_calculate_adjointa @@ -150,7 +150,7 @@ subroutine s_calculate_ainverse(tensor, ainv) real(kind(0d0)), dimension(num_dims**2) :: dja real(kind(0d0)) :: det - call s_calculate_adjointa(tensor,dja) + call s_calculate_adjointa(tensor, dja) det = f_determinant(tensor) ainv(:) = tensor(:)/det end subroutine s_calculate_ainverse @@ -167,10 +167,10 @@ function f_elastic_energy(btensor, j, k, l) do i = 1, num_dims**2 tensorb(i) = btensor(i)%sf(j, k, l) end do - jacobian = btensor(num_dims**2+1)%sf(j,k,l) + jacobian = btensor(num_dims**2 + 1)%sf(j, k, l) invariant1 = f_trace(tensorb) ! compute the invariant without the elastic modulus - f_elastic_energy = 0.5d0*(invariant1-3)/jacobian + f_elastic_energy = 0.5d0*(invariant1 - 3)/jacobian end function f_elastic_energy subroutine s_calculate_cauchy_stress(btensor, j, k, l, sigma) @@ -186,10 +186,10 @@ subroutine s_calculate_cauchy_stress(btensor, j, k, l, sigma) do i = 1, num_dims**2 tensorb(i) = btensor(i)%sf(j, k, l) end do - jacobian = btensor(num_dims**2+1)%sf(j,k,l) - call s_calculate_deviatoric(tensorb,devbtensor) - sigma(:) = devbtensor(:)/jacobian + jacobian = btensor(num_dims**2 + 1)%sf(j, k, l) + call s_calculate_deviatoric(tensorb, devbtensor) + sigma(:) = devbtensor(:)/jacobian end subroutine s_calculate_cauchy_stress - + end module m_rmt_tensor_calc diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index c52a0902ba..5a02749e27 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -861,17 +861,22 @@ contains subroutine s_convert_conservative_to_primitive_variables(qK_cons_vf, & qK_prim_vf, & gm_alphaK_vf, & - ix, iy, iz) + ix, iy, iz, & + qK_btensor_vf) + type(scalar_field), dimension(sys_size), intent(IN) :: qK_cons_vf type(scalar_field), dimension(sys_size), intent(INOUT) :: qK_prim_vf - type(scalar_field), & allocatable, optional, dimension(:), & intent(IN) :: gm_alphaK_vf type(int_bounds_info), optional, intent(IN) :: ix, iy, iz + type(scalar_field), & + optional, dimension(num_dims**2), & + intent(IN) :: qK_btensor_vf + real(kind(0d0)), dimension(num_fluids) :: alpha_K, alpha_rho_K real(kind(0d0)), dimension(2) :: Re_K real(kind(0d0)) :: rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K @@ -1038,18 +1043,23 @@ contains end do end if - !$acc loop seq - do i = strxb, strxe - qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) - end do + if (hyperelasticity .and. .not. bubbles) then + !$acc loop seq + do i = strxb, strxe + qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & + /rho_K + end do + ! MAURO TODO REMOVE THE ELASTIC ENERGY FROM THE PRESSURE + !if(present(qK_btensor_vf)) then + ! use the btensor information to calculate + + !else + ! call the code to then generate the btensor, this will have to be in common + + !end if + !e_e = (G_K/(4.d0*rho_K))!*f_elastic_energy(ghat) + !qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - e_e/gamma_k - if (hyperelasticity) then - ! call s_allocate_tensor(qK_prim_vf,j,k,l,gtensor) - ! call s_calculate_atransposea(gtensor,getge) ! getge is G^e - ! detG = f_determinant(getge) ! determinant of G^e - ! ghat(:) = getge(:)*detG**(-1.d0/3.d0) - e_e = (G_K/(4.d0*rho_K))!*f_elastic_energy(ghat) - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - e_e/gamma_k end if !$acc loop seq @@ -1209,6 +1219,14 @@ contains end do end if + if (hyperelasticity) then + do i = stress_idx%beg, stress_idx%end + q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) + end do + ! MAURO!! TODO ADD THE ELASTIC ENERGY TO THIS PART OF THE CODE! + + end if + !if (hyperelasticity .and. G .gt. 0.d0 ) then ! call s_allocate_tensor(q_cons_vf,j,k,l,gtensor) ! call s_calculate_atransposea(gtensor,getge) ! getge is G^e diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 1c10638e8f..b1293da7f4 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -486,8 +486,9 @@ contains end if if (hyperelasticity) then + ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + num_dims**2 + stress_idx%end = sys_size + num_dims sys_size = stress_idx%end end if diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 7eb522ef8d..4e527eac35 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -591,9 +591,9 @@ contains end if if (hyperelasticity) then - ! number of distinct stress is 1 in 1D, 6 in 2D, and 9 in 3D + ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + num_dims**2 + stress_idx%end = sys_size + num_dims sys_size = stress_idx%end end if diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 641ea01e84..3a3d5434a2 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -664,7 +664,7 @@ contains if (model_eqns == 2) then cont_idx%beg = 1 cont_idx%end = num_fluids - mom_idx%beg = cont_idx%end + 1 + mom_idx%beg = cont_idx%end + 1 mom_idx%end = cont_idx%end + num_dims E_idx = mom_idx%end + 1 adv_idx%beg = E_idx + 1 @@ -784,9 +784,9 @@ contains end if if (hyperelasticity) then - ! number of distinct stress is 1 in 1D, 6 in 2D, and 9 in 3D + ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + num_dims**2 + stress_idx%end = sys_size + num_dims sys_size = stress_idx%end end if diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 9f67297029..b9a40ff14d 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -71,6 +71,11 @@ module m_rhs type(vector_field) :: q_prim_qp !< !$acc declare create(q_prim_qp) + !! The btensor at the cell-interior Gaussian quadrature points. + !! These tensor is needed to be calculated once and make the code DRY. + type(vector_field) :: q_btensor !< + !$acc declare create(q_btensor) + !> @name The first-order spatial derivatives of the primitive variables at cell- !! interior Gaussian quadrature points. These are WENO-reconstructed from !! their respective cell-average values, obtained through the application @@ -235,6 +240,7 @@ contains @:ALLOCATE(q_cons_qp%vf(1:sys_size)) @:ALLOCATE(q_prim_qp%vf(1:sys_size)) + @:ALLOCATE(q_btensor%vf(1:num_dims**2)) do l = 1, sys_size @:ALLOCATE(q_cons_qp%vf(l)%sf(ix%beg:ix%end, iy%beg:iy%end, iz%beg:iz%end)) @@ -248,7 +254,11 @@ contains @:ALLOCATE(q_prim_qp%vf(l)%sf(ix%beg:ix%end, iy%beg:iy%end, iz%beg:iz%end)) end do - @:ACC_SETUP_VFs(q_cons_qp, q_prim_qp) + do l = 1, num_dims**2 + @:ALLOCATE(q_btensor%vf(l)%sf(ix%beg:ix%end, iy%beg:iy%end, iz%beg:iz%end)) + end do + + @:ACC_SETUP_VFs(q_cons_qp, q_prim_qp, q_btensor) do l = 1, cont_idx%end q_prim_qp%vf(l)%sf => q_cons_qp%vf(l)%sf @@ -691,6 +701,23 @@ contains ! ================================================================== + ! Computing Btensor needed for conservative to primitive variables later == + + call nvtxStartRange("Hyperelasticity: Btensor") + ! create the Btensor and save in a large vector field + !if (hyperelasticity) call s_get_Btensor(qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, & + ! dqL_prim_dx_n, dqL_prim_dy_n, dqL_prim_dz_n, & + ! qL_prim, & + ! qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, & + ! dqR_prim_dx_n, dqR_prim_dy_n, dqR_prim_dz_n, & + ! qR_prim, & + ! q_prim_qp, & + ! dq_prim_dx_qp, dq_prim_dy_qp, dq_prim_dz_qp, & + ! ix, iy, iz) + call nvtxEndRange() + + ! ================================================================== + ! Converting Conservative to Primitive Variables ================== if (mpp_lim .and. bubbles) then @@ -718,7 +745,9 @@ contains q_cons_qp%vf, & q_prim_qp%vf, & gm_alpha_qp%vf, & - ix, iy, iz) + ix, iy, iz, & + q_btensor%vf) + call nvtxEndRange call nvtxStartRange("RHS-MPI") @@ -742,6 +771,7 @@ contains ix, iy, iz) call nvtxEndRange() + ! Dimensional Splitting Loop ======================================= do id = 1, num_dims @@ -886,6 +916,14 @@ contains rhs_vf) call nvtxEndRange + ! RHS additions for hyperelasticity + call nvtxStartRange("RHS_Hyperelasticity") + ! use the calculated Btensor and compute the Cauchy stress tensor in common + !if (hyperelasticity) call s_compute_hyperelastic_rhs(id, & + ! q_prim_qp%vf, & + ! rhs_vf) + call nvtxEndRange + ! RHS additions for viscosity call nvtxStartRange("RHS_viscous") if (any(Re_size > 0d0)) call s_compute_viscous_rhs(id, & From cb03f7e45cf76926335471e119f9d92764d9afde Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Fri, 10 May 2024 10:11:22 -0500 Subject: [PATCH 068/380] adding hyperelasticity flag to m_mpi_proxy + toolchain/case_dicts --- src/simulation/m_mpi_proxy.fpp | 2 +- toolchain/mfc/run/case_dicts.py | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index 7b8804e40a..3a72329da1 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -188,7 +188,7 @@ contains & 'parallel_io', 'hypoelasticity', 'bubbles', 'polytropic', & & 'polydisperse', 'qbmm', 'monopole', 'probe_wrt', 'integral_wrt', & & 'prim_vars_wrt', 'weno_avg', 'file_per_process', 'relax', & - & 'adv_n', 'adap_dt', 'ib', 'num_ibs' ] + & 'adv_n', 'adap_dt', 'ib', 'num_ibs', 'hyperelasticity' ] call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) #:endfor diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index 769ae021d1..5a975a5e8e 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -2,7 +2,7 @@ COMMON = [ - "hypoelasticity", "cyl_coord", "pref", "p", "parallel_io", + "hypoelasticity",'hyperelasticity', "cyl_coord", "pref", "p", "parallel_io", "Web", "poly_sigma", "case_dir", "thermal", "polytropic", "m", "mpp_lim", "R0ref", "adv_alphan", "num_fluids", "model_eqns", "nb", "weno_order", "rhoref", "bubbles", "Re_inv", "n", "precision", From eeef1770a9f41144ea4a95cc58935fd6d09442f7 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Fri, 10 May 2024 10:34:04 -0500 Subject: [PATCH 069/380] flag for crashing in m_dataouput in sim --- src/simulation/m_data_output.fpp | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index bcef507b94..1c60475d5f 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -331,6 +331,12 @@ contains ! Compute mixture sound speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c) + + if ( c .lt. 10d-12 ) then + print*, 'code has crashed at processor: ',proc_rank,' at j :: ',j,', k :: ',k,' l :: ',l,'with alph1a ::',alpha(1),'and alpha2 ::', alpha(2) + print*, 'ICFL ERROR, I TOLD YOU AGAIN!' + ! call s_mpi_abort() + endif if (grid_geometry == 3) then if (k == 0) then From 23f48195411f0c09a8ca03e788c2031e1b16b732 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Sat, 11 May 2024 13:20:05 -0500 Subject: [PATCH 070/380] dynamic threshold adjustment for interface and consistent with definng the energy regions as well --- src/post_process/m_data_output.fpp | 56 +++++++++++++++++------------- 1 file changed, 32 insertions(+), 24 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 9ce06c56a6..247edd407f 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -21,6 +21,8 @@ module m_data_output use m_compile_specific use m_helper + + use m_mpi_common ! ========================================================================== implicit none @@ -986,39 +988,41 @@ contains real(kind(0d0)), dimension(num_fluids) :: alpha, vol_fluid, xcom, ycom, zcom real(kind=8), parameter :: pi = 4.d0*datan(1.d0) real(kind(0d0)), allocatable :: x_td(:), y_td(:), x_d1(:), y_d1(:), y_d(:), x_d(:) - real(kind(0d0)) :: axp, axm, ayp, aym, azm, azp + real(kind(0d0)) :: axp, axm, ayp, aym, azm, azp, tgp, euc_d, maxalph_loc, maxalph_glb, thres allocate (x_d1(m*n)) allocate (y_d1(m*n)) counter = 0 - + maxalph_loc = maxval(q_prim_vf(E_idx + 2)%sf(:,:,:)) + call s_mpi_allreduce_max(maxalph_loc, maxalph_glb) do l = 0, p - if (z_cc(l) < dz(l) .and. z_cc(l) > 0) then + if (z_cc(l) < dz(l) .and. z_cc(l) >= 0) then cent = l end if end do + thres = 0.9d0*maxalph_glb do k = 0, n OLoop: do j = 0, m - axp = q_prim_vf(E_idx + 1)%sf(j + 1, k, cent) - axm = q_prim_vf(E_idx + 1)%sf(j - 1, k, cent) - ayp = q_prim_vf(E_idx + 1)%sf(j, k + 1, cent) - aym = q_prim_vf(E_idx + 1)%sf(j, k - 1, cent) + axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) + axm = q_prim_vf(E_idx + 2)%sf(j - 1, k, cent) + ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, cent) + aym = q_prim_vf(E_idx + 2)%sf(j, k - 1, cent) - if ((axp > 0.9 .and. axm < 0.9) .or. (axp < 0.9 .and. axm > 0.9) & - .or. (ayp > 0.9 .and. aym < 0.9) .or. (ayp < 0.9 .and. aym > 0.9)) then + if ((axp > thres .and. axm < thres) .or. (axp < thres .and. axm > thres) & + .or. (ayp > thres .and. aym < thres) .or. (ayp < thres .and. aym > thres)) then if (counter == 0) then counter = counter + 1 x_d1(counter) = x_cc(j) y_d1(counter) = y_cc(k) + euc_d = sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2) + tgp = 2*sqrt(dx(j)**2 + dy(k)**2) else do i = 1, counter - if (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & - y_d1(i))**2) <= 2*sqrt(dx(j)**2 & - + dy(k)**2)) then + if (euc_d <= tgp) then cycle OLoop - elseif (sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - & - y_d1(i))**2) > 2*sqrt(dx(j)**2 & - + dy(k)**2) .and. i == counter) then + elseif (euc_d > tgp .and. i == counter .and. x_cc(j) < 1.5 .and. y_cc(k) < 1.5) then + !artificial bounding on the interface for bubble at a centroid. + !need to remove eventually. counter = counter + 1 x_d1(counter) = x_cc(j) y_d1(counter) = y_cc(k) @@ -1055,13 +1059,17 @@ contains subroutine s_write_energy_data_file(q_prim_vf, t_step) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer, intent(IN) :: t_step - real(kind(0d0)) :: Elk, Egk, Elint, Egint, Vb - real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf + real(kind(0d0)) :: Elk, Egk, Elint, Egint, Vb, maxalph_loc, maxalph_glb + real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, thres real(kind(0d0)), dimension(num_dims) :: vel real(kind(0d0)), dimension(num_fluids) :: gammas, pi_infs integer :: i, j, k, l, s !looping indicies integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations - + + maxalph_loc = maxval(q_prim_vf(E_idx + 2)%sf(:,:,:)) + call s_mpi_allreduce_max(maxalph_loc, maxalph_glb) + thres = 0.9d0*maxalph_glb + Elk = 0d0 Egk = 0d0 Elint = 0d0 @@ -1086,17 +1094,17 @@ contains pres = q_prim_vf(E_idx)%sf(i, j, k) do s = 1, num_dims vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) - if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9) then - Elk = Elk + 0.5d0*rho*vel(s)*vel(s)*dV - else + if (q_prim_vf(E_idx+2)%sf(i, j, k) > thres) then Egk = Egk + 0.5d0*rho*vel(s)*vel(s)*dV + else + Elk = Elk + 0.5d0*rho*vel(s)*vel(s)*dV end if end do - if (q_prim_vf(E_idx + 1)%sf(i, j, k) > 0.9) then - Elint = Elint + (gamma*pres + pi_inf)*dV - else + if (q_prim_vf(E_idx+2)%sf(i, j, k) > thres) then Egint = Egint + (gamma*pres + pi_inf)*dV Vb = Vb + dV + else + Elint = Elint + (gamma*pres + pi_inf)*dV end if end do end do From dae5cbfa50222657af4cbb7cfd9b6a497ecd39a4 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Sat, 11 May 2024 13:28:35 -0500 Subject: [PATCH 071/380] adjusting threshold to 0.75*max(alpha2) --- src/post_process/m_data_output.fpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 247edd407f..6abb5ea118 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -1000,7 +1000,7 @@ contains cent = l end if end do - thres = 0.9d0*maxalph_glb + thres = 0.75d0*maxalph_glb do k = 0, n OLoop: do j = 0, m axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) @@ -1068,7 +1068,7 @@ contains maxalph_loc = maxval(q_prim_vf(E_idx + 2)%sf(:,:,:)) call s_mpi_allreduce_max(maxalph_loc, maxalph_glb) - thres = 0.9d0*maxalph_glb + thres = 0.75d0*maxalph_glb Elk = 0d0 Egk = 0d0 From c049c1b1e53d2a2ebdbbc602e0af03bf9e990469 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 11 May 2024 14:30:26 -0500 Subject: [PATCH 072/380] fixed issues in common/RMT calc, working on btensor calculation, compiles on GPUs --- src/common/m_rmt_tensor_calc.f90 | 41 +++++++----------- src/common/m_variables_conversion.fpp | 40 ++++++++---------- src/simulation/m_hyperelastic.fpp | 61 +++++++++++++++++++++++++++ src/simulation/m_rhs.fpp | 13 ++---- 4 files changed, 98 insertions(+), 57 deletions(-) create mode 100644 src/simulation/m_hyperelastic.fpp diff --git a/src/common/m_rmt_tensor_calc.f90 b/src/common/m_rmt_tensor_calc.f90 index ce76c0c0a6..15405432f5 100644 --- a/src/common/m_rmt_tensor_calc.f90 +++ b/src/common/m_rmt_tensor_calc.f90 @@ -20,15 +20,15 @@ module m_rmt_tensor_calc implicit none private; public :: s_calculate_btensor, & - s_calculate_cauchy_stress, & - f_elastic_energy + f_elastic_energy, & + s_calculate_deviatoric contains subroutine s_calculate_btensor(q_prim_vf, j, k, l, btensor) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - type(scalar_field), dimension(num_dims**2 + 1), intent(OUT) :: btensor + type(scalar_field), dimension(num_dims*(num_dims+1)/2 + 1), intent(OUT) :: btensor integer, intent(IN) :: j, k, l real(kind(0d0)), dimension(num_dims**2) :: ftensor, ftransposef, tensorb, tensor @@ -38,7 +38,9 @@ subroutine s_calculate_btensor(q_prim_vf, j, k, l, btensor) do i = 1, num_dims tensor(i) = q_prim_vf(stress_idx%beg + i - 1)%sf(j, k, l) end do + ! NOTE: btensor is symmetric, save the data space ! need to calculate gradxi then calculate btensor and J = det(F) + ! store in btensor ! extracting the nxn tensor for the calculation !do i = 1, num_dims**2 @@ -152,11 +154,15 @@ subroutine s_calculate_ainverse(tensor, ainv) call s_calculate_adjointa(tensor, dja) det = f_determinant(tensor) - ainv(:) = tensor(:)/det + ainv(:) = dja(:)/det end subroutine s_calculate_ainverse + ! neo-Hookean only at this time, will need to be changed later function f_elastic_energy(btensor, j, k, l) - type(scalar_field), dimension(num_dims**2 + 1), intent(IN) :: btensor + type(scalar_field), & + dimension(num_dims*(num_dims+1)/2 + 1), & + intent(IN) :: btensor + integer, intent(IN) :: j, k, l real(kind(0d0)), dimension(num_dims**2) :: ftransposef, tensorb @@ -164,32 +170,17 @@ function f_elastic_energy(btensor, j, k, l) integer :: i !< Generic loop iterators ! extracting the nxn tensor for the calculation - do i = 1, num_dims**2 + !TODO COPY SPRATT CODE FOR SYMMETRIC TENSOR + do i = 1, num_dims*(num_dims+1)/2 tensorb(i) = btensor(i)%sf(j, k, l) end do - jacobian = btensor(num_dims**2 + 1)%sf(j, k, l) + tensorb(1) = btensor(1)%sf(j, k, l) + + jacobian = btensor(num_dims*(num_dims+1)/2 + 1)%sf(j, k, l) invariant1 = f_trace(tensorb) ! compute the invariant without the elastic modulus f_elastic_energy = 0.5d0*(invariant1 - 3)/jacobian end function f_elastic_energy - subroutine s_calculate_cauchy_stress(btensor, j, k, l, sigma) - type(scalar_field), dimension(num_dims**2 + 1), intent(IN) :: btensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: sigma - integer, intent(IN) :: j, k, l - - real(kind(0d0)), dimension(num_dims**2) :: tensorb, devbtensor - real(kind(0d0)) :: jacobian - integer :: i !< Generic loop iterators - - ! extracting the nxn tensor for the calculation - do i = 1, num_dims**2 - tensorb(i) = btensor(i)%sf(j, k, l) - end do - jacobian = btensor(num_dims**2 + 1)%sf(j, k, l) - call s_calculate_deviatoric(tensorb, devbtensor) - sigma(:) = devbtensor(:)/jacobian - - end subroutine s_calculate_cauchy_stress end module m_rmt_tensor_calc diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 5a02749e27..593b656811 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -875,7 +875,7 @@ contains type(scalar_field), & optional, dimension(num_dims**2), & - intent(IN) :: qK_btensor_vf + intent(OUT) :: qK_btensor_vf real(kind(0d0)), dimension(num_fluids) :: alpha_K, alpha_rho_K real(kind(0d0)), dimension(2) :: Re_K @@ -1043,22 +1043,21 @@ contains end do end if - if (hyperelasticity .and. .not. bubbles) then + if (hyperelasticity .and. .not. bubbles .and. G_K > 100 ) then !$acc loop seq do i = strxb, strxe qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & /rho_K end do - ! MAURO TODO REMOVE THE ELASTIC ENERGY FROM THE PRESSURE - !if(present(qK_btensor_vf)) then - ! use the btensor information to calculate - !else - ! call the code to then generate the btensor, this will have to be in common + !call s_calculate_btensor(qK_prim_vf, j, k, l, qK_btensor_vf) - !end if - !e_e = (G_K/(4.d0*rho_K))!*f_elastic_energy(ghat) - !qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - e_e/gamma_k + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & + !G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K + + else + ! Mostly in the non-solid material + qK_btensor_vf(:)%sf(j,k,l) = 0d0 end if @@ -1093,6 +1092,8 @@ contains dimension(sys_size), & intent(INOUT) :: q_cons_vf + type(scalar_field), dimension(num_dims**2) :: q_btensor_vf + ! Density, specific heat ratio function, liquid stiffness function ! and dynamic pressure, as defined in the incompressible flow sense, ! respectively @@ -1220,22 +1221,15 @@ contains end if if (hyperelasticity) then + ! adding the elastic contribution do i = stress_idx%beg, stress_idx%end q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) end do - ! MAURO!! TODO ADD THE ELASTIC ENERGY TO THIS PART OF THE CODE! - + !call s_calculate_btensor(qK_prim_vf, j, k, l, q_btensor_vf) + q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) !+ & + !G*f_elastic_energy(q_btensor_vf, j, k, l) end if - - !if (hyperelasticity .and. G .gt. 0.d0 ) then - ! call s_allocate_tensor(q_cons_vf,j,k,l,gtensor) - ! call s_calculate_atransposea(gtensor,getge) ! getge is G^e - ! detG = f_determinant(getge) ! determinant of G^e - ! ghat(:) = getge(:)*detG**(-1.d0/3.d0) - ! e_e = (G/(4.d0*rho))*f_elastic_energy(ghat) - ! q_cons_vf(E_idx)%sf(j,k,l) = q_cons_vf(E_idx)%sf(j,k,l) + e_e - !end if - + end do end do end do @@ -1323,7 +1317,7 @@ contains end do pres_K = qK_prim_vf(j, k, l, E_idx) - if (hypoelasticity) then + if (hypoelasticity .or. hyperelasticity) then call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, & alpha_K, alpha_rho_K, Re_K, & j, k, l, G_K, Gs) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp new file mode 100644 index 0000000000..2abb7c9890 --- /dev/null +++ b/src/simulation/m_hyperelastic.fpp @@ -0,0 +1,61 @@ +!> +!! @file m_hyperelastic.f90 +!! @brief Contains module m_hyperelastic + +#:include 'macros.fpp' + +!> @brief This module is used to compute source terms for hyperelastic model +module m_hyperelastic + + ! Dependencies ============================================================= + + use m_derived_types !< Definitions of the derived types + + use m_global_parameters !< Definitions of the global parameters + + use m_mpi_proxy !< Message passing interface (MPI) module proxy + + use m_rmt_tensor_calc !< State variables type conversion procedures + + ! ========================================================================== + + implicit none + + private; public :: s_initialize_hyperelastic_module, & + s_compute_hyperelastic_rhs, & + s_calculate_cauchy_stress + +contains + + subroutine s_initialize_hyperelastic_module() + + end subroutine s_initialize_hyperelastic_module + + subroutine s_compute_hyperelastic_rhs() + + end subroutine s_compute_hyperelastic_rhs + + subroutine s_calculate_cauchy_stress(btensor, j, k, l, sigma) + type(scalar_field), dimension(num_dims**2 + 1), intent(IN) :: btensor + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: sigma + integer, intent(IN) :: j, k, l + + real(kind(0d0)), dimension(num_dims**2) :: tensorb, devbtensor + real(kind(0d0)) :: jacobian + integer :: i !< Generic loop iterators + + ! extracting the nxn tensor for the calculation + do i = 1, num_dims**2 + tensorb(i) = btensor(i)%sf(j, k, l) + end do + jacobian = btensor(num_dims**2 + 1)%sf(j, k, l) + call s_calculate_deviatoric(tensorb, devbtensor) + sigma(:) = devbtensor(:)/jacobian + + end subroutine s_calculate_cauchy_stress + + + +end module m_hyperelastic + + diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index b9a40ff14d..81ddb82105 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -39,6 +39,8 @@ module m_rhs use m_hypoelastic + use m_hyperelastic + use m_monopole use m_viscous @@ -705,15 +707,7 @@ contains call nvtxStartRange("Hyperelasticity: Btensor") ! create the Btensor and save in a large vector field - !if (hyperelasticity) call s_get_Btensor(qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, & - ! dqL_prim_dx_n, dqL_prim_dy_n, dqL_prim_dz_n, & - ! qL_prim, & - ! qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, & - ! dqR_prim_dx_n, dqR_prim_dy_n, dqR_prim_dz_n, & - ! qR_prim, & - ! q_prim_qp, & - ! dq_prim_dx_qp, dq_prim_dy_qp, dq_prim_dz_qp, & - ! ix, iy, iz) + call nvtxEndRange() ! ================================================================== @@ -921,6 +915,7 @@ contains ! use the calculated Btensor and compute the Cauchy stress tensor in common !if (hyperelasticity) call s_compute_hyperelastic_rhs(id, & ! q_prim_qp%vf, & + ! ! rhs_vf) call nvtxEndRange From bba5cf1e48f5922fc96806ceee12e93ae1360168 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 11 May 2024 16:01:30 -0500 Subject: [PATCH 073/380] code GPU compiles, added pre_process TODOs for Mirelys --- src/pre_process/m_assign_variables.f90 | 23 +++++++++++++++++++++++ src/pre_process/m_checker.f90 | 2 ++ src/pre_process/m_mpi_proxy.fpp | 2 +- src/pre_process/m_start_up.fpp | 2 +- src/simulation/m_start_up.fpp | 2 +- 5 files changed, 28 insertions(+), 3 deletions(-) diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 index 9d7c21f457..029b2f9cf2 100644 --- a/src/pre_process/m_assign_variables.f90 +++ b/src/pre_process/m_assign_variables.f90 @@ -440,6 +440,29 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & end do end if + ! Elastic Shear Stress + if (hyperelasticity) then + do i = 1, (stress_idx%end - stress_idx%beg) + 1 + !q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = & + ! (eta*patch_icpp(patch_id)%tau_e(i) & + ! + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1)) + end do + ! TODO MIRELYS + ! STEP 1: Calculate r_o, initial position and theta and psi + ! r_o = (x^2 + y^2 + z^2)^1/2 + ! \theta = itan(y/x) + ! \psi = arccos(z/r_o) + ! STEP 2: Calculate the equilibrium radius from the input file + ! Req = Rmax/(p_L/p_b), where Rmax is the initial radius, p_L and p_b is the initial liquid and bubble pressure + ! STEP 3: Calculate the current grid position, i.e., \xi + ! \xi_s = (r_o^3 - Req^3 + Rmax^3)^(1/3) This is in spherical coordinates + ! STEP 4: map \xi back to x, y, z coordinate system + ! \xi_cartesian_x = \xi_s*sin(psi)*cos(theta) + ! \xi_cartesian_y = \xi_s*sin(psi)*sin(theta) + ! \xi_cartesian_z = \xi_s*cos(psi) + ! STEP 5: Update q_prim_vf(i + stress_idx%beg - 1) + end if + if (mpp_lim .and. bubbles) then !adjust volume fractions, according to modeled gas void fraction alf_sum%sf = 0d0 diff --git a/src/pre_process/m_checker.f90 b/src/pre_process/m_checker.f90 index 595ab1268e..1a1f0f1dab 100644 --- a/src/pre_process/m_checker.f90 +++ b/src/pre_process/m_checker.f90 @@ -104,6 +104,8 @@ subroutine s_check_inputs() call s_mpi_abort('hypoelasticity requires model_eqns = 2'// & 'exiting ...') end if + ! TODO MIRELYS ADD CHECKER FLAG FOR THIS + ! phase change checkers. if (relax) then if (model_eqns /= 3) then diff --git a/src/pre_process/m_mpi_proxy.fpp b/src/pre_process/m_mpi_proxy.fpp index d356cd5e68..42c93050b6 100644 --- a/src/pre_process/m_mpi_proxy.fpp +++ b/src/pre_process/m_mpi_proxy.fpp @@ -55,7 +55,7 @@ contains & 'cyl_coord','adv_alphan','mpp_lim','hypoelasticity', 'relax', & & 'parallel_io', 'perturb_flow', 'vel_profile', 'instability_wave',& & 'perturb_sph', 'bubbles', 'polytropic', 'polydisperse', 'qbmm', & - & 'file_per_process', 'adv_n', 'ib' ] + & 'file_per_process', 'adv_n', 'ib', 'hyperelasticity' ] call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) #:endfor call MPI_BCAST(fluid_rho(1), num_fluids_max, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index 38339dadbc..1913e8ef80 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -136,7 +136,7 @@ contains sigR, sigV, dist_type, rhoRV, R0_type, & file_per_process, relax, relax_model, & palpha_eps, ptgalpha_eps, adv_n, & - ib, num_ibs, patch_ib + ib, num_ibs, patch_ib, hyperelasticity ! Inquiring the status of the pre_process.inp file file_loc = 'pre_process.inp' diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 89465b26c0..76299522da 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -133,7 +133,7 @@ contains riemann_solver, wave_speeds, avg_state, & bc_x, bc_y, bc_z, & hypoelasticity, & - ib, num_ibs, patch_ib, & + ib, num_ibs, hyperelasticity, patch_ib, & fluid_pp, probe_wrt, prim_vars_wrt, & fd_order, probe, num_probes, t_step_old, & alt_soundspeed, mixture_err, weno_Re_flux, & From 6de626200c06aaf22eb0dc46a594d5f22491df1d Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Sat, 11 May 2024 19:56:26 -0500 Subject: [PATCH 074/380] adding pre_stress state flag --- src/pre_process/m_assign_variables.f90 | 15 ++++++++++----- src/pre_process/m_checker.f90 | 13 +++++++++++-- src/pre_process/m_global_parameters.fpp | 2 ++ src/pre_process/m_mpi_proxy.fpp | 2 +- src/pre_process/m_start_up.fpp | 2 +- 5 files changed, 25 insertions(+), 9 deletions(-) diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 index 029b2f9cf2..ebc85b6c4f 100644 --- a/src/pre_process/m_assign_variables.f90 +++ b/src/pre_process/m_assign_variables.f90 @@ -443,17 +443,22 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & ! Elastic Shear Stress if (hyperelasticity) then do i = 1, (stress_idx%end - stress_idx%beg) + 1 - !q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = & + ! STEP 1: Calculate r_o (initial position) and theta and phi + !r_o = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2)) + !theta = atan2(y_cc(k), x_cc(j)) + !phi = atan2(sqrt(x_cc(j)**2 + y_cc(k)**2), z_cc(l)) + ! STEP 2: Calculate the equilibrium radius from the initial bubble radius, + ! initial liquid pressure and initial bubble pressure specified in input file + ! Req = Rmax/( p_l / p_b)**(1d0 / 3d0) + + ! q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = & ! (eta*patch_icpp(patch_id)%tau_e(i) & ! + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1)) end do ! TODO MIRELYS - ! STEP 1: Calculate r_o, initial position and theta and psi - ! r_o = (x^2 + y^2 + z^2)^1/2 - ! \theta = itan(y/x) ! \psi = arccos(z/r_o) ! STEP 2: Calculate the equilibrium radius from the input file - ! Req = Rmax/(p_L/p_b), where Rmax is the initial radius, p_L and p_b is the initial liquid and bubble pressure + ! Req = Rmax/((p_L/p_b)^(1/3)), where Rmax is the initial radius, p_L and p_b is the initial liquid and bubble pressure ! STEP 3: Calculate the current grid position, i.e., \xi ! \xi_s = (r_o^3 - Req^3 + Rmax^3)^(1/3) This is in spherical coordinates ! STEP 4: map \xi back to x, y, z coordinate system diff --git a/src/pre_process/m_checker.f90 b/src/pre_process/m_checker.f90 index 1a1f0f1dab..8218310b9f 100644 --- a/src/pre_process/m_checker.f90 +++ b/src/pre_process/m_checker.f90 @@ -104,8 +104,17 @@ subroutine s_check_inputs() call s_mpi_abort('hypoelasticity requires model_eqns = 2'// & 'exiting ...') end if - ! TODO MIRELYS ADD CHECKER FLAG FOR THIS - + + if (hyperelasticity .and. (model_eqns /= 2)) then + call s_mpi_abort('hyperelasticity requires model_eqns =2'// & + 'exiting ...') + end if + + if (pre_stress .and. .not. hyperelasticity) then + call s_mpi_abort('pre_stress requires hyperelasticity'// & + 'exiting ...') + end if + ! phase change checkers. if (relax) then if (model_eqns /= 3) then diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 4e527eac35..48237474d2 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -85,6 +85,7 @@ module m_global_parameters integer :: weno_order !< Order of accuracy for the WENO reconstruction logical :: hypoelasticity !< activate hypoelasticity logical :: hyperelasticity !< activate hyperelasticity + logical :: pre_stress !< activate pre_stressed domain ! Annotations of the structure, i.e. the organization, of the state vectors type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. @@ -277,6 +278,7 @@ contains hypoelasticity = .false. hyperelasticity = .false. + pre_stress = .false. bc_x%beg = dflt_int; bc_x%end = dflt_int bc_y%beg = dflt_int; bc_y%end = dflt_int diff --git a/src/pre_process/m_mpi_proxy.fpp b/src/pre_process/m_mpi_proxy.fpp index 42c93050b6..3809eac053 100644 --- a/src/pre_process/m_mpi_proxy.fpp +++ b/src/pre_process/m_mpi_proxy.fpp @@ -55,7 +55,7 @@ contains & 'cyl_coord','adv_alphan','mpp_lim','hypoelasticity', 'relax', & & 'parallel_io', 'perturb_flow', 'vel_profile', 'instability_wave',& & 'perturb_sph', 'bubbles', 'polytropic', 'polydisperse', 'qbmm', & - & 'file_per_process', 'adv_n', 'ib', 'hyperelasticity' ] + & 'file_per_process', 'adv_n', 'ib', 'hyperelasticity','pre_stress'] call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) #:endfor call MPI_BCAST(fluid_rho(1), num_fluids_max, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index 1913e8ef80..8fecaccb35 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -136,7 +136,7 @@ contains sigR, sigV, dist_type, rhoRV, R0_type, & file_per_process, relax, relax_model, & palpha_eps, ptgalpha_eps, adv_n, & - ib, num_ibs, patch_ib, hyperelasticity + ib, num_ibs, patch_ib, hyperelasticity, pre_stress ! Inquiring the status of the pre_process.inp file file_loc = 'pre_process.inp' From b64aa4574280b62c461fd2539da1c1172ef7d009 Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Sat, 11 May 2024 22:47:54 -0500 Subject: [PATCH 075/380] pre-processing with xi field (for one solid) ready, can compile with gpu --- src/pre_process/m_assign_variables.f90 | 38 +++++++++++--------------- toolchain/mfc/run/case_dicts.py | 2 +- 2 files changed, 17 insertions(+), 23 deletions(-) diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 index ebc85b6c4f..dec98d03ff 100644 --- a/src/pre_process/m_assign_variables.f90 +++ b/src/pre_process/m_assign_variables.f90 @@ -260,6 +260,8 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & real(kind(0d0)) :: orig_qv real(kind(0d0)) :: muR, muV real(kind(0d0)) :: R3bar + real(kind(0d0)) :: rcoord, theta, phi, xi_sph + real(kind(0d0)), dimension(3) :: xi_cart real(kind(0d0)), dimension(int(E_idx - mom_idx%beg)) :: vel !< velocity real(kind(0d0)) :: pres !< pressure @@ -442,30 +444,22 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & ! Elastic Shear Stress if (hyperelasticity) then + xi_cart(1) = x_cc(j) + xi_cart(2) = y_cc(k) + xi_cart(3) = z_cc(l) + if (pre_stress) then ! pre stressed initial condition in spatial domain + rcoord = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2)) + phi = atan2(y_cc(k), x_cc(j)) + theta = atan2(sqrt(x_cc(j)**2 + y_cc(k)**2), z_cc(l)) + xi_sph = (rcoord**3 - R0ref**3 + 1)**( 1d0 / 3d0 ) !spherical coord, assuming Rmax=1 + xi_cart(1) = xi_sph*sin(theta)*cos(phi) + xi_cart(2) = xi_sph*sin(theta)*sin(phi) + xi_cart(3) = xi_sph*cos(theta) + end if do i = 1, (stress_idx%end - stress_idx%beg) + 1 - ! STEP 1: Calculate r_o (initial position) and theta and phi - !r_o = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2)) - !theta = atan2(y_cc(k), x_cc(j)) - !phi = atan2(sqrt(x_cc(j)**2 + y_cc(k)**2), z_cc(l)) - ! STEP 2: Calculate the equilibrium radius from the initial bubble radius, - ! initial liquid pressure and initial bubble pressure specified in input file - ! Req = Rmax/( p_l / p_b)**(1d0 / 3d0) - - ! q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = & - ! (eta*patch_icpp(patch_id)%tau_e(i) & - ! + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1)) + q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = & + (eta*xi_cart(i) + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1)) end do - ! TODO MIRELYS - ! \psi = arccos(z/r_o) - ! STEP 2: Calculate the equilibrium radius from the input file - ! Req = Rmax/((p_L/p_b)^(1/3)), where Rmax is the initial radius, p_L and p_b is the initial liquid and bubble pressure - ! STEP 3: Calculate the current grid position, i.e., \xi - ! \xi_s = (r_o^3 - Req^3 + Rmax^3)^(1/3) This is in spherical coordinates - ! STEP 4: map \xi back to x, y, z coordinate system - ! \xi_cartesian_x = \xi_s*sin(psi)*cos(theta) - ! \xi_cartesian_y = \xi_s*sin(psi)*sin(theta) - ! \xi_cartesian_z = \xi_s*cos(psi) - ! STEP 5: Update q_prim_vf(i + stress_idx%beg - 1) end if if (mpp_lim .and. bubbles) then diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index 9036a9d286..be8065cecf 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -16,7 +16,7 @@ 'instability_wave', 'perturb_flow', 'perturb_flow_fluid', 'perturb_flow_mag', 'perturb_sph', 'perturb_sph_fluid', 'fluid_rho', 'num_patches', 'qbmm', 'dist_type', 'R0_type', 'sigR', 'sigV', 'rhoRV', "palpha_eps", "ptgalpha_eps", - 'pi_fac', 'ib', 'num_ibs' + 'pi_fac', 'ib', 'num_ibs', 'pre_stress' ] for ib_id in range(1, 10+1): From be6cf75eaf1e70e3f8f84760d3b662798f790173 Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Sun, 12 May 2024 14:47:03 -0500 Subject: [PATCH 076/380] adding hyperelasticity to post_process, compiles on gpu, let's gooo --- src/post_process/m_data_input.f90 | 4 ++-- src/post_process/m_mpi_proxy.fpp | 2 +- src/post_process/m_start_up.f90 | 15 +++++++++------ 3 files changed, 12 insertions(+), 9 deletions(-) diff --git a/src/post_process/m_data_input.f90 b/src/post_process/m_data_input.f90 index 0a09826072..fa75a27d5e 100644 --- a/src/post_process/m_data_input.f90 +++ b/src/post_process/m_data_input.f90 @@ -332,7 +332,7 @@ subroutine s_read_parallel_data_files(t_step) ! --------------------------- NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) ! Read the data for each variable - if (bubbles .or. hypoelasticity) then + if (bubbles .or. hypoelasticity .or. hyperelasticity) then do i = 1, sys_size var_MOK = int(i, MPI_OFFSET_KIND) @@ -379,7 +379,7 @@ subroutine s_read_parallel_data_files(t_step) ! --------------------------- NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) ! Read the data for each variable - if (bubbles .or. hypoelasticity) then + if (bubbles .or. hypoelasticity .or. hyperelasticity) then do i = 1, sys_size var_MOK = int(i, MPI_OFFSET_KIND) diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp index 79686abb0e..2f4e1d51fb 100644 --- a/src/post_process/m_mpi_proxy.fpp +++ b/src/post_process/m_mpi_proxy.fpp @@ -200,7 +200,7 @@ contains & 'heat_ratio_wrt', 'pi_inf_wrt', 'pres_inf_wrt', 'cons_vars_wrt', & & 'prim_vars_wrt', 'c_wrt', 'qm_wrt','schlieren_wrt', 'bubbles', & & 'polytropic', 'polydisperse', 'file_per_process', 'relax', & - & 'adv_n', 'qbmm' ] + & 'adv_n', 'qbmm','hyperelasticity'] call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) #:endfor diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index a801fa50f3..2eb9234e98 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -72,7 +72,7 @@ subroutine s_read_input_file() ! --------------------------------------- parallel_io, rhoref, pref, bubbles, qbmm, sigR, & R0ref, nb, polytropic, thermal, Ca, Web, Re_inv, & polydisperse, poly_sigma, file_per_process, relax, relax_model, & - adv_n, sim_data + adv_n, sim_data, hyperelasticity ! Inquiring the status of the post_process.inp file file_loc = 'post_process.inp' @@ -313,21 +313,24 @@ subroutine s_save_data(t_step, varname, pres, c, H) ! ---------------------------------------------------------------------- ! Adding the elastic shear stresses to the formatted database file ----- - if (hypoelasticity) then + if (hypoelasticity .or. hyperelasticity) then do i = 1, stress_idx%end - stress_idx%beg + 1 if (prim_vars_wrt) then q_sf = q_prim_vf(i - 1 + stress_idx%beg)%sf( & -offset_x%beg:m + offset_x%end, & -offset_y%beg:n + offset_y%end, & -offset_z%beg:p + offset_z%end) - - write (varname, '(A,I0)') 'tau', i + if (hypoelasticity) then + write (varname, '(A,I0)') 'tau', i + else + write (varname, '(A,I0)') 'xi', i + end if call s_write_variable_to_formatted_database_file(varname, t_step) - end if + end if varname(:) = ' ' end do end if - ! ---------------------------------------------------------------------- + ! ---------------------------------------------------------------------- ! Adding the pressure to the formatted database file ------------------- if (pres_wrt .or. prim_vars_wrt) then From d191aafd9fc67689b1f2f059b86ef2855d1c5ad5 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 12 May 2024 16:03:50 -0500 Subject: [PATCH 077/380] added error flag for R0ref --- src/pre_process/m_checker.f90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/pre_process/m_checker.f90 b/src/pre_process/m_checker.f90 index 8218310b9f..2125dd5799 100644 --- a/src/pre_process/m_checker.f90 +++ b/src/pre_process/m_checker.f90 @@ -115,6 +115,11 @@ subroutine s_check_inputs() 'exiting ...') end if + if (pre_stress .and. R0ref == dflt_int) then + call s_mpi_abort('pre_stress hyperelasticity requires R0ref'// & + 'exiting ...') + end if + ! phase change checkers. if (relax) then if (model_eqns /= 3) then From b5ea413da58dd777818e947a5ae724908c8932fe Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Sun, 12 May 2024 22:24:22 -0500 Subject: [PATCH 078/380] debugging hyperelasticity for pre and post-process, compiles --- src/common/m_variables_conversion.fpp | 7 ++++--- src/post_process/m_start_up.f90 | 9 ++++++--- src/pre_process/m_assign_variables.f90 | 24 +++++++++++++++++------- src/pre_process/m_checker.f90 | 12 +++++++++--- 4 files changed, 36 insertions(+), 16 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 593b656811..af9ed5d7ed 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1043,13 +1043,14 @@ contains end do end if - if (hyperelasticity .and. .not. bubbles .and. G_K > 100 ) then + if ( hyperelasticity .and. .not. bubbles) then ! .and. G_K > 100 ) then !$acc loop seq do i = strxb, strxe qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & /rho_K + !if (proc_rank == 0) print *, 'q(',i,') :: ',qK_prim_vf(i)%sf(j, k, l) end do - + !if (proc_rank == 0) stop !call s_calculate_btensor(qK_prim_vf, j, k, l, qK_btensor_vf) qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & @@ -1057,7 +1058,7 @@ contains else ! Mostly in the non-solid material - qK_btensor_vf(:)%sf(j,k,l) = 0d0 + !qK_btensor_vf(:)%sf(j,k,l) = 0d0 end if diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 2eb9234e98..a69ba333db 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -155,11 +155,13 @@ subroutine s_perform_time_step(t_step) ! Populating the buffer regions of the conservative variables if (buff_size > 0) then - call s_populate_conservative_variables_buffer_regions() + call s_populate_conservative_variables_buffer_regions() end if - + !if (proc_rank == 0) print *, "I got here 1" ! Converting the conservative variables to the primitive ones call s_convert_conservative_to_primitive_variables(q_cons_vf, q_prim_vf) + !if (proc_rank == 0) print *, "I got here 2" + end subroutine s_perform_time_step subroutine s_save_data(t_step, varname, pres, c, H) @@ -311,7 +313,7 @@ subroutine s_save_data(t_step, varname, pres, c, H) end if ! ---------------------------------------------------------------------- - + !if (proc_rank == 0) print *, "I got here 3" ! Adding the elastic shear stresses to the formatted database file ----- if (hypoelasticity .or. hyperelasticity) then do i = 1, stress_idx%end - stress_idx%beg + 1 @@ -330,6 +332,7 @@ subroutine s_save_data(t_step, varname, pres, c, H) varname(:) = ' ' end do end if + !if (proc_rank == 0) print *, "I got here 4" ! ---------------------------------------------------------------------- ! Adding the pressure to the formatted database file ------------------- diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 index dec98d03ff..c0c359c7a2 100644 --- a/src/pre_process/m_assign_variables.f90 +++ b/src/pre_process/m_assign_variables.f90 @@ -443,10 +443,12 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & end if ! Elastic Shear Stress - if (hyperelasticity) then - xi_cart(1) = x_cc(j) - xi_cart(2) = y_cc(k) - xi_cart(3) = z_cc(l) + !if(proc_rank == 0) print *, 'I got to before hyperelasticity for patch :: ', patch_id + if (hyperelasticity) then + !if (proc_rank ==0) print *, 'x ::', x_cc(j), 'y ::', y_cc(k), 'z ::', z_cc(l) + xi_cart(1) = x_cc(j) + xi_cart(2) = y_cc(k) + xi_cart(3) = z_cc(l) if (pre_stress) then ! pre stressed initial condition in spatial domain rcoord = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2)) phi = atan2(y_cc(k), x_cc(j)) @@ -457,10 +459,18 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & xi_cart(3) = xi_sph*cos(theta) end if do i = 1, (stress_idx%end - stress_idx%beg) + 1 - q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = & - (eta*xi_cart(i) + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1)) + q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = xi_cart(i) + !(eta*xi_cart(i) + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1)) + + !if (proc_rank ==0) print *, 'q(',i') ::', q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) + !if (proc_rank == 0) then + ! write(*,*) 'q(',i,') :: ',q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l)& + ! ,', xi_cart :: ',xi_cart(i) + !end if end do - end if + end if + !if (proc_rank ==0) stop + !if(proc_rank == 0) print *, 'I got to after hyperelasticity for patch :: ', patch_id if (mpp_lim .and. bubbles) then !adjust volume fractions, according to modeled gas void fraction diff --git a/src/pre_process/m_checker.f90 b/src/pre_process/m_checker.f90 index 2125dd5799..1208fd0f3d 100644 --- a/src/pre_process/m_checker.f90 +++ b/src/pre_process/m_checker.f90 @@ -120,7 +120,7 @@ subroutine s_check_inputs() 'exiting ...') end if - ! phase change checkers. + ! phase change checkers. if (relax) then if (model_eqns /= 3) then call s_mpi_abort('phase change requires model_eqns = 3. '// & @@ -715,8 +715,14 @@ subroutine s_check_inputs() call s_mpi_abort('Unsupported value of '// & 'fluid_pp('//trim(iStr)//')%'// & 'cv. Make sure cv is positive. Exiting ...') - end if - + elseif (hyperelasticity .or. hypoelasticity & + .and. & + fluid_pp(i)%G /= dflt_real) then + call s_mpi_abort('Unsupported combination '// & + 'of values of model_eqns '// & + 'and fluid_pp('//trim(iStr)//')%'// & + 'hyperelasticity. Exiting ...') + end if end do ! Moving Boundaries Checks: x boundaries From 39ec6e8faef160be668c49819eecfdb9b848c579 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Mon, 13 May 2024 15:16:47 -0500 Subject: [PATCH 079/380] added mach number ouput capability in the energy code, not working yet. --- src/post_process/m_data_output.fpp | 124 +++++++++++++++++++++-------- 1 file changed, 93 insertions(+), 31 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 6abb5ea118..496411272a 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -16,13 +16,13 @@ module m_data_output use m_global_parameters ! Global parameters for the code + use m_derived_variables !< Procedures used to compute quantities derived + use m_mpi_proxy ! Message passing interface (MPI) module proxy use m_compile_specific use m_helper - - use m_mpi_common ! ========================================================================== implicit none @@ -993,14 +993,24 @@ contains allocate (x_d1(m*n)) allocate (y_d1(m*n)) counter = 0 - maxalph_loc = maxval(q_prim_vf(E_idx + 2)%sf(:,:,:)) + maxalph_loc = 0d0 + do k = 0, p + do j = 0, n + do i = 0, m + if (q_prim_vf(E_idx + 2)%sf(i, j, k) > maxalph_loc) then + maxalph_loc = q_prim_vf(E_idx + 2)%sf(i, j, k) + end if + end do + end do + end do + call s_mpi_allreduce_max(maxalph_loc, maxalph_glb) do l = 0, p if (z_cc(l) < dz(l) .and. z_cc(l) >= 0) then cent = l end if end do - thres = 0.75d0*maxalph_glb + thres = 0.6d0*maxalph_glb do k = 0, n OLoop: do j = 0, m axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) @@ -1015,10 +1025,10 @@ contains x_d1(counter) = x_cc(j) y_d1(counter) = y_cc(k) euc_d = sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2) - tgp = 2*sqrt(dx(j)**2 + dy(k)**2) + tgp = sqrt(dx(j)**2 + dy(k)**2) else do i = 1, counter - if (euc_d <= tgp) then + if (euc_d <= tgp .or. x_cc(j) == x_d1(i) .or. y_cc(k) == y_d1(i)) then cycle OLoop elseif (euc_d > tgp .and. i == counter .and. x_cc(j) < 1.5 .and. y_cc(k) < 1.5) then !artificial bounding on the interface for bubble at a centroid. @@ -1060,21 +1070,33 @@ contains type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer, intent(IN) :: t_step real(kind(0d0)) :: Elk, Egk, Elint, Egint, Vb, maxalph_loc, maxalph_glb - real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, thres + real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, thres, MaxMa, MaxMa_glb, maxvel, c1, c2, c, crat, Ma, H real(kind(0d0)), dimension(num_dims) :: vel - real(kind(0d0)), dimension(num_fluids) :: gammas, pi_infs + real(kind(0d0)), dimension(num_fluids) :: gammas, pi_infs, adv integer :: i, j, k, l, s !looping indicies integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations - - maxalph_loc = maxval(q_prim_vf(E_idx + 2)%sf(:,:,:)) + + maxalph_loc = 0d0 + do k = 0, p + do j = 0, n + do i = 0, m + if (q_prim_vf(E_idx + 2)%sf(i, j, k) > maxalph_loc) then + maxalph_loc = q_prim_vf(E_idx + 2)%sf(i, j, k) + end if + end do + end do + end do + call s_mpi_allreduce_max(maxalph_loc, maxalph_glb) - thres = 0.75d0*maxalph_glb + thres = 0.6d0*maxalph_glb Elk = 0d0 Egk = 0d0 Elint = 0d0 Egint = 0d0 Vb = 0d0 + maxvel = 0d0 + MaxMa = 0d0 if (p > 0) then do k = 0, p do j = 0, n @@ -1084,32 +1106,71 @@ contains rho = 0d0 gamma = 0d0 pi_inf = 0d0 - do l = 1, num_fluids - gammas(l) = fluid_pp(l)%gamma - pi_infs(l) = fluid_pp(l)%pi_inf - rho = rho + q_prim_vf(E_idx + l)%sf(i, j, k)*q_prim_vf(l)%sf(i, j, k) - gamma = gamma + q_prim_vf(E_idx + l)%sf(i, j, k)*gammas(l) - pi_inf = pi_inf + q_prim_vf(E_idx + l)%sf(i, j, k)*pi_infs(l) - end do pres = q_prim_vf(E_idx)%sf(i, j, k) + Elint = Elint + q_prim_vf(E_idx+1)%sf(i, j, k)*(fluid_pp(1)%gamma*pres+fluid_pp(1)%pi_inf)*dV + Egint = Egint + q_prim_vf(E_idx+2)%sf(i, j, k)*(fluid_pp(2)%gamma*pres+fluid_pp(2)%pi_inf)*dV do s = 1, num_dims vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) - if (q_prim_vf(E_idx+2)%sf(i, j, k) > thres) then - Egk = Egk + 0.5d0*rho*vel(s)*vel(s)*dV - else - Elk = Elk + 0.5d0*rho*vel(s)*vel(s)*dV - end if + Egk = Egk + 0.5d0*q_prim_vf(E_idx + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV + Elk = Elk + 0.5d0*q_prim_vf(E_idx + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV + if (dabs(vel(s)) .gt. maxvel) then + maxvel = dabs(vel(s)) + endif end do - if (q_prim_vf(E_idx+2)%sf(i, j, k) > thres) then - Egint = Egint + (gamma*pres + pi_inf)*dV - Vb = Vb + dV - else - Elint = Elint + (gamma*pres + pi_inf)*dV - end if + do l = 1, adv_idx%end - E_idx + adv(l) = q_prim_vf(E_idx + l)%sf(i, j, k) + gamma = gamma+ adv(l)*fluid_pp(l)%gamma + pi_inf = pi_inf + adv(l)*fluid_pp(l)%pi_inf + rho = rho + adv(l)*q_prim_vf(l)%sf(i, j, k) + end do + + H = ((gamma + 1d0)*pres + pi_inf)/rho + + call s_compute_speed_of_sound(pres, rho, & + gamma, pi_inf, & + H, adv, 0d0, c) + + ! c1 = dsqrt((1/fluid_pp(1)%gamma+1)*(pres+fluid_pp(1)%pi_inf)/q_prim_vf(1)%sf(i, j, k)) + ! c2 = dsqrt((1/fluid_pp(2)%gamma+1)*(pres+fluid_pp(2)%pi_inf)/q_prim_vf(2)%sf(i, j, k)) + ! crat = q_prim_vf(E_idx+1)%sf(i, j, k)/(q_prim_vf(1)%sf(i, j, k)*c1**2.0d0) + & + ! q_prim_vf(E_idx+2)%sf(i, j, k)/(q_prim_vf(2)%sf(i, j, k)*c2**2.0d0) + ! rho = q_prim_vf(E_idx + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k) + & + ! q_prim_vf(E_idx + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k) + ! c = dsqrt(1/(crat*rho)) + Ma = maxvel/c + if (Ma > MaxMa) then + MaxMa = Ma + endif + if (q_prim_vf(E_idx + 2)%sf(i, j, k) > thres) then + Vb = Vb + dV + endif +! do l = 1, num_fluids +! gammas(l) = fluid_pp(l)%gamma +! pi_infs(l) = fluid_pp(l)%pi_inf +! rho = rho + q_prim_vf(E_idx + l)%sf(i, j, k)*q_prim_vf(l)%sf(i, j, k) +! gamma = gamma + q_prim_vf(E_idx + l)%sf(i, j, k)*gammas(l) +! pi_inf = pi_inf + q_prim_vf(E_idx + l)%sf(i, j, k)*pi_infs(l) +! end do +! pres = q_prim_vf(E_idx)%sf(i, j, k) +! do s = 1, num_dims +! vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) +! if (q_prim_vf(E_idx+2)%sf(i, j, k) > thres) then +! Egk = Egk + 0.5d0*rho*vel(s)*vel(s)*dV +! else +! Elk = Elk + 0.5d0*rho*vel(s)*vel(s)*dV +! end if +! end do +! if (q_prim_vf(E_idx+2)%sf(i, j, k) > thres) then +! Egint = Egint + (gamma*pres + pi_inf)*dV +! Vb = Vb + dV +! else +! Elint = Elint + (gamma*pres + pi_inf)*dV +! end if end do end do end do end if + call s_mpi_allreduce_max(MaxMa, MaxMa_glb) tmp = Elk call s_mpi_allreduce_sum(tmp, Elk) tmp = Elint @@ -1121,12 +1182,13 @@ contains tmp = Vb call s_mpi_allreduce_sum(tmp, Vb) if (proc_rank == 0) then - write (251, '(6X, 5F24.12)') & + write (251, '(6X, 6F24.12)') & Elint, & Egint, & Elk, & Egk, & - Vb + Vb, & + MaxMa_glb end if end subroutine s_write_energy_data_file From cdc2ef2d5858fa4202a044152de1d47ffdf0ee31 Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Tue, 14 May 2024 23:01:17 -0500 Subject: [PATCH 080/380] debugged pre_process, I think --- src/common/m_rmt_tensor_calc.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/common/m_rmt_tensor_calc.f90 b/src/common/m_rmt_tensor_calc.f90 index 15405432f5..2d030eba02 100644 --- a/src/common/m_rmt_tensor_calc.f90 +++ b/src/common/m_rmt_tensor_calc.f90 @@ -57,7 +57,7 @@ function f_determinant(tensor) real(kind(0d0)) :: f_determinant if (num_dims == 1) then - f_determinant = tensor(1) ! TODO: Mirelys: does this make sense? + f_determinant = tensor(1) elseif (num_dims == 2) then f_determinant = tensor(1)*tensor(4) - tensor(2)*tensor(3) else @@ -103,7 +103,7 @@ subroutine s_calculate_atransposea(tensor, ata) real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ata - ata(1) = tensor(1)**2 ! TODO: Mirelys: Does this make sense? + ata(1) = tensor(1)**2 if (num_dims == 2) then ata(1) = ata(1) + tensor(3)**2 ata(2) = tensor(1)*tensor(2) + tensor(3)*tensor(4) From cea0d6ab09789415bb2dc65562af96c5d7eaca68 Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Tue, 14 May 2024 23:02:42 -0500 Subject: [PATCH 081/380] this time, pre_process debugged --- src/pre_process/m_assign_variables.f90 | 34 ++++++++++++-------------- src/pre_process/m_checker.f90 | 16 ++++++------ src/simulation/m_time_steppers.fpp | 5 ++-- 3 files changed, 26 insertions(+), 29 deletions(-) diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 index c0c359c7a2..372bc537d0 100644 --- a/src/pre_process/m_assign_variables.f90 +++ b/src/pre_process/m_assign_variables.f90 @@ -443,23 +443,21 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & end if ! Elastic Shear Stress - !if(proc_rank == 0) print *, 'I got to before hyperelasticity for patch :: ', patch_id - if (hyperelasticity) then - !if (proc_rank ==0) print *, 'x ::', x_cc(j), 'y ::', y_cc(k), 'z ::', z_cc(l) - xi_cart(1) = x_cc(j) - xi_cart(2) = y_cc(k) - xi_cart(3) = z_cc(l) - if (pre_stress) then ! pre stressed initial condition in spatial domain - rcoord = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2)) - phi = atan2(y_cc(k), x_cc(j)) - theta = atan2(sqrt(x_cc(j)**2 + y_cc(k)**2), z_cc(l)) - xi_sph = (rcoord**3 - R0ref**3 + 1)**( 1d0 / 3d0 ) !spherical coord, assuming Rmax=1 - xi_cart(1) = xi_sph*sin(theta)*cos(phi) - xi_cart(2) = xi_sph*sin(theta)*sin(phi) - xi_cart(3) = xi_sph*cos(theta) - end if - do i = 1, (stress_idx%end - stress_idx%beg) + 1 - q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = xi_cart(i) + if (hyperelasticity) then + xi_cart(1) = x_cc(j) + xi_cart(2) = y_cc(k) + xi_cart(3) = z_cc(l) + if (pre_stress) then ! pre stressed initial condition in spatial domain + rcoord = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2)) + theta = atan2(y_cc(k), x_cc(j)) + phi = atan2(sqrt(x_cc(j)**2 + y_cc(k)**2), z_cc(l)) + xi_sph = (rcoord**3 - R0ref**3 + 1d0 )**( 1d0 / 3d0 ) !spherical coord, assuming Rmax=1 + xi_cart(1) = xi_sph*sin(phi)*cos(theta) + xi_cart(2) = xi_sph*sin(phi)*sin(theta) + xi_cart(3) = xi_sph*cos(phi) + end if + do i = 1, (stress_idx%end - stress_idx%beg) + 1 + q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = xi_cart(i) !(eta*xi_cart(i) + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1)) !if (proc_rank ==0) print *, 'q(',i') ::', q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) @@ -467,7 +465,7 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & ! write(*,*) 'q(',i,') :: ',q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l)& ! ,', xi_cart :: ',xi_cart(i) !end if - end do + end do end if !if (proc_rank ==0) stop !if(proc_rank == 0) print *, 'I got to after hyperelasticity for patch :: ', patch_id diff --git a/src/pre_process/m_checker.f90 b/src/pre_process/m_checker.f90 index 1208fd0f3d..25b2fd5f34 100644 --- a/src/pre_process/m_checker.f90 +++ b/src/pre_process/m_checker.f90 @@ -715,14 +715,14 @@ subroutine s_check_inputs() call s_mpi_abort('Unsupported value of '// & 'fluid_pp('//trim(iStr)//')%'// & 'cv. Make sure cv is positive. Exiting ...') - elseif (hyperelasticity .or. hypoelasticity & - .and. & - fluid_pp(i)%G /= dflt_real) then - call s_mpi_abort('Unsupported combination '// & - 'of values of model_eqns '// & - 'and fluid_pp('//trim(iStr)//')%'// & - 'hyperelasticity. Exiting ...') - end if + ! elseif ((hyperelasticity .or. hypoelasticity) & + ! .and. & + ! fluid_pp(i)%G /= dflt_real) then + ! call s_mpi_abort('Unsupported combination '// & + ! 'of values of model_eqns '// & + ! 'and fluid_pp('//trim(iStr)//')%'// & + ! 'hyperelasticity. Exiting ...') + end if end do ! Moving Boundaries Checks: x boundaries diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 41c308ee4f..c645d5efa4 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -179,8 +179,7 @@ contains end if end if - if (hypoelasticity) then - + if (hypoelasticity .or. hyperelasticity) then do i = stress_idx%beg, stress_idx%end @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & iy_t%beg:iy_t%end, & @@ -986,7 +985,7 @@ contains @:DEALLOCATE(q_prim_vf(i)%sf) end do - if (hypoelasticity) then + if (hypoelasticity .or. hyperelasticity) then do i = stress_idx%beg, stress_idx%end @:DEALLOCATE(q_prim_vf(i)%sf) end do From bc2bacda6fac6b6fe420b1e4db80d11fd4cd3e29 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Wed, 15 May 2024 19:08:18 -0500 Subject: [PATCH 082/380] trying to debug energy ouputting code --- src/post_process/m_data_output.fpp | 80 ++++++++---------------------- submit_gpu.sh | 20 ++++++-- 2 files changed, 37 insertions(+), 63 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 496411272a..2f404befcf 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -1069,34 +1069,21 @@ contains subroutine s_write_energy_data_file(q_prim_vf, t_step) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer, intent(IN) :: t_step - real(kind(0d0)) :: Elk, Egk, Elint, Egint, Vb, maxalph_loc, maxalph_glb - real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, thres, MaxMa, MaxMa_glb, maxvel, c1, c2, c, crat, Ma, H + real(kind(0d0)) :: Elk, Egk, Elint, Egint, Vb, Vl, pres_av + real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, MaxMa, MaxMa_glb, maxvel, c, Ma, H real(kind(0d0)), dimension(num_dims) :: vel real(kind(0d0)), dimension(num_fluids) :: gammas, pi_infs, adv integer :: i, j, k, l, s !looping indicies integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations - - maxalph_loc = 0d0 - do k = 0, p - do j = 0, n - do i = 0, m - if (q_prim_vf(E_idx + 2)%sf(i, j, k) > maxalph_loc) then - maxalph_loc = q_prim_vf(E_idx + 2)%sf(i, j, k) - end if - end do - end do - end do - - call s_mpi_allreduce_max(maxalph_loc, maxalph_glb) - thres = 0.6d0*maxalph_glb - - Elk = 0d0 + Egk = 0d0 Elint = 0d0 Egint = 0d0 Vb = 0d0 maxvel = 0d0 MaxMa = 0d0 + Vl = 0d0 + Elk = 0d0 if (p > 0) then do k = 0, p do j = 0, n @@ -1107,12 +1094,11 @@ contains gamma = 0d0 pi_inf = 0d0 pres = q_prim_vf(E_idx)%sf(i, j, k) - Elint = Elint + q_prim_vf(E_idx+1)%sf(i, j, k)*(fluid_pp(1)%gamma*pres+fluid_pp(1)%pi_inf)*dV - Egint = Egint + q_prim_vf(E_idx+2)%sf(i, j, k)*(fluid_pp(2)%gamma*pres+fluid_pp(2)%pi_inf)*dV + Egint = Egint + q_prim_vf(E_idx+2)%sf(i, j, k)**2.0d0*(fluid_pp(2)%gamma*pres)*dV do s = 1, num_dims vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) - Egk = Egk + 0.5d0*q_prim_vf(E_idx + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV - Elk = Elk + 0.5d0*q_prim_vf(E_idx + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV + Egk = Egk + 0.5d0*q_prim_vf(E_idx + 2)%sf(i, j, k)**2.0d0*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV + Elk = Elk + 0.5d0*q_prim_vf(E_idx + 1)%sf(i, j, k)**2.0d0*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV if (dabs(vel(s)) .gt. maxvel) then maxvel = dabs(vel(s)) endif @@ -1130,64 +1116,42 @@ contains gamma, pi_inf, & H, adv, 0d0, c) - ! c1 = dsqrt((1/fluid_pp(1)%gamma+1)*(pres+fluid_pp(1)%pi_inf)/q_prim_vf(1)%sf(i, j, k)) - ! c2 = dsqrt((1/fluid_pp(2)%gamma+1)*(pres+fluid_pp(2)%pi_inf)/q_prim_vf(2)%sf(i, j, k)) - ! crat = q_prim_vf(E_idx+1)%sf(i, j, k)/(q_prim_vf(1)%sf(i, j, k)*c1**2.0d0) + & - ! q_prim_vf(E_idx+2)%sf(i, j, k)/(q_prim_vf(2)%sf(i, j, k)*c2**2.0d0) - ! rho = q_prim_vf(E_idx + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k) + & - ! q_prim_vf(E_idx + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k) - ! c = dsqrt(1/(crat*rho)) Ma = maxvel/c - if (Ma > MaxMa) then + if (Ma > MaxMa .and. adv(1) > 1.0d0-0.5d-6) then MaxMa = Ma endif - if (q_prim_vf(E_idx + 2)%sf(i, j, k) > thres) then - Vb = Vb + dV - endif -! do l = 1, num_fluids -! gammas(l) = fluid_pp(l)%gamma -! pi_infs(l) = fluid_pp(l)%pi_inf -! rho = rho + q_prim_vf(E_idx + l)%sf(i, j, k)*q_prim_vf(l)%sf(i, j, k) -! gamma = gamma + q_prim_vf(E_idx + l)%sf(i, j, k)*gammas(l) -! pi_inf = pi_inf + q_prim_vf(E_idx + l)%sf(i, j, k)*pi_infs(l) -! end do -! pres = q_prim_vf(E_idx)%sf(i, j, k) -! do s = 1, num_dims -! vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) -! if (q_prim_vf(E_idx+2)%sf(i, j, k) > thres) then -! Egk = Egk + 0.5d0*rho*vel(s)*vel(s)*dV -! else -! Elk = Elk + 0.5d0*rho*vel(s)*vel(s)*dV -! end if -! end do -! if (q_prim_vf(E_idx+2)%sf(i, j, k) > thres) then -! Egint = Egint + (gamma*pres + pi_inf)*dV -! Vb = Vb + dV -! else -! Elint = Elint + (gamma*pres + pi_inf)*dV -! end if + Vl = Vl + adv(1)*dV + Vb = Vb + adv(2)*dV + pres_av = pres_av + adv(1)**2.0d0*pres*dV end do end do end do end if + tmp = pres_av + call s_mpi_allreduce_sum(tmp, pres_av) + tmp = Vl + call s_mpi_allreduce_sum(tmp, Vl) + call s_mpi_allreduce_max(MaxMa, MaxMa_glb) tmp = Elk call s_mpi_allreduce_sum(tmp, Elk) - tmp = Elint - call s_mpi_allreduce_sum(tmp, Elint) tmp = Egint call s_mpi_allreduce_sum(tmp, Egint) tmp = Egk call s_mpi_allreduce_sum(tmp, Egk) tmp = Vb call s_mpi_allreduce_sum(tmp, Vb) + + Elint = pres_av/Vl*Vb + if (proc_rank == 0) then - write (251, '(6X, 6F24.12)') & + write (251, '(6X, 7F24.12)') & Elint, & Egint, & Elk, & Egk, & Vb, & + Vl, & MaxMa_glb end if diff --git a/submit_gpu.sh b/submit_gpu.sh index c03eff7bcc..21284621ba 100755 --- a/submit_gpu.sh +++ b/submit_gpu.sh @@ -1,7 +1,17 @@ -#./mfc.sh run /scratch/bciv/sremillard/sph_col_32/3Dshinput_new.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 1:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta ## Pre-process -./mfc.sh run /scratch/bciv/sremillard/sph_col_2atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# sph2 -t pre_process -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/sremillard/sph_col_5atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# sph5 -t pre_process -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/sremillard/pert_col_2atm_tenth/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# base -t pre_process -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/sremillard/sph_col_1atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# sph_1 -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/sph_col_2atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# sph2 -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/sph_col_50atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 1:00:00 -# sph50 -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/sph_col_20atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 1:00:00 -# sph20 -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/sph_col_10atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 1:00:00 -# sph10 -t pre_process -a bciv-delta-gpu -c delta + +#./mfc.sh run /scratch/bciv/sremillard/pert_col_2atm_tenth/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# base -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/sph_col_1atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# sph_1 -t pre_process -a bciv-delta-gpu -c delta + + +## simulation +./mfc.sh run /scratch/bciv/sremillard/sph_col_50atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 5:30:00 -# sph50 -t simulation -a bciv-delta-gpu -c delta +./mfc.sh run /scratch/bciv/sremillard/sph_col_20atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 5:30:00 -# sph20 -t simulation -a bciv-delta-gpu -c delta +./mfc.sh run /scratch/bciv/sremillard/sph_col_10atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 5:30:00 -# sph10 -t simulation -a bciv-delta-gpu -c delta + + From 43ee8c98b1ccb60b64cc27db4268722ff00e5b89 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Wed, 15 May 2024 19:09:44 -0500 Subject: [PATCH 083/380] most likely is the correct energy - caution --- src/post_process/m_data_output.fpp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 2f404befcf..f99452147c 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -1094,11 +1094,11 @@ contains gamma = 0d0 pi_inf = 0d0 pres = q_prim_vf(E_idx)%sf(i, j, k) - Egint = Egint + q_prim_vf(E_idx+2)%sf(i, j, k)**2.0d0*(fluid_pp(2)%gamma*pres)*dV + Egint = Egint + q_prim_vf(E_idx+2)%sf(i, j, k)*(fluid_pp(2)%gamma*pres)*dV do s = 1, num_dims vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) - Egk = Egk + 0.5d0*q_prim_vf(E_idx + 2)%sf(i, j, k)**2.0d0*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV - Elk = Elk + 0.5d0*q_prim_vf(E_idx + 1)%sf(i, j, k)**2.0d0*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV + Egk = Egk + 0.5d0*q_prim_vf(E_idx + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV + Elk = Elk + 0.5d0*q_prim_vf(E_idx + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV if (dabs(vel(s)) .gt. maxvel) then maxvel = dabs(vel(s)) endif @@ -1122,7 +1122,7 @@ contains endif Vl = Vl + adv(1)*dV Vb = Vb + adv(2)*dV - pres_av = pres_av + adv(1)**2.0d0*pres*dV + pres_av = pres_av + adv(1)*pres*dV end do end do end do From 9b967727ab8b7032a97bc516bee0b162a47d9b0f Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Wed, 15 May 2024 21:23:29 -0500 Subject: [PATCH 084/380] switching the ma threshold --- src/post_process/m_data_output.fpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index f99452147c..4c9926e54a 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -1117,7 +1117,7 @@ contains H, adv, 0d0, c) Ma = maxvel/c - if (Ma > MaxMa .and. adv(1) > 1.0d0-0.5d-6) then + if (Ma > MaxMa .and. adv(1) > 1.0d0-1.0d-6) then MaxMa = Ma endif Vl = Vl + adv(1)*dV From 6fb0ecdf4fe495852965ed2a5e2104fe55f81f69 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 15 May 2024 22:03:49 -0500 Subject: [PATCH 085/380] additions including the start of the btensor calculation, compiles but not tested --- src/common/m_rmt_tensor_calc.f90 | 150 ++++++++++++++++++++++++- src/common/m_variables_conversion.fpp | 8 +- src/simulation/m_global_parameters.fpp | 20 ++-- src/simulation/m_rhs.fpp | 13 +-- src/simulation/m_start_up.fpp | 1 - 5 files changed, 163 insertions(+), 29 deletions(-) diff --git a/src/common/m_rmt_tensor_calc.f90 b/src/common/m_rmt_tensor_calc.f90 index 15405432f5..e1201e1ff7 100644 --- a/src/common/m_rmt_tensor_calc.f90 +++ b/src/common/m_rmt_tensor_calc.f90 @@ -1,6 +1,7 @@ !> !! @file m_variables_conversion.f90 !! @brief Contains module m_variables_conversion +#:include 'macros.fpp' !> @brief This module consists of subroutines used in the calculation of matrix !! operations for the reference map tensor @@ -23,6 +24,21 @@ module m_rmt_tensor_calc f_elastic_energy, & s_calculate_deviatoric +#ifdef CRAY_ACC_WAR + + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), du_dx, du_dy, du_dz) + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), dv_dx, dv_dy, dv_dz) + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), dw_dx, dw_dy, dw_dz) + !$acc declare link(du_dx,du_dy,du_dz,dv_dx,dv_dy,dv_dz,dw_dx,dw_dy,dw_dz) +#else + + real(kind(0d0)), allocatable, dimension(:, :, :) :: du_dx, du_dy, du_dz + real(kind(0d0)), allocatable, dimension(:, :, :) :: dv_dx, dv_dy, dv_dz + real(kind(0d0)), allocatable, dimension(:, :, :) :: dw_dx, dw_dy, dw_dz + !$acc declare create(du_dx,du_dy,du_dz,dv_dx,dv_dy,dv_dz,dw_dx,dw_dy,dw_dz) + +#endif + contains subroutine s_calculate_btensor(q_prim_vf, j, k, l, btensor) @@ -31,13 +47,17 @@ subroutine s_calculate_btensor(q_prim_vf, j, k, l, btensor) type(scalar_field), dimension(num_dims*(num_dims+1)/2 + 1), intent(OUT) :: btensor integer, intent(IN) :: j, k, l - real(kind(0d0)), dimension(num_dims**2) :: ftensor, ftransposef, tensorb, tensor + real(kind(0d0)), dimension(num_dims**2) :: ftensor, ftransposef, tensorb + real(kind(0d0)), dimension(num_dims) :: xi_vec integer :: i !< Generic loop iterators - ! Converting the primitive variables to the conservative variables + ! building the xi vector do i = 1, num_dims - tensor(i) = q_prim_vf(stress_idx%beg + i - 1)%sf(j, k, l) + xi_vec(i) = q_prim_vf(stress_idx%beg + i - 1)%sf(j, k, l) end do + ! feed data into function to calculate the grad_xi + + ! NOTE: btensor is symmetric, save the data space ! need to calculate gradxi then calculate btensor and J = det(F) ! store in btensor @@ -183,4 +203,128 @@ function f_elastic_energy(btensor, j, k, l) end function f_elastic_energy + subroutine s_initialize_hypoelastic_module_b() ! -------------------- + + integer :: i + + !@:ALLOCATE_GLOBAL(du_dx(0:m,0:n,0:p)) + !if (n > 0) then + ! @:ALLOCATE_GLOBAL(du_dy(0:m,0:n,0:p), dv_dx(0:m,0:n,0:p), dv_dy(0:m,0:n,0:p)) + ! if (p > 0) then + ! @:ALLOCATE_GLOBAL(du_dz(0:m,0:n,0:p), dv_dz(0:m,0:n,0:p)) + ! @:ALLOCATE_GLOBAL(dw_dx(0:m,0:n,0:p), dw_dy(0:m,0:n,0:p), dw_dz(0:m,0:n,0:p)) + ! end if + !end if + + end subroutine s_initialize_hypoelastic_module_b + + !> The purpose of this procedure is to compute the source terms + !! that are needed for the elastic stress equations + !! @param idir Dimension splitting index + !! @param q_prim_vf Primitive variables + !! @param rhs_vf rhs variables + subroutine s_compute_grad_xi(idir, q_prim_vf, rhs_vf) + + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + type(scalar_field), dimension(sys_size), intent(INOUT) :: rhs_vf + integer, intent(IN) :: idir + + real(kind(0d0)) :: rho_K, G_K + + integer :: i, k, l, q !< Loop variables + integer :: ndirs !< Number of coordinate directions + + ndirs = 1; if (n > 0) ndirs = 2; if (p > 0) ndirs = 3 + + if (idir == 1) then + ! calculate velocity gradients + rho_K and G_K + ! TODO: re-organize these loops one by one for GPU efficiency if possible? + + !$acc parallel loop collapse(3) gang vector default(present) + do q = 0, p + do l = 0, n + do k = 0, m + du_dx(k, l, q) = & + (q_prim_vf(momxb)%sf(k - 2, l, q) & + - 8d0*q_prim_vf(momxb)%sf(k - 1, l, q) & + + 8d0*q_prim_vf(momxb)%sf(k + 1, l, q) & + - q_prim_vf(momxb)%sf(k + 2, l, q)) & + /(12d0*dx(k)) + end do + end do + end do + + if (ndirs > 1) then + !$acc parallel loop collapse(3) gang vector default(present) + do q = 0, p + do l = 0, n + do k = 0, m + du_dy(k, l, q) = & + (q_prim_vf(momxb)%sf(k, l - 2, q) & + - 8d0*q_prim_vf(momxb)%sf(k, l - 1, q) & + + 8d0*q_prim_vf(momxb)%sf(k, l + 1, q) & + - q_prim_vf(momxb)%sf(k, l + 2, q)) & + /(12d0*dy(l)) + dv_dx(k, l, q) = & + (q_prim_vf(momxb + 1)%sf(k - 2, l, q) & + - 8d0*q_prim_vf(momxb + 1)%sf(k - 1, l, q) & + + 8d0*q_prim_vf(momxb + 1)%sf(k + 1, l, q) & + - q_prim_vf(momxb + 1)%sf(k + 2, l, q)) & + /(12d0*dx(k)) + dv_dy(k, l, q) = & + (q_prim_vf(momxb + 1)%sf(k, l - 2, q) & + - 8d0*q_prim_vf(momxb + 1)%sf(k, l - 1, q) & + + 8d0*q_prim_vf(momxb + 1)%sf(k, l + 1, q) & + - q_prim_vf(momxb + 1)%sf(k, l + 2, q)) & + /(12d0*dy(l)) + end do + end do + end do + + ! 3D + if (ndirs == 3) then + !$acc parallel loop collapse(3) gang vector default(present) + do q = 0, p + do l = 0, n + do k = 0, m + du_dz(k, l, q) = & + (q_prim_vf(momxb)%sf(k, l, q - 2) & + - 8d0*q_prim_vf(momxb)%sf(k, l, q - 1) & + + 8d0*q_prim_vf(momxb)%sf(k, l, q + 1) & + - q_prim_vf(momxb)%sf(k, l, q + 2)) & + /(12d0*dz(q)) + dv_dz(k, l, q) = & + (q_prim_vf(momxb + 1)%sf(k, l, q - 2) & + - 8d0*q_prim_vf(momxb + 1)%sf(k, l, q - 1) & + + 8d0*q_prim_vf(momxb + 1)%sf(k, l, q + 1) & + - q_prim_vf(momxb + 1)%sf(k, l, q + 2)) & + /(12d0*dz(q)) + dw_dx(k, l, q) = & + (q_prim_vf(momxe)%sf(k - 2, l, q) & + - 8d0*q_prim_vf(momxe)%sf(k - 1, l, q) & + + 8d0*q_prim_vf(momxe)%sf(k + 1, l, q) & + - q_prim_vf(momxe)%sf(k + 2, l, q)) & + /(12d0*dx(k)) + dw_dy(k, l, q) = & + (q_prim_vf(momxe)%sf(k, l - 2, q) & + - 8d0*q_prim_vf(momxe)%sf(k, l - 1, q) & + + 8d0*q_prim_vf(momxe)%sf(k, l + 1, q) & + - q_prim_vf(momxe)%sf(k, l + 2, q)) & + /(12d0*dy(l)) + dw_dz(k, l, q) = & + (q_prim_vf(momxe)%sf(k, l, q - 2) & + - 8d0*q_prim_vf(momxe)%sf(k, l, q - 1) & + + 8d0*q_prim_vf(momxe)%sf(k, l, q + 1) & + - q_prim_vf(momxe)%sf(k, l, q + 2)) & + /(12d0*dz(q)) + end do + end do + end do + end if + end if + end if + + end subroutine s_compute_grad_xi + end module m_rmt_tensor_calc + diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index af9ed5d7ed..a981f509bd 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -874,7 +874,7 @@ contains type(int_bounds_info), optional, intent(IN) :: ix, iy, iz type(scalar_field), & - optional, dimension(num_dims**2), & + optional, dimension(num_dims*(num_dims+1)/2 + 1), & intent(OUT) :: qK_btensor_vf real(kind(0d0)), dimension(num_fluids) :: alpha_K, alpha_rho_K @@ -1023,7 +1023,7 @@ contains end if end if - if (hypoelasticity) then + if ( hypoelasticity .and. .not. bubbles ) then !$acc loop seq do i = strxb, strxe qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & @@ -1043,14 +1043,12 @@ contains end do end if - if ( hyperelasticity .and. .not. bubbles) then ! .and. G_K > 100 ) then + if ( hyperelasticity .and. .not. bubbles ) then ! .and. G_K > 100 ) then !$acc loop seq do i = strxb, strxe qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & /rho_K - !if (proc_rank == 0) print *, 'q(',i,') :: ',qK_prim_vf(i)%sf(j, k, l) end do - !if (proc_rank == 0) stop !call s_calculate_btensor(qK_prim_vf, j, k, l, qK_btensor_vf) qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 3a3d5434a2..b7638cd9c0 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -186,18 +186,19 @@ module m_global_parameters !> @name Annotations of the structure of the state and flux vectors in terms of the !! size and the configuration of the system of equations to which they belong !> @{ - integer :: sys_size !< Number of unknowns in system of eqns. + integer :: sys_size !< Number of unknowns in system of eqns. type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. type(int_bounds_info) :: mom_idx !< Indexes of first & last momentum eqns. - integer :: E_idx !< Index of energy equation - integer :: n_idx !< Index of number density + integer :: E_idx !< Index of energy equation + integer :: n_idx !< Index of number density type(int_bounds_info) :: adv_idx !< Indexes of first & last advection eqns. type(int_bounds_info) :: internalEnergies_idx !< Indexes of first & last internal energy eqns. - type(bub_bounds_info) :: bub_idx !< Indexes of first & last bubble variable eqns. - integer :: alf_idx !< Index of void fraction - integer :: gamma_idx !< Index of specific heat ratio func. eqn. - integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. + type(bub_bounds_info) :: bub_idx !< Indexes of first & last bubble variable eqns. + integer :: alf_idx !< Index of void fraction + integer :: gamma_idx !< Index of specific heat ratio func. eqn. + integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. type(int_bounds_info) :: stress_idx !< Indexes of first and last shear stress eqns. + integer :: b_size !< Number of elements in the symmetric b tensor !> @} !$acc declare create(bub_idx) @@ -250,7 +251,7 @@ module m_global_parameters integer :: startx, starty, startz - !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx) + !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx, b_size) ! END: Simulation Algorithm Parameters ===================================== @@ -788,6 +789,7 @@ contains stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + num_dims sys_size = stress_idx%end + b_size = (num_dims*(num_dims + 1))/2 end if else if (model_eqns == 3) then @@ -987,7 +989,7 @@ contains intxb = internalEnergies_idx%beg intxe = internalEnergies_idx%end - !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe) + !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe, b_size) !$acc update device(m, n, p) !$acc update device(alt_soundspeed, monopole, num_mono) diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 81ddb82105..d1ffcbd3c8 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -242,7 +242,7 @@ contains @:ALLOCATE(q_cons_qp%vf(1:sys_size)) @:ALLOCATE(q_prim_qp%vf(1:sys_size)) - @:ALLOCATE(q_btensor%vf(1:num_dims**2)) + @:ALLOCATE(q_btensor%vf(1:b_size)) do l = 1, sys_size @:ALLOCATE(q_cons_qp%vf(l)%sf(ix%beg:ix%end, iy%beg:iy%end, iz%beg:iz%end)) @@ -256,7 +256,7 @@ contains @:ALLOCATE(q_prim_qp%vf(l)%sf(ix%beg:ix%end, iy%beg:iy%end, iz%beg:iz%end)) end do - do l = 1, num_dims**2 + do l = 1, b_size @:ALLOCATE(q_btensor%vf(l)%sf(ix%beg:ix%end, iy%beg:iy%end, iz%beg:iz%end)) end do @@ -703,15 +703,6 @@ contains ! ================================================================== - ! Computing Btensor needed for conservative to primitive variables later == - - call nvtxStartRange("Hyperelasticity: Btensor") - ! create the Btensor and save in a large vector field - - call nvtxEndRange() - - ! ================================================================== - ! Converting Conservative to Primitive Variables ================== if (mpp_lim .and. bubbles) then diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 76299522da..8c9990f71b 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -46,7 +46,6 @@ module m_start_up use m_derived_variables !< Procedures used to compute quantities derived !! from the conservative and primitive variables - use m_hypoelastic use m_phase_change !< Phase-change module From d22db0051c565d65d62f80d10d54cb02d61232c2 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 16 May 2024 20:56:02 -0400 Subject: [PATCH 086/380] added btensor calc, testing compilation --- src/common/m_rmt_tensor_calc.f90 | 262 ++++++++++-------------- src/common/test.f90 | 80 ++++++++ src/pre_process/m_global_parameters.fpp | 1 + 3 files changed, 187 insertions(+), 156 deletions(-) create mode 100644 src/common/test.f90 diff --git a/src/common/m_rmt_tensor_calc.f90 b/src/common/m_rmt_tensor_calc.f90 index 612aeec6ae..51fa19c27a 100644 --- a/src/common/m_rmt_tensor_calc.f90 +++ b/src/common/m_rmt_tensor_calc.f90 @@ -1,7 +1,7 @@ !> !! @file m_variables_conversion.f90 !! @brief Contains module m_variables_conversion -#:include 'macros.fpp' +!#:include 'macros.fpp' !> @brief This module consists of subroutines used in the calculation of matrix !! operations for the reference map tensor @@ -26,49 +26,47 @@ module m_rmt_tensor_calc #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), du_dx, du_dy, du_dz) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), dv_dx, dv_dy, dv_dz) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), dw_dx, dw_dy, dw_dz) - !$acc declare link(du_dx,du_dy,du_dz,dv_dx,dv_dy,dv_dz,dw_dx,dw_dy,dw_dz) + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), grad_xi) + !$acc declare link(grad_xi) #else - real(kind(0d0)), allocatable, dimension(:, :, :) :: du_dx, du_dy, du_dz - real(kind(0d0)), allocatable, dimension(:, :, :) :: dv_dx, dv_dy, dv_dz - real(kind(0d0)), allocatable, dimension(:, :, :) :: dw_dx, dw_dy, dw_dz - !$acc declare create(du_dx,du_dy,du_dz,dv_dx,dv_dy,dv_dz,dw_dx,dw_dy,dw_dz) + real(kind(0d0)), allocatable, dimension(:) :: grad_xi + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz + !$acc declare create(grad_xi) #endif contains subroutine s_calculate_btensor(q_prim_vf, j, k, l, btensor) - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf type(scalar_field), dimension(num_dims*(num_dims+1)/2 + 1), intent(OUT) :: btensor integer, intent(IN) :: j, k, l - - real(kind(0d0)), dimension(num_dims**2) :: ftensor, ftransposef, tensorb - real(kind(0d0)), dimension(num_dims) :: xi_vec - integer :: i !< Generic loop iterators - - ! building the xi vector - do i = 1, num_dims - xi_vec(i) = q_prim_vf(stress_idx%beg + i - 1)%sf(j, k, l) - end do - ! feed data into function to calculate the grad_xi - - - ! NOTE: btensor is symmetric, save the data space - ! need to calculate gradxi then calculate btensor and J = det(F) - ! store in btensor - - ! extracting the nxn tensor for the calculation - !do i = 1, num_dims**2 - ! ftensor(i) = gradxitensor(i)%sf(j, k, l) - !end do - !call s_calculate_atransposea(ftensor,ftransposef) - !call s_calculate_ainverse(ftransposef,btensor) - !jacobian = f_determinant(ftensor) + real(kind(0d0)), dimension(num_dims**2) :: grad_xi, ftensor, tensorb + + ! calculate the grad_xi, grad_xi is a nxn tensor + call s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) + ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + call s_calculate_ainverse(grad_xi,ftensor) + ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + call s_calculate_atransposea(ftensor,tensorb) + ! btensor is symmetric, save the data space + ! 1: 1D, 3: 2D, 6: 3D + btensor(1)%sf(j,k,l) = tensorb(1) + if (num_dims > 1) then ! 2D + btensor(2)%sf(j,k,l) = tensorb(2) + btensor(3)%sf(j,k,l) = tensorb(4) + end if + if (num_dims > 2) then ! 3D + btensor(3)%sf(j,k,l) = tensorb(3) + btensor(4)%sf(j,k,l) = tensorb(5) + btensor(5)%sf(j,k,l) = tensorb(6) + btensor(6)%sf(j,k,l) = tensorb(9) + end if + ! store the determinant at the last entry of the btensor sf + btensor(7)%sf(j,k,l) = f_determinant(ftensor) end subroutine s_calculate_btensor @@ -179,9 +177,7 @@ end subroutine s_calculate_ainverse ! neo-Hookean only at this time, will need to be changed later function f_elastic_energy(btensor, j, k, l) - type(scalar_field), & - dimension(num_dims*(num_dims+1)/2 + 1), & - intent(IN) :: btensor + type(scalar_field), dimension(num_dims*(num_dims+1)/2 + 1), intent(IN) :: btensor integer, intent(IN) :: j, k, l @@ -202,129 +198,83 @@ function f_elastic_energy(btensor, j, k, l) f_elastic_energy = 0.5d0*(invariant1 - 3)/jacobian end function f_elastic_energy - - subroutine s_initialize_hypoelastic_module_b() ! -------------------- - - integer :: i - - !@:ALLOCATE_GLOBAL(du_dx(0:m,0:n,0:p)) - !if (n > 0) then - ! @:ALLOCATE_GLOBAL(du_dy(0:m,0:n,0:p), dv_dx(0:m,0:n,0:p), dv_dy(0:m,0:n,0:p)) - ! if (p > 0) then - ! @:ALLOCATE_GLOBAL(du_dz(0:m,0:n,0:p), dv_dz(0:m,0:n,0:p)) - ! @:ALLOCATE_GLOBAL(dw_dx(0:m,0:n,0:p), dw_dy(0:m,0:n,0:p), dw_dz(0:m,0:n,0:p)) - ! end if - !end if - - end subroutine s_initialize_hypoelastic_module_b - - !> The purpose of this procedure is to compute the source terms - !! that are needed for the elastic stress equations - !! @param idir Dimension splitting index - !! @param q_prim_vf Primitive variables - !! @param rhs_vf rhs variables - subroutine s_compute_grad_xi(idir, q_prim_vf, rhs_vf) + subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - type(scalar_field), dimension(sys_size), intent(INOUT) :: rhs_vf - integer, intent(IN) :: idir - - real(kind(0d0)) :: rho_K, G_K - - integer :: i, k, l, q !< Loop variables - integer :: ndirs !< Number of coordinate directions - - ndirs = 1; if (n > 0) ndirs = 2; if (p > 0) ndirs = 3 - - if (idir == 1) then - ! calculate velocity gradients + rho_K and G_K - ! TODO: re-organize these loops one by one for GPU efficiency if possible? - - !$acc parallel loop collapse(3) gang vector default(present) - do q = 0, p - do l = 0, n - do k = 0, m - du_dx(k, l, q) = & - (q_prim_vf(momxb)%sf(k - 2, l, q) & - - 8d0*q_prim_vf(momxb)%sf(k - 1, l, q) & - + 8d0*q_prim_vf(momxb)%sf(k + 1, l, q) & - - q_prim_vf(momxb)%sf(k + 2, l, q)) & - /(12d0*dx(k)) - end do - end do - end do - - if (ndirs > 1) then - !$acc parallel loop collapse(3) gang vector default(present) - do q = 0, p - do l = 0, n - do k = 0, m - du_dy(k, l, q) = & - (q_prim_vf(momxb)%sf(k, l - 2, q) & - - 8d0*q_prim_vf(momxb)%sf(k, l - 1, q) & - + 8d0*q_prim_vf(momxb)%sf(k, l + 1, q) & - - q_prim_vf(momxb)%sf(k, l + 2, q)) & - /(12d0*dy(l)) - dv_dx(k, l, q) = & - (q_prim_vf(momxb + 1)%sf(k - 2, l, q) & - - 8d0*q_prim_vf(momxb + 1)%sf(k - 1, l, q) & - + 8d0*q_prim_vf(momxb + 1)%sf(k + 1, l, q) & - - q_prim_vf(momxb + 1)%sf(k + 2, l, q)) & - /(12d0*dx(k)) - dv_dy(k, l, q) = & - (q_prim_vf(momxb + 1)%sf(k, l - 2, q) & - - 8d0*q_prim_vf(momxb + 1)%sf(k, l - 1, q) & - + 8d0*q_prim_vf(momxb + 1)%sf(k, l + 1, q) & - - q_prim_vf(momxb + 1)%sf(k, l + 2, q)) & - /(12d0*dy(l)) - end do - end do - end do - - ! 3D - if (ndirs == 3) then - !$acc parallel loop collapse(3) gang vector default(present) - do q = 0, p - do l = 0, n - do k = 0, m - du_dz(k, l, q) = & - (q_prim_vf(momxb)%sf(k, l, q - 2) & - - 8d0*q_prim_vf(momxb)%sf(k, l, q - 1) & - + 8d0*q_prim_vf(momxb)%sf(k, l, q + 1) & - - q_prim_vf(momxb)%sf(k, l, q + 2)) & - /(12d0*dz(q)) - dv_dz(k, l, q) = & - (q_prim_vf(momxb + 1)%sf(k, l, q - 2) & - - 8d0*q_prim_vf(momxb + 1)%sf(k, l, q - 1) & - + 8d0*q_prim_vf(momxb + 1)%sf(k, l, q + 1) & - - q_prim_vf(momxb + 1)%sf(k, l, q + 2)) & - /(12d0*dz(q)) - dw_dx(k, l, q) = & - (q_prim_vf(momxe)%sf(k - 2, l, q) & - - 8d0*q_prim_vf(momxe)%sf(k - 1, l, q) & - + 8d0*q_prim_vf(momxe)%sf(k + 1, l, q) & - - q_prim_vf(momxe)%sf(k + 2, l, q)) & - /(12d0*dx(k)) - dw_dy(k, l, q) = & - (q_prim_vf(momxe)%sf(k, l - 2, q) & - - 8d0*q_prim_vf(momxe)%sf(k, l - 1, q) & - + 8d0*q_prim_vf(momxe)%sf(k, l + 1, q) & - - q_prim_vf(momxe)%sf(k, l + 2, q)) & - /(12d0*dy(l)) - dw_dz(k, l, q) = & - (q_prim_vf(momxe)%sf(k, l, q - 2) & - - 8d0*q_prim_vf(momxe)%sf(k, l, q - 1) & - + 8d0*q_prim_vf(momxe)%sf(k, l, q + 1) & - - q_prim_vf(momxe)%sf(k, l, q + 2)) & - /(12d0*dz(q)) - end do - end do - end do - end if - end if - end if + real(kind(0d0)), dimension(num_dims**2), intent(INOUT) :: grad_xi + integer, intent(IN) :: j, k, l + ! dxix/dx + grad_xi(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*dx(k)) + + if (num_dims > 1) then + ! dxiy / dx + grad_xi(2) = & + (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & + /(12d0*dx(k)) + ! dxix / dy + grad_xi(3) = & + (q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*dy(l)) + ! dxiy / dy + grad_xi(4) = & + (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & + /(12d0*dy(l)) + end if + ! 3D + if (num_dims > 2) then + ! using results from upper if statement to map form 2x2 to 3x3 tensor + grad_xi(5) = grad_xi(4) + grad_xi(4) = grad_xi(3) + ! dxix / dz + grad_xi(3) = & + (q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - q_prim_vf(xibeg)%sf(j, k, l + 2)) & + /(12d0*dz(q)) + ! dxiy / dz + grad_xi(6) = & + (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & + /(12d0*dz(q)) + ! dxiz / dx + grad_xi(7) = & + (q_prim_vf(xiend)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - q_prim_vf(xiend)%sf(j + 2, k, l)) & + /(12d0*dx(k)) + ! dxiz / dy + grad_xi(8) = & + (q_prim_vf(xiend)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - q_prim_vf(xiend)%sf(j, k + 2, l)) & + /(12d0*dy(l)) + ! dxiz / dz + grad_xi(9) = & + (q_prim_vf(xiend)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - q_prim_vf(xiend)%sf(j, k, l + 2)) & + /(12d0*dz(q)) + end if end subroutine s_compute_grad_xi end module m_rmt_tensor_calc - diff --git a/src/common/test.f90 b/src/common/test.f90 new file mode 100644 index 0000000000..ed45bcec55 --- /dev/null +++ b/src/common/test.f90 @@ -0,0 +1,80 @@ + subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) + + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + real(kind(0d0)), dimension(num_dims**2), intent(INOUT) :: grad_xi + integer, intent(IN) :: j, k, l + + ! dxix/dx + grad_xi(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*dx(k)) + + if (num_dims > 1) then + ! dxiy / dx + grad_xi(2) = & + (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & + /(12d0*dx(k)) + ! dxix / dy + grad_xi(3) = & + (q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*dy(l)) + ! dxiy / dy + grad_xi(4) = & + (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & + /(12d0*dy(l)) + end if + ! 3D + if (num_dims > 2) then + ! using results from upper if statement to map form 2x2 to 3x3 tensor + grad_xi(5) = grad_xi(4) + grad_xi(4) = grad_xi(3) + ! dxix / dz + grad_xi(3) = & + (q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - q_prim_vf(xibeg)%sf(j, k, l + 2)) & + /(12d0*dz(q)) + ! dxiy / dz + grad_xi(6) = & + (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & + /(12d0*dz(q)) + ! dxiz / dx + grad_xi(7) = & + (q_prim_vf(xiend)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - q_prim_vf(xiend)%sf(j + 2, k, l)) & + /(12d0*dx(k)) + ! dxiz / dy + grad_xi(8) = & + (q_prim_vf(xiend)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - q_prim_vf(xiend)%sf(j, k + 2, l)) & + /(12d0*dy(l)) + ! dxiz / dz + grad_xi(9) = & + (q_prim_vf(xiend)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - q_prim_vf(xiend)%sf(j, k, l + 2)) & + /(12d0*dz(q)) + end if + end subroutine s_compute_grad_xi + +end module m_rmt_tensor_calc diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 48237474d2..7cdaecbc3f 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -85,6 +85,7 @@ module m_global_parameters integer :: weno_order !< Order of accuracy for the WENO reconstruction logical :: hypoelasticity !< activate hypoelasticity logical :: hyperelasticity !< activate hyperelasticity + integer :: b_size !< Number of components in the b tensor logical :: pre_stress !< activate pre_stressed domain ! Annotations of the structure, i.e. the organization, of the state vectors From 6f374e7f65439ec40d5da73da313d4cc5b7b1844 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 16 May 2024 21:26:25 -0400 Subject: [PATCH 087/380] resolving issues with grad xi calc --- src/common/m_rmt_tensor_calc.f90 | 21 ++++--- src/common/test.f90 | 80 ------------------------ src/post_process/m_global_parameters.fpp | 3 + src/pre_process/m_global_parameters.fpp | 3 + src/simulation/m_global_parameters.fpp | 6 +- 5 files changed, 23 insertions(+), 90 deletions(-) delete mode 100644 src/common/test.f90 diff --git a/src/common/m_rmt_tensor_calc.f90 b/src/common/m_rmt_tensor_calc.f90 index 51fa19c27a..16fc8486e7 100644 --- a/src/common/m_rmt_tensor_calc.f90 +++ b/src/common/m_rmt_tensor_calc.f90 @@ -209,7 +209,8 @@ subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*dx(k)) + /(12d0*(x_cb(j) - x_cb(j-1))) + !/(12d0*dx(j)) if (num_dims > 1) then ! dxiy / dx @@ -218,21 +219,23 @@ subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & - /(12d0*dx(k)) + /(12d0*(x_cb(j) - x_cb(j-1))) + !/(12d0*dx(j)) ! dxix / dy grad_xi(3) = & (q_prim_vf(xibeg)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*dy(l)) + /(12d0*(y_cb(k) - y_cb(k-1))) + !/(12d0*dy(k)) ! dxiy / dy grad_xi(4) = & (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & - /(12d0*dy(l)) + /(12d0*dy(k)) end if ! 3D if (num_dims > 2) then @@ -245,35 +248,35 @@ subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - q_prim_vf(xibeg)%sf(j, k, l + 2)) & - /(12d0*dz(q)) + /(12d0*dz(l)) ! dxiy / dz grad_xi(6) = & (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & - /(12d0*dz(q)) + /(12d0*dz(l)) ! dxiz / dx grad_xi(7) = & (q_prim_vf(xiend)%sf(j - 2, k, l) & - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - q_prim_vf(xiend)%sf(j + 2, k, l)) & - /(12d0*dx(k)) + /(12d0*dx(j)) ! dxiz / dy grad_xi(8) = & (q_prim_vf(xiend)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*dy(l)) + /(12d0*dy(k)) ! dxiz / dz grad_xi(9) = & (q_prim_vf(xiend)%sf(j, k, l - 2) & - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - q_prim_vf(xiend)%sf(j, k, l + 2)) & - /(12d0*dz(q)) + /(12d0*dz(l)) end if end subroutine s_compute_grad_xi diff --git a/src/common/test.f90 b/src/common/test.f90 deleted file mode 100644 index ed45bcec55..0000000000 --- a/src/common/test.f90 +++ /dev/null @@ -1,80 +0,0 @@ - subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) - - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(num_dims**2), intent(INOUT) :: grad_xi - integer, intent(IN) :: j, k, l - - ! dxix/dx - grad_xi(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*dx(k)) - - if (num_dims > 1) then - ! dxiy / dx - grad_xi(2) = & - (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & - /(12d0*dx(k)) - ! dxix / dy - grad_xi(3) = & - (q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*dy(l)) - ! dxiy / dy - grad_xi(4) = & - (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & - /(12d0*dy(l)) - end if - ! 3D - if (num_dims > 2) then - ! using results from upper if statement to map form 2x2 to 3x3 tensor - grad_xi(5) = grad_xi(4) - grad_xi(4) = grad_xi(3) - ! dxix / dz - grad_xi(3) = & - (q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - q_prim_vf(xibeg)%sf(j, k, l + 2)) & - /(12d0*dz(q)) - ! dxiy / dz - grad_xi(6) = & - (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & - /(12d0*dz(q)) - ! dxiz / dx - grad_xi(7) = & - (q_prim_vf(xiend)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - q_prim_vf(xiend)%sf(j + 2, k, l)) & - /(12d0*dx(k)) - ! dxiz / dy - grad_xi(8) = & - (q_prim_vf(xiend)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*dy(l)) - ! dxiz / dz - grad_xi(9) = & - (q_prim_vf(xiend)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - q_prim_vf(xiend)%sf(j, k, l + 2)) & - /(12d0*dz(q)) - end if - end subroutine s_compute_grad_xi - -end module m_rmt_tensor_calc diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index b1293da7f4..ca7eba3f2a 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -247,6 +247,7 @@ module m_global_parameters integer :: intxb, intxe integer :: bubxb, bubxe integer :: strxb, strxe + integer :: xibeg, xiend !> @} contains @@ -581,6 +582,8 @@ contains strxe = stress_idx%end intxb = internalEnergies_idx%beg intxe = internalEnergies_idx%end + xibeg = stress_idx%beg + xiend = stress_idx%end ! ================================================================== #ifdef MFC_MPI diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 7cdaecbc3f..09dbda4f29 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -215,6 +215,7 @@ module m_global_parameters integer :: intxb, intxe integer :: bubxb, bubxe integer :: strxb, strxe + integer :: xibeg, xiend !> @} integer, allocatable, dimension(:, :, :) :: logic_grid @@ -689,6 +690,8 @@ contains strxe = stress_idx%end intxb = internalEnergies_idx%beg intxe = internalEnergies_idx%end + xibeg = stress_idx%beg + xiend = stress_idx%end ! ================================================================== diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 6b6b4ecb60..f76f414c6f 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -409,7 +409,9 @@ module m_global_parameters integer :: intxb, intxe integer :: bubxb, bubxe integer :: strxb, strxe + integer :: xibeg, xiend !$acc declare create(momxb, momxe, advxb, advxe, contxb, contxe, intxb, intxe, bubxb, bubxe, strxb, strxe) +!$acc declare create(xibeg,xiend) #ifdef CRAY_ACC_WAR @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps) @@ -987,8 +989,10 @@ contains strxe = stress_idx%end intxb = internalEnergies_idx%beg intxe = internalEnergies_idx%end + xibeg = stress_idx%beg + xiend = stress_idx%end - !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe, b_size) + !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe, b_size, xibeg, xiend) !$acc update device(m, n, p) !$acc update device(alt_soundspeed, monopole, num_mono) From 730e6c49a6954288f0905801a178ee361f306e0c Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Thu, 16 May 2024 21:40:18 -0400 Subject: [PATCH 088/380] tiny rmt_tensor_calc changes for successful pre_process build --- src/common/m_rmt_tensor_calc.f90 | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/src/common/m_rmt_tensor_calc.f90 b/src/common/m_rmt_tensor_calc.f90 index 16fc8486e7..8f42344038 100644 --- a/src/common/m_rmt_tensor_calc.f90 +++ b/src/common/m_rmt_tensor_calc.f90 @@ -235,7 +235,8 @@ subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & - /(12d0*dy(k)) + /(12d0*(y_cb(k) - y_cb(k-1))) + !/(12d0*dy(k)) end if ! 3D if (num_dims > 2) then @@ -248,35 +249,40 @@ subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - q_prim_vf(xibeg)%sf(j, k, l + 2)) & - /(12d0*dz(l)) + /(12d0*(z_cb(l) - z_cb(l-1))) + !/(12d0*dz(l)) ! dxiy / dz grad_xi(6) = & (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & - /(12d0*dz(l)) + /(12d0*(z_cb(l) - z_cb(l-1))) + !/(12d0*dz(l)) ! dxiz / dx grad_xi(7) = & (q_prim_vf(xiend)%sf(j - 2, k, l) & - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - q_prim_vf(xiend)%sf(j + 2, k, l)) & - /(12d0*dx(j)) + /(12d0*(x_cb(j) - x_cb(j-1))) + !/(12d0*dx(j)) ! dxiz / dy grad_xi(8) = & (q_prim_vf(xiend)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*dy(k)) + /(12d0*(y_cb(k) - y_cb(k-1))) + !/(12d0*dy(k)) ! dxiz / dz grad_xi(9) = & (q_prim_vf(xiend)%sf(j, k, l - 2) & - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - q_prim_vf(xiend)%sf(j, k, l + 2)) & - /(12d0*dz(l)) + /(12d0*(z_cb(l) - z_cb(l-1))) + !/(12d0*dz(l)) end if end subroutine s_compute_grad_xi From 906aab0ff0ef3a6195980082cc4b6c3fbac066d1 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 16 May 2024 22:24:33 -0400 Subject: [PATCH 089/380] finished drafting the rmt in common code, compiles pre_process --- src/common/m_rmt_tensor_calc.f90 | 61 +++++------------------- src/post_process/m_global_parameters.fpp | 3 ++ src/pre_process/m_global_parameters.fpp | 2 + src/simulation/m_global_parameters.fpp | 3 +- 4 files changed, 20 insertions(+), 49 deletions(-) diff --git a/src/common/m_rmt_tensor_calc.f90 b/src/common/m_rmt_tensor_calc.f90 index 8f42344038..eccc40f2d1 100644 --- a/src/common/m_rmt_tensor_calc.f90 +++ b/src/common/m_rmt_tensor_calc.f90 @@ -21,21 +21,17 @@ module m_rmt_tensor_calc implicit none private; public :: s_calculate_btensor, & - f_elastic_energy, & - s_calculate_deviatoric + f_elastic_energy #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), grad_xi) !$acc declare link(grad_xi) #else - real(kind(0d0)), allocatable, dimension(:) :: grad_xi ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz !$acc declare create(grad_xi) - #endif contains @@ -66,7 +62,7 @@ subroutine s_calculate_btensor(q_prim_vf, j, k, l, btensor) btensor(6)%sf(j,k,l) = tensorb(9) end if ! store the determinant at the last entry of the btensor sf - btensor(7)%sf(j,k,l) = f_determinant(ftensor) + btensor(b_size)%sf(j,k,l) = f_determinant(ftensor) end subroutine s_calculate_btensor @@ -90,33 +86,6 @@ function f_determinant(tensor) end if end function f_determinant - subroutine s_calculate_deviatoric(tensor, deviatoric) - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: deviatoric - real(kind(0d0)) :: trace13 - deviatoric = tensor - trace13 = f_trace(tensor) - trace13 = (1.0/3.0)*trace13 - deviatoric(1) = tensor(1) - trace13 - if (num_dims == 2) then - deviatoric(4) = tensor(4) - trace13 - elseif (num_dims == 3) then - deviatoric(5) = tensor(5) - trace13 - deviatoric(9) = tensor(9) - trace13 - end if - end subroutine s_calculate_deviatoric - - function f_trace(tensor) - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)) :: f_trace - f_trace = tensor(1) - if (num_dims == 2) then - f_trace = f_trace + tensor(4) - elseif (num_dims == 3) then - f_trace = f_trace + tensor(5) + tensor(9) - end if - end function f_trace - subroutine s_calculate_atransposea(tensor, ata) real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ata @@ -177,25 +146,19 @@ end subroutine s_calculate_ainverse ! neo-Hookean only at this time, will need to be changed later function f_elastic_energy(btensor, j, k, l) - type(scalar_field), dimension(num_dims*(num_dims+1)/2 + 1), intent(IN) :: btensor - + type(scalar_field), dimension(b_size), intent(IN) :: btensor integer, intent(IN) :: j, k, l + real(kind(0d0)) :: invariant1, f_elastic_energy - real(kind(0d0)), dimension(num_dims**2) :: ftransposef, tensorb - real(kind(0d0)) :: invariant1, jacobian, f_elastic_energy - integer :: i !< Generic loop iterators + invariant1 = btensor(1)%sf(j,k,l) - ! extracting the nxn tensor for the calculation - !TODO COPY SPRATT CODE FOR SYMMETRIC TENSOR - do i = 1, num_dims*(num_dims+1)/2 - tensorb(i) = btensor(i)%sf(j, k, l) - end do - tensorb(1) = btensor(1)%sf(j, k, l) - - jacobian = btensor(num_dims*(num_dims+1)/2 + 1)%sf(j, k, l) - invariant1 = f_trace(tensorb) + if (num_dims == 2) then + invariant1 = invariant1 + btensor(3)%sf(j,k,l) + elseif (num_dims == 3) then + invariant1 = invariant1 + btensor(4)%sf(j,k,l) + btensor(6)%sf(j,k,l) + end if ! compute the invariant without the elastic modulus - f_elastic_energy = 0.5d0*(invariant1 - 3)/jacobian + f_elastic_energy = 0.5d0*(invariant1 - 3)/btensor(b_size)%sf(j, k, l) end function f_elastic_energy subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) @@ -284,6 +247,8 @@ subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) /(12d0*(z_cb(l) - z_cb(l-1))) !/(12d0*dz(l)) end if + + end subroutine s_compute_grad_xi end module m_rmt_tensor_calc diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index ca7eba3f2a..7dc330c591 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -94,6 +94,7 @@ module m_global_parameters logical :: alt_soundspeed !< Alternate sound speed logical :: hypoelasticity !< Turn hypoelasticity on logical :: hyperelasticity !< Turn hyperelasticity on + integer :: b_size !< Number of components in the b tensor !> @} !> @name Annotations of the structure, i.e. the organization, of the state vectors @@ -491,6 +492,8 @@ contains stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + num_dims sys_size = stress_idx%end + ! number of entries in the symmetric btensor plus the jacobian + b_size = (num_dims*(num_dims + 1))/2 + 1 end if ! ================================================================== diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 09dbda4f29..15a428af6c 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -599,6 +599,8 @@ contains stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + num_dims sys_size = stress_idx%end + ! number of entries in the symmetric btensor plus the jacobian + b_size = (num_dims*(num_dims + 1))/2 + 1 end if ! ================================================================== diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index f76f414c6f..adc24eb668 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -790,7 +790,8 @@ contains stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + num_dims sys_size = stress_idx%end - b_size = (num_dims*(num_dims + 1))/2 + ! number of entries in the symmetric btensor plus the jacobian + b_size = (num_dims*(num_dims + 1))/2 + 1 end if else if (model_eqns == 3) then From cff90c164b0bb5cebed647f22b069fbdee5dcb64 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 16 May 2024 22:36:59 -0400 Subject: [PATCH 090/380] cleaning up m_hyperelastic a bit --- src/simulation/m_hyperelastic.fpp | 14 +++----------- 1 file changed, 3 insertions(+), 11 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 2abb7c9890..e791921307 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -15,14 +15,11 @@ module m_hyperelastic use m_mpi_proxy !< Message passing interface (MPI) module proxy - use m_rmt_tensor_calc !< State variables type conversion procedures - ! ========================================================================== implicit none private; public :: s_initialize_hyperelastic_module, & - s_compute_hyperelastic_rhs, & s_calculate_cauchy_stress contains @@ -31,10 +28,6 @@ contains end subroutine s_initialize_hyperelastic_module - subroutine s_compute_hyperelastic_rhs() - - end subroutine s_compute_hyperelastic_rhs - subroutine s_calculate_cauchy_stress(btensor, j, k, l, sigma) type(scalar_field), dimension(num_dims**2 + 1), intent(IN) :: btensor real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: sigma @@ -49,13 +42,12 @@ contains tensorb(i) = btensor(i)%sf(j, k, l) end do jacobian = btensor(num_dims**2 + 1)%sf(j, k, l) - call s_calculate_deviatoric(tensorb, devbtensor) + !call s_calculate_deviatoric(tensorb, devbtensor) + ! calculate deviatoric using symmetric tensor + sigma(:) = devbtensor(:)/jacobian end subroutine s_calculate_cauchy_stress - - end module m_hyperelastic - From 0c55bff33078f582f3789c5774b9a7a4dffca7ed Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Fri, 17 May 2024 00:28:23 -0400 Subject: [PATCH 091/380] symmetric tensor calc added to find stress, simulation compiles --- src/common/m_rmt_tensor_calc.f90 | 1 - src/common/m_variables_conversion.fpp | 6 ++--- src/simulation/m_hyperelastic.fpp | 32 +++++++++++++++++++++++---- 3 files changed, 31 insertions(+), 8 deletions(-) diff --git a/src/common/m_rmt_tensor_calc.f90 b/src/common/m_rmt_tensor_calc.f90 index eccc40f2d1..3c1b605a3a 100644 --- a/src/common/m_rmt_tensor_calc.f90 +++ b/src/common/m_rmt_tensor_calc.f90 @@ -248,7 +248,6 @@ subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) !/(12d0*dz(l)) end if - end subroutine s_compute_grad_xi end module m_rmt_tensor_calc diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index e5949b047c..9e2d03e0ec 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1049,10 +1049,10 @@ contains qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & /rho_K end do - !call s_calculate_btensor(qK_prim_vf, j, k, l, qK_btensor_vf) + call s_calculate_btensor(qK_prim_vf, j, k, l, qK_btensor_vf) - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & - !G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K else ! Mostly in the non-solid material diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index e791921307..c7be2fba50 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -42,12 +42,36 @@ contains tensorb(i) = btensor(i)%sf(j, k, l) end do jacobian = btensor(num_dims**2 + 1)%sf(j, k, l) - !call s_calculate_deviatoric(tensorb, devbtensor) - ! calculate deviatoric using symmetric tensor - + call s_calculate_deviatoric(tensorb, devbtensor) sigma(:) = devbtensor(:)/jacobian end subroutine s_calculate_cauchy_stress -end module m_hyperelastic + function f_trace(symtensor) + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: symtensor + real(kind(0d0)) :: f_trace + + f_trace = symtensor(1) + if (num_dims == 2) then + f_trace = symtensor(1)+symtensor(3) + else + f_trace = symtensor(1)+symtensor(4)+symtensor(6) + endif + end function f_trace + + subroutine s_calculate_deviatoric(symtensor, devtensor) + real(kind(0d0)), dimension(num_dims*2 + 1), intent(IN) :: symtensor + real(kind(0d0)), dimension(num_dims*2), intent(OUT) :: devtensor + real(kind(0d0)) :: trace + devtensor = symtensor + trace = f_trace(symtensor) + devtensor(1) = symtensor(1) - (1d0/3d0)*trace + if (num_dims == 2) then + devtensor(3) = symtensor(3) - (1d0/3d0)*trace + else + devtensor(4) = symtensor(4) - (1d0/3d0)*trace + devtensor(6) = symtensor(6) - (1d0/3d0)*trace + end if + end subroutine s_calculate_deviatoric +end module m_hyperelastic From 832691de76734af47eca94d43226af8e80ef9fca Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 17 May 2024 17:09:00 -0500 Subject: [PATCH 092/380] adding the start for hll riemann solver with hyper, does not compile --- src/simulation/m_global_parameters.fpp | 2 +- src/simulation/m_hyperelastic.fpp | 8 +++++++- src/simulation/m_rhs.fpp | 6 ++++++ 3 files changed, 14 insertions(+), 2 deletions(-) diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index adc24eb668..091e04c567 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -788,7 +788,7 @@ contains if (hyperelasticity) then ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + num_dims + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + num_dims sys_size = stress_idx%end ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index c7be2fba50..809ba8eb0c 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -28,7 +28,13 @@ contains end subroutine s_initialize_hyperelastic_module - subroutine s_calculate_cauchy_stress(btensor, j, k, l, sigma) + !type(int_bounds_info), optional, intent(IN) :: ix, iy, iz + + !do l = izb, ize + ! do k = iyb, iye + ! do j = ixb, ixe + + subroutine s_calculate_cauchy_from_btensor(q_btensor_vf, ix, iy, iz, q_prim_vf) type(scalar_field), dimension(num_dims**2 + 1), intent(IN) :: btensor real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: sigma integer, intent(IN) :: j, k, l diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index d1ffcbd3c8..36c0cd2d1b 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -735,6 +735,12 @@ contains call nvtxEndRange + call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") + if (hyperelasticity) then + call s_compute_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf,ix,iy,iz) + end if + call nvtxEndRange + call nvtxStartRange("RHS-MPI") call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) call nvtxEndRange From 02add190d05a581df2b5ae6ad7bb7e761617274e Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Fri, 17 May 2024 19:24:06 -0400 Subject: [PATCH 093/380] preparing q_prim_vf with btensor, compilation untested --- src/simulation/m_hyperelastic.fpp | 51 ++++++++++++++++--------------- 1 file changed, 27 insertions(+), 24 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 809ba8eb0c..bada797257 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -28,29 +28,32 @@ contains end subroutine s_initialize_hyperelastic_module - !type(int_bounds_info), optional, intent(IN) :: ix, iy, iz - - !do l = izb, ize - ! do k = iyb, iye - ! do j = ixb, ixe - - subroutine s_calculate_cauchy_from_btensor(q_btensor_vf, ix, iy, iz, q_prim_vf) - type(scalar_field), dimension(num_dims**2 + 1), intent(IN) :: btensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: sigma - integer, intent(IN) :: j, k, l - - real(kind(0d0)), dimension(num_dims**2) :: tensorb, devbtensor - real(kind(0d0)) :: jacobian - integer :: i !< Generic loop iterators - - ! extracting the nxn tensor for the calculation - do i = 1, num_dims**2 - tensorb(i) = btensor(i)%sf(j, k, l) + subroutine s_calculate_cauchy_from_btensor(btensor, ix, iy, iz, q_prim_vf) + type(scalar_field), dimension(sys_size), intent(INOUT) :: q_prim_vf + real(kind(0d0)), dimension(b_size), intent(IN) :: btensor + integer, intent(IN) :: j, k, l + + type(int_bounds_info), optional, intent(IN) :: ix, iy, iz + + real(kind(0d0)), dimension(b_size) :: sigma, tensorb, devbtensor + real(kind(0d0)) :: jacobian + integer :: i !< Generic loop iterators + + ! extracting the nxn tensor for the calculation + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe + do i = 1, b_size-1 + tensorb(i) = btensor(i)%sf(j, k, l) + end do + jacobian = btensor(b_size+1)%sf(j, k, l) + call s_calculate_deviatoric(tensorb, devbtensor) + sigma(:) = devbtensor(:)/jacobian + do i = 1, b_size-1 + q_prim_vf(i)%sf(ix,iy,iz) = sigma(i) + end do end do - jacobian = btensor(num_dims**2 + 1)%sf(j, k, l) - call s_calculate_deviatoric(tensorb, devbtensor) - sigma(:) = devbtensor(:)/jacobian - + end do end subroutine s_calculate_cauchy_stress function f_trace(symtensor) @@ -65,7 +68,7 @@ contains endif end function f_trace - subroutine s_calculate_deviatoric(symtensor, devtensor) + subroutine s_calculate_deviatoric(symtensor, devtensor) real(kind(0d0)), dimension(num_dims*2 + 1), intent(IN) :: symtensor real(kind(0d0)), dimension(num_dims*2), intent(OUT) :: devtensor real(kind(0d0)) :: trace @@ -78,6 +81,6 @@ contains devtensor(4) = symtensor(4) - (1d0/3d0)*trace devtensor(6) = symtensor(6) - (1d0/3d0)*trace end if - end subroutine s_calculate_deviatoric + end subroutine s_calculate_deviatoric end module m_hyperelastic From 2d12411ffbe511ecb1e6ad1195d4e5ce3726f13f Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 17 May 2024 21:03:53 -0500 Subject: [PATCH 094/380] cleaned up the Cauchy stress calculation --- src/simulation/m_hyperelastic.fpp | 29 +++++++++++------------------ 1 file changed, 11 insertions(+), 18 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index bada797257..76ec803023 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -19,30 +19,23 @@ module m_hyperelastic implicit none - private; public :: s_initialize_hyperelastic_module, & - s_calculate_cauchy_stress + private; public :: s_calculate_cauchy_stress contains - subroutine s_initialize_hyperelastic_module() - - end subroutine s_initialize_hyperelastic_module - - subroutine s_calculate_cauchy_from_btensor(btensor, ix, iy, iz, q_prim_vf) + subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf) type(scalar_field), dimension(sys_size), intent(INOUT) :: q_prim_vf real(kind(0d0)), dimension(b_size), intent(IN) :: btensor - integer, intent(IN) :: j, k, l - - type(int_bounds_info), optional, intent(IN) :: ix, iy, iz - + real(kind(0d0)), dimension(b_size) :: sigma, tensorb, devbtensor real(kind(0d0)) :: jacobian - integer :: i !< Generic loop iterators + integer :: i, j, k, l !< Generic loop iterators ! extracting the nxn tensor for the calculation - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe + !$acc parallel loop collapse(3) gang vector default(present) + do l = 0, p + do k = 0, n + do j = 0, m do i = 1, b_size-1 tensorb(i) = btensor(i)%sf(j, k, l) end do @@ -52,9 +45,9 @@ contains do i = 1, b_size-1 q_prim_vf(i)%sf(ix,iy,iz) = sigma(i) end do - end do - end do - end subroutine s_calculate_cauchy_stress + end do + end do + end subroutine s_calculate_cauchy_from_btensor function f_trace(symtensor) real(kind(0d0)), dimension(num_dims**2), intent(IN) :: symtensor From 7ff34f3489d3c55fe3742684f9a05991f7c16917 Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Fri, 17 May 2024 23:41:14 -0500 Subject: [PATCH 095/380] debug lines added for hyperelasticity and btensor and elastic energy, testing compilation hehe --- src/common/m_rmt_tensor_calc.f90 | 5 +++++ src/simulation/m_hyperelastic.fpp | 30 +++++++++++++++++------------- src/simulation/m_rhs.fpp | 2 +- 3 files changed, 23 insertions(+), 14 deletions(-) diff --git a/src/common/m_rmt_tensor_calc.f90 b/src/common/m_rmt_tensor_calc.f90 index 3c1b605a3a..a6568d0de5 100644 --- a/src/common/m_rmt_tensor_calc.f90 +++ b/src/common/m_rmt_tensor_calc.f90 @@ -41,6 +41,7 @@ subroutine s_calculate_btensor(q_prim_vf, j, k, l, btensor) type(scalar_field), dimension(num_dims*(num_dims+1)/2 + 1), intent(OUT) :: btensor integer, intent(IN) :: j, k, l real(kind(0d0)), dimension(num_dims**2) :: grad_xi, ftensor, tensorb + integer :: i ! calculate the grad_xi, grad_xi is a nxn tensor call s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) @@ -64,6 +65,10 @@ subroutine s_calculate_btensor(q_prim_vf, j, k, l, btensor) ! store the determinant at the last entry of the btensor sf btensor(b_size)%sf(j,k,l) = f_determinant(ftensor) + do i = 1, size(btensor) + print*, 'btensor(', i, ')%sf(', j, ',', k, ',', l, ') = ', btensor(i)%sf(j,k,l) + end do + end subroutine s_calculate_btensor function f_determinant(tensor) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 76ec803023..3cf211f9c8 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -19,34 +19,38 @@ module m_hyperelastic implicit none - private; public :: s_calculate_cauchy_stress + private; public :: s_calculate_cauchy_from_btensor contains subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf) type(scalar_field), dimension(sys_size), intent(INOUT) :: q_prim_vf - real(kind(0d0)), dimension(b_size), intent(IN) :: btensor + type(scalar_field), dimension(b_size), intent(IN) :: btensor real(kind(0d0)), dimension(b_size) :: sigma, tensorb, devbtensor real(kind(0d0)) :: jacobian integer :: i, j, k, l !< Generic loop iterators + + !if (proc_rank ==0) print*, 'this is btensor ::', btensor ! extracting the nxn tensor for the calculation !$acc parallel loop collapse(3) gang vector default(present) do l = 0, p - do k = 0, n - do j = 0, m - do i = 1, b_size-1 - tensorb(i) = btensor(i)%sf(j, k, l) - end do - jacobian = btensor(b_size+1)%sf(j, k, l) - call s_calculate_deviatoric(tensorb, devbtensor) - sigma(:) = devbtensor(:)/jacobian - do i = 1, b_size-1 - q_prim_vf(i)%sf(ix,iy,iz) = sigma(i) - end do + do k = 0, n + do j = 0, m + do i = 1, b_size-1 + tensorb(i) = btensor(i)%sf(j, k, l) + end do + jacobian = btensor(b_size+1)%sf(j, k, l) + call s_calculate_deviatoric(tensorb, devbtensor) + sigma(:) = devbtensor(:)/jacobian + do i = 1, b_size-1 + q_prim_vf(i)%sf(j, k, l) = sigma(i) + end do + end do end do end do + if (proc_rank ==0) print*, 'J is ::', jacobian, 'this is sigma ::', sigma end subroutine s_calculate_cauchy_from_btensor function f_trace(symtensor) diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 36c0cd2d1b..02e254957c 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -737,7 +737,7 @@ contains call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") if (hyperelasticity) then - call s_compute_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf,ix,iy,iz) + call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf) end if call nvtxEndRange From 8ecc6fdb6c51c04be40ad2bf3e6305b064deb978 Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Sat, 18 May 2024 18:35:53 -0500 Subject: [PATCH 096/380] actively debugging btensor, elastic energy, and q_prim_vf, does not compile --- src/common/m_rmt_tensor_calc.f90 | 49 ++++++++++++++----------- src/common/m_variables_conversion.fpp | 7 ++-- src/pre_process/m_assign_variables.f90 | 3 +- src/pre_process/m_global_parameters.fpp | 2 +- src/pre_process/m_initial_condition.fpp | 12 ++++-- src/simulation/m_global_parameters.fpp | 2 + src/simulation/m_mpi_proxy.fpp | 3 +- src/simulation/m_start_up.fpp | 7 ++-- toolchain/mfc/run/case_dicts.py | 4 +- 9 files changed, 52 insertions(+), 37 deletions(-) diff --git a/src/common/m_rmt_tensor_calc.f90 b/src/common/m_rmt_tensor_calc.f90 index a6568d0de5..148db502d8 100644 --- a/src/common/m_rmt_tensor_calc.f90 +++ b/src/common/m_rmt_tensor_calc.f90 @@ -38,7 +38,7 @@ module m_rmt_tensor_calc subroutine s_calculate_btensor(q_prim_vf, j, k, l, btensor) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - type(scalar_field), dimension(num_dims*(num_dims+1)/2 + 1), intent(OUT) :: btensor + type(scalar_field), dimension(num_dims*(num_dims+1)/2 + 1), intent(INOUT) :: btensor integer, intent(IN) :: j, k, l real(kind(0d0)), dimension(num_dims**2) :: grad_xi, ftensor, tensorb integer :: i @@ -46,29 +46,26 @@ subroutine s_calculate_btensor(q_prim_vf, j, k, l, btensor) ! calculate the grad_xi, grad_xi is a nxn tensor call s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - call s_calculate_ainverse(grad_xi,ftensor) + !call s_calculate_ainverse(grad_xi,ftensor) ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - call s_calculate_atransposea(ftensor,tensorb) + !call s_calculate_atransposea(ftensor,tensorb) ! btensor is symmetric, save the data space + print *, "I got here!" ! 1: 1D, 3: 2D, 6: 3D btensor(1)%sf(j,k,l) = tensorb(1) - if (num_dims > 1) then ! 2D - btensor(2)%sf(j,k,l) = tensorb(2) - btensor(3)%sf(j,k,l) = tensorb(4) - end if - if (num_dims > 2) then ! 3D - btensor(3)%sf(j,k,l) = tensorb(3) - btensor(4)%sf(j,k,l) = tensorb(5) - btensor(5)%sf(j,k,l) = tensorb(6) - btensor(6)%sf(j,k,l) = tensorb(9) - end if + !if (num_dims > 1) then ! 2D + ! btensor(2)%sf(j,k,l) = tensorb(2) + ! btensor(3)%sf(j,k,l) = tensorb(4) + !end if + !if (num_dims > 2) then ! 3D + ! btensor(3)%sf(j,k,l) = tensorb(3) + ! btensor(4)%sf(j,k,l) = tensorb(5) + ! btensor(5)%sf(j,k,l) = tensorb(6) + ! btensor(6)%sf(j,k,l) = tensorb(9) + !end if ! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j,k,l) = f_determinant(ftensor) - - do i = 1, size(btensor) - print*, 'btensor(', i, ')%sf(', j, ',', k, ',', l, ') = ', btensor(i)%sf(j,k,l) - end do - + !btensor(b_size)%sf(j,k,l) = f_determinant(ftensor) + end subroutine s_calculate_btensor function f_determinant(tensor) @@ -86,6 +83,7 @@ function f_determinant(tensor) end if ! error checking if (f_determinant == 0) then + print *, 'f_determinant :: ',f_determinant print *, 'ERROR: Determinant was zero' call s_mpi_abort() end if @@ -143,7 +141,7 @@ subroutine s_calculate_ainverse(tensor, ainv) real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ainv real(kind(0d0)), dimension(num_dims**2) :: dja real(kind(0d0)) :: det - + integer :: i call s_calculate_adjointa(tensor, dja) det = f_determinant(tensor) ainv(:) = dja(:)/det @@ -171,7 +169,8 @@ subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf real(kind(0d0)), dimension(num_dims**2), intent(INOUT) :: grad_xi integer, intent(IN) :: j, k, l - + integer :: i + print *, "num_dims :: ",num_dims ! dxix/dx grad_xi(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & @@ -253,6 +252,12 @@ subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) !/(12d0*dz(l)) end if - end subroutine s_compute_grad_xi + + !if (proc_rank ==0) then + ! do i = 1, num_dims**2 + ! print *, 'grad_xi(',i,') ::', grad_xi(i) + ! end do + !end if + end subroutine s_compute_grad_xi end module m_rmt_tensor_calc diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 9e2d03e0ec..6d8b2a71e6 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1043,7 +1043,7 @@ contains end do end if - if ( hyperelasticity .and. .not. bubbles ) then ! .and. G_K > 100 ) then + if (hyperelasticity .and. .not. bubbles) then ! .and. G_K > 100 ) then !$acc loop seq do i = strxb, strxe qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & @@ -1051,8 +1051,8 @@ contains end do call s_calculate_btensor(qK_prim_vf, j, k, l, qK_btensor_vf) - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K + !qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + ! G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K else ! Mostly in the non-solid material @@ -1224,6 +1224,7 @@ contains do i = stress_idx%beg, stress_idx%end q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) end do + ! TODO !call s_calculate_btensor(qK_prim_vf, j, k, l, q_btensor_vf) q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) !+ & !G*f_elastic_energy(q_btensor_vf, j, k, l) diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 index 372bc537d0..4377cf5f0f 100644 --- a/src/pre_process/m_assign_variables.f90 +++ b/src/pre_process/m_assign_variables.f90 @@ -458,9 +458,10 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & end if do i = 1, (stress_idx%end - stress_idx%beg) + 1 q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = xi_cart(i) + !(eta*xi_cart(i) + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1)) - !if (proc_rank ==0) print *, 'q(',i') ::', q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) + !if (proc_rank ==0) print *, 'q(',i,') ::', q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) !if (proc_rank == 0) then ! write(*,*) 'q(',i,') :: ',q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l)& ! ,', xi_cart :: ',xi_cart(i) diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 15a428af6c..19dc43a71e 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -597,7 +597,7 @@ contains if (hyperelasticity) then ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + num_dims + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 sys_size = stress_idx%end ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp index dc29206d8f..8d880893e1 100644 --- a/src/pre_process/m_initial_condition.fpp +++ b/src/pre_process/m_initial_condition.fpp @@ -123,10 +123,10 @@ contains ! Converting the conservative variables to the primitive ones given ! preexisting initial condition data files were read in on start-up - if (old_ic) then - call s_convert_conservative_to_primitive_variables(q_cons_vf, & - q_prim_vf) - end if + !if (old_ic) then + ! call s_convert_conservative_to_primitive_variables(q_cons_vf, & + ! q_prim_vf) + !end if ! 3D Patch Geometries ============================================= if (p > 0) then @@ -318,6 +318,10 @@ contains call s_convert_primitive_to_conservative_variables(q_prim_vf, & q_cons_vf) + !TODO REMOVE AFTER DEBUGGING + call s_convert_conservative_to_primitive_variables(q_cons_vf, & + q_prim_vf) + if (qbmm .and. .not. polytropic) then !Initialize pb and mv call s_initialize_mv(q_cons_vf, mv%sf) diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 091e04c567..d85f042f8f 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -162,6 +162,8 @@ module m_global_parameters type(int_bounds_info) :: bc_x, bc_y, bc_z !> @} type(bounds_info) :: x_domain, y_domain, z_domain + real(kind(0d0)) :: x_a, y_a, z_a + real(kind(0d0)) :: x_b, y_b, z_b logical :: parallel_io !< Format of the data files logical :: file_per_process !< shared file or not when using parallel io diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index 334a45342d..42a269212c 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -200,7 +200,8 @@ contains & 'bc_y%vb1','bc_y%vb2','bc_y%vb3','bc_y%ve1','bc_y%ve2','bc_y%ve3', & & 'bc_z%vb1','bc_z%vb2','bc_z%vb3','bc_z%ve1','bc_z%ve2','bc_z%ve3', & & 'x_domain%beg', 'x_domain%end', 'y_domain%beg', 'y_domain%end', & - & 'z_domain%beg', 'z_domain%end'] + & 'z_domain%beg', 'z_domain%end', 'x_a', 'x_b', 'y_a', 'y_b', 'z_a', & + & 'z_b'] call MPI_BCAST(${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) #:endfor diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index e3379a7cfc..9522ee23c4 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -131,6 +131,7 @@ contains mapped_weno, mp_weno, weno_avg, & riemann_solver, wave_speeds, avg_state, & bc_x, bc_y, bc_z, & + x_a, y_a, z_a, x_b, y_b, z_b, & x_domain, y_domain, z_domain, & hypoelasticity, & ib, num_ibs, hyperelasticity, patch_ib, & @@ -138,8 +139,8 @@ contains fd_order, probe, num_probes, t_step_old, & alt_soundspeed, mixture_err, weno_Re_flux, & null_weights, precision, parallel_io, cyl_coord, & - rhoref, pref, bubbles, bubble_model, & - R0ref, & + rhoref, pref, bubbles, bubble_model, & + #:if not MFC_CASE_OPTIMIZATION nb, weno_order, num_fluids, & #:endif @@ -151,7 +152,7 @@ contains relax, relax_model, & palpha_eps, ptgalpha_eps, & R0_type, file_per_process, & - pi_fac, adv_n, adap_dt + pi_fac, adv_n, adap_dt, R0ref, ! Checking that an input file has been provided by the user. If it ! has, then the input file is read in, otherwise, simulation exits. diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index fa79f2f3e7..0a26b326da 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -2,7 +2,7 @@ COMMON = [ - "hypoelasticity",'hyperelasticity', "cyl_coord", "pref", "p", "parallel_io", + "hypoelasticity", "hyperelasticity", "cyl_coord", "pref", "p", "parallel_io", "Web", "poly_sigma", "case_dir", "thermal", "polytropic", "m", "mpp_lim", "R0ref", "adv_alphan", "num_fluids", "model_eqns", "nb", "weno_order", "rhoref", "bubbles", "Re_inv", "n", "precision", @@ -16,7 +16,7 @@ 'instability_wave', 'perturb_flow', 'perturb_flow_fluid', 'perturb_flow_mag', 'perturb_sph', 'perturb_sph_fluid', 'fluid_rho', 'num_patches', 'qbmm', 'dist_type', 'R0_type', 'sigR', 'sigV', 'rhoRV', "palpha_eps", "ptgalpha_eps", - 'pi_fac', 'ib', 'num_ibs', 'pre_stress' + 'pi_fac', 'ib', 'num_ibs','pre_stress' ] for ib_id in range(1, 10+1): From 527df2417ff55f9a36a2d1990749339dc21528c5 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 18 May 2024 18:37:59 -0500 Subject: [PATCH 097/380] clean up of submit job --- submit_gpu.sh | 17 ----------------- 1 file changed, 17 deletions(-) delete mode 100755 submit_gpu.sh diff --git a/submit_gpu.sh b/submit_gpu.sh deleted file mode 100755 index 21284621ba..0000000000 --- a/submit_gpu.sh +++ /dev/null @@ -1,17 +0,0 @@ - -## Pre-process -#./mfc.sh run /scratch/bciv/sremillard/sph_col_2atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# sph2 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/sremillard/sph_col_50atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 1:00:00 -# sph50 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/sremillard/sph_col_20atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 1:00:00 -# sph20 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/sremillard/sph_col_10atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 1:00:00 -# sph10 -t pre_process -a bciv-delta-gpu -c delta - -#./mfc.sh run /scratch/bciv/sremillard/pert_col_2atm_tenth/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# base -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/sremillard/sph_col_1atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# sph_1 -t pre_process -a bciv-delta-gpu -c delta - - -## simulation -./mfc.sh run /scratch/bciv/sremillard/sph_col_50atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 5:30:00 -# sph50 -t simulation -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/sremillard/sph_col_20atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 5:30:00 -# sph20 -t simulation -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/sremillard/sph_col_10atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 5:30:00 -# sph10 -t simulation -a bciv-delta-gpu -c delta - - From 5456f8a3325ab92d3a144666640f23efb342c95a Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 18 May 2024 23:04:49 -0500 Subject: [PATCH 098/380] pre_process, simulation compiles, grad xi halo region issue found --- src/common/m_rmt_tensor_calc.f90 | 217 ++++++++++++------------ src/common/m_variables_conversion.fpp | 22 +-- src/post_process/m_data_output.fpp | 26 +-- src/post_process/m_start_up.f90 | 10 +- src/pre_process/m_assign_variables.f90 | 44 ++--- src/pre_process/m_checker.f90 | 20 +-- src/pre_process/m_global_parameters.fpp | 2 +- src/pre_process/m_initial_condition.fpp | 25 ++- src/simulation/m_data_output.fpp | 12 +- src/simulation/m_hyperelastic.fpp | 74 ++++---- src/simulation/m_mpi_proxy.fpp | 2 +- 11 files changed, 232 insertions(+), 222 deletions(-) diff --git a/src/common/m_rmt_tensor_calc.f90 b/src/common/m_rmt_tensor_calc.f90 index 148db502d8..9ecdb99e9e 100644 --- a/src/common/m_rmt_tensor_calc.f90 +++ b/src/common/m_rmt_tensor_calc.f90 @@ -37,38 +37,38 @@ module m_rmt_tensor_calc contains subroutine s_calculate_btensor(q_prim_vf, j, k, l, btensor) + !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - type(scalar_field), dimension(num_dims*(num_dims+1)/2 + 1), intent(INOUT) :: btensor + type(scalar_field), dimension(b_size), intent(OUT) :: btensor integer, intent(IN) :: j, k, l real(kind(0d0)), dimension(num_dims**2) :: grad_xi, ftensor, tensorb - integer :: i ! calculate the grad_xi, grad_xi is a nxn tensor call s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !call s_calculate_ainverse(grad_xi,ftensor) + call s_calculate_ainverse(grad_xi,ftensor) ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !call s_calculate_atransposea(ftensor,tensorb) + call s_calculate_atransposea(ftensor,tensorb) ! btensor is symmetric, save the data space - print *, "I got here!" ! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j,k,l) = tensorb(1) - !if (num_dims > 1) then ! 2D - ! btensor(2)%sf(j,k,l) = tensorb(2) - ! btensor(3)%sf(j,k,l) = tensorb(4) - !end if - !if (num_dims > 2) then ! 3D - ! btensor(3)%sf(j,k,l) = tensorb(3) - ! btensor(4)%sf(j,k,l) = tensorb(5) - ! btensor(5)%sf(j,k,l) = tensorb(6) - ! btensor(6)%sf(j,k,l) = tensorb(9) - !end if + btensor(1)%sf(j, k, l) = tensorb(1) + if (num_dims > 1) then ! 2D + btensor(2)%sf(j,k,l) = tensorb(2) + btensor(3)%sf(j,k,l) = tensorb(4) + end if + if (num_dims > 2) then ! 3D + btensor(3)%sf(j,k,l) = tensorb(3) + btensor(4)%sf(j,k,l) = tensorb(5) + btensor(5)%sf(j,k,l) = tensorb(6) + btensor(6)%sf(j,k,l) = tensorb(9) + end if ! store the determinant at the last entry of the btensor sf - !btensor(b_size)%sf(j,k,l) = f_determinant(ftensor) - + btensor(b_size)%sf(j,k,l) = f_determinant(ftensor) + end subroutine s_calculate_btensor function f_determinant(tensor) + !$acc routine seq real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor real(kind(0d0)) :: f_determinant @@ -83,13 +83,14 @@ function f_determinant(tensor) end if ! error checking if (f_determinant == 0) then - print *, 'f_determinant :: ',f_determinant + print *, 'f_determinant :: ', f_determinant print *, 'ERROR: Determinant was zero' - call s_mpi_abort() + STOP end if end function f_determinant subroutine s_calculate_atransposea(tensor, ata) + !$acc routine seq real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ata @@ -113,6 +114,7 @@ subroutine s_calculate_atransposea(tensor, ata) end subroutine s_calculate_atransposea subroutine s_calculate_adjointa(tensor, dja) + !$acc routine seq real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: dja @@ -137,6 +139,7 @@ subroutine s_calculate_adjointa(tensor, dja) end subroutine s_calculate_adjointa subroutine s_calculate_ainverse(tensor, ainv) + !$acc routine seq real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ainv real(kind(0d0)), dimension(num_dims**2) :: dja @@ -149,115 +152,113 @@ end subroutine s_calculate_ainverse ! neo-Hookean only at this time, will need to be changed later function f_elastic_energy(btensor, j, k, l) + !$acc routine seq type(scalar_field), dimension(b_size), intent(IN) :: btensor integer, intent(IN) :: j, k, l real(kind(0d0)) :: invariant1, f_elastic_energy - invariant1 = btensor(1)%sf(j,k,l) + invariant1 = btensor(1)%sf(j, k, l) if (num_dims == 2) then - invariant1 = invariant1 + btensor(3)%sf(j,k,l) - elseif (num_dims == 3) then - invariant1 = invariant1 + btensor(4)%sf(j,k,l) + btensor(6)%sf(j,k,l) - end if + invariant1 = invariant1 + btensor(3)%sf(j, k, l) + elseif (num_dims == 3) then + invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + end if ! compute the invariant without the elastic modulus f_elastic_energy = 0.5d0*(invariant1 - 3)/btensor(b_size)%sf(j, k, l) end function f_elastic_energy subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) - + !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf real(kind(0d0)), dimension(num_dims**2), intent(INOUT) :: grad_xi integer, intent(IN) :: j, k, l integer :: i - print *, "num_dims :: ",num_dims + ! dxix/dx grad_xi(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j-1))) - !/(12d0*dx(j)) + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + if (num_dims > 1) then - ! dxiy / dx - grad_xi(2) = & - (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j-1))) - !/(12d0*dx(j)) - ! dxix / dy - grad_xi(3) = & - (q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k-1))) - !/(12d0*dy(k)) - ! dxiy / dy - grad_xi(4) = & - (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k-1))) - !/(12d0*dy(k)) - end if + ! dxiy / dx + grad_xi(2) = & + (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxix / dy + grad_xi(3) = & + (q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + grad_xi(4) = & + (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if ! 3D if (num_dims > 2) then - ! using results from upper if statement to map form 2x2 to 3x3 tensor - grad_xi(5) = grad_xi(4) - grad_xi(4) = grad_xi(3) - ! dxix / dz - grad_xi(3) = & - (q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - q_prim_vf(xibeg)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l-1))) - !/(12d0*dz(l)) - ! dxiy / dz - grad_xi(6) = & - (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l-1))) - !/(12d0*dz(l)) - ! dxiz / dx - grad_xi(7) = & - (q_prim_vf(xiend)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - q_prim_vf(xiend)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j-1))) - !/(12d0*dx(j)) - ! dxiz / dy - grad_xi(8) = & - (q_prim_vf(xiend)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k-1))) - !/(12d0*dy(k)) - ! dxiz / dz - grad_xi(9) = & - (q_prim_vf(xiend)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - q_prim_vf(xiend)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l-1))) - !/(12d0*dz(l)) - end if + ! using results from upper if statement to map form 2x2 to 3x3 tensor + grad_xi(5) = grad_xi(4) + grad_xi(4) = grad_xi(3) + ! dxix / dz + grad_xi(3) = & + (q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - q_prim_vf(xibeg)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + grad_xi(6) = & + (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dx + grad_xi(7) = & + (q_prim_vf(xiend)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - q_prim_vf(xiend)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dy + grad_xi(8) = & + (q_prim_vf(xiend)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - q_prim_vf(xiend)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dz + grad_xi(9) = & + (q_prim_vf(xiend)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - q_prim_vf(xiend)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if - - !if (proc_rank ==0) then - ! do i = 1, num_dims**2 - ! print *, 'grad_xi(',i,') ::', grad_xi(i) - ! end do - !end if - end subroutine s_compute_grad_xi + if (proc_rank ==0) then + do i = 1, num_dims**2 + print *, 'grad_xi(',i,') ::', grad_xi(i) + end do + do i = 1, 5 + print *, 'i :: ',i,", qprim :: ",q_prim_vf(xiend)%sf(j,k,l+i-3) + end do + print *,'x_cb :: ',x_cb(j),", and x_cb-1 :: ",x_cb(j-1) + print *,'z_cb :: ',z_cb(l),", and z_cb-1 :: ",z_cb(l-1) + STOP + end if + end subroutine s_compute_grad_xi end module m_rmt_tensor_calc diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 6d8b2a71e6..1b8f51e784 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -873,9 +873,7 @@ contains type(int_bounds_info), optional, intent(IN) :: ix, iy, iz - type(scalar_field), & - optional, dimension(num_dims*(num_dims+1)/2 + 1), & - intent(OUT) :: qK_btensor_vf + type(scalar_field), optional, dimension(b_size), intent(OUT) :: qK_btensor_vf real(kind(0d0)), dimension(num_fluids) :: alpha_K, alpha_rho_K real(kind(0d0)), dimension(2) :: Re_K @@ -897,10 +895,6 @@ contains real(kind(0d0)) :: pres - real(kind(0d0)) :: detG, e_e - - real(kind(0d0)), dimension(num_dims**2) :: gtensor, getge, ghat - integer :: i, j, k, l, q !< Generic loop iterators real(kind(0.d0)) :: ntmp @@ -1091,7 +1085,7 @@ contains dimension(sys_size), & intent(INOUT) :: q_cons_vf - type(scalar_field), dimension(num_dims**2) :: q_btensor_vf + type(scalar_field), dimension(b_size) :: q_btensor ! Density, specific heat ratio function, liquid stiffness function ! and dynamic pressure, as defined in the incompressible flow sense, @@ -1105,10 +1099,11 @@ contains real(kind(0d0)), dimension(nb) :: Rtmp real(kind(0d0)) :: G = 0d0 real(kind(0d0)), dimension(2) :: Re_K - real(kind(0d0)) :: detG, e_e - real(kind(0d0)), dimension(num_dims**2) :: gtensor, getge, ghat integer :: i, j, k, l, q !< Generic loop iterators + do l = 1, b_size + @:ALLOCATE(q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) + end do #ifndef MFC_SIMULATION ! Converting the primitive variables to the conservative variables @@ -1224,10 +1219,9 @@ contains do i = stress_idx%beg, stress_idx%end q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) end do - ! TODO - !call s_calculate_btensor(qK_prim_vf, j, k, l, q_btensor_vf) - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) !+ & - !G*f_elastic_energy(q_btensor_vf, j, k, l) + call s_calculate_btensor(q_prim_vf, j, k, l, q_btensor) + q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & + G*f_elastic_energy(q_btensor, j, k, l) end if end do diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 4c9926e54a..6a2fc410be 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -993,11 +993,11 @@ contains allocate (x_d1(m*n)) allocate (y_d1(m*n)) counter = 0 - maxalph_loc = 0d0 + maxalph_loc = 0d0 do k = 0, p do j = 0, n - do i = 0, m - if (q_prim_vf(E_idx + 2)%sf(i, j, k) > maxalph_loc) then + do i = 0, m + if (q_prim_vf(E_idx + 2)%sf(i, j, k) > maxalph_loc) then maxalph_loc = q_prim_vf(E_idx + 2)%sf(i, j, k) end if end do @@ -1024,7 +1024,7 @@ contains counter = counter + 1 x_d1(counter) = x_cc(j) y_d1(counter) = y_cc(k) - euc_d = sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2) + euc_d = sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2) tgp = sqrt(dx(j)**2 + dy(k)**2) else do i = 1, counter @@ -1032,7 +1032,7 @@ contains cycle OLoop elseif (euc_d > tgp .and. i == counter .and. x_cc(j) < 1.5 .and. y_cc(k) < 1.5) then !artificial bounding on the interface for bubble at a centroid. - !need to remove eventually. + !need to remove eventually. counter = counter + 1 x_d1(counter) = x_cc(j) y_d1(counter) = y_cc(k) @@ -1070,7 +1070,7 @@ contains type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer, intent(IN) :: t_step real(kind(0d0)) :: Elk, Egk, Elint, Egint, Vb, Vl, pres_av - real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, MaxMa, MaxMa_glb, maxvel, c, Ma, H + real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, MaxMa, MaxMa_glb, maxvel, c, Ma, H real(kind(0d0)), dimension(num_dims) :: vel real(kind(0d0)), dimension(num_fluids) :: gammas, pi_infs, adv integer :: i, j, k, l, s !looping indicies @@ -1094,18 +1094,18 @@ contains gamma = 0d0 pi_inf = 0d0 pres = q_prim_vf(E_idx)%sf(i, j, k) - Egint = Egint + q_prim_vf(E_idx+2)%sf(i, j, k)*(fluid_pp(2)%gamma*pres)*dV + Egint = Egint + q_prim_vf(E_idx + 2)%sf(i, j, k)*(fluid_pp(2)%gamma*pres)*dV do s = 1, num_dims vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) Egk = Egk + 0.5d0*q_prim_vf(E_idx + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV Elk = Elk + 0.5d0*q_prim_vf(E_idx + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV - if (dabs(vel(s)) .gt. maxvel) then + if (dabs(vel(s)) > maxvel) then maxvel = dabs(vel(s)) - endif + end if end do do l = 1, adv_idx%end - E_idx adv(l) = q_prim_vf(E_idx + l)%sf(i, j, k) - gamma = gamma+ adv(l)*fluid_pp(l)%gamma + gamma = gamma + adv(l)*fluid_pp(l)%gamma pi_inf = pi_inf + adv(l)*fluid_pp(l)%pi_inf rho = rho + adv(l)*q_prim_vf(l)%sf(i, j, k) end do @@ -1117,9 +1117,9 @@ contains H, adv, 0d0, c) Ma = maxvel/c - if (Ma > MaxMa .and. adv(1) > 1.0d0-1.0d-6) then - MaxMa = Ma - endif + if (Ma > MaxMa .and. adv(1) > 1.0d0 - 1.0d-6) then + MaxMa = Ma + end if Vl = Vl + adv(1)*dV Vb = Vb + adv(2)*dV pres_av = pres_av + adv(1)*pres*dV diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index a69ba333db..6753d35e24 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -155,12 +155,12 @@ subroutine s_perform_time_step(t_step) ! Populating the buffer regions of the conservative variables if (buff_size > 0) then - call s_populate_conservative_variables_buffer_regions() + call s_populate_conservative_variables_buffer_regions() end if - !if (proc_rank == 0) print *, "I got here 1" + !if (proc_rank == 0) print *, "I got here 1" ! Converting the conservative variables to the primitive ones call s_convert_conservative_to_primitive_variables(q_cons_vf, q_prim_vf) - !if (proc_rank == 0) print *, "I got here 2" + !if (proc_rank == 0) print *, "I got here 2" end subroutine s_perform_time_step @@ -328,12 +328,12 @@ subroutine s_save_data(t_step, varname, pres, c, H) write (varname, '(A,I0)') 'xi', i end if call s_write_variable_to_formatted_database_file(varname, t_step) - end if + end if varname(:) = ' ' end do end if !if (proc_rank == 0) print *, "I got here 4" - ! ---------------------------------------------------------------------- + ! ---------------------------------------------------------------------- ! Adding the pressure to the formatted database file ------------------- if (pres_wrt .or. prim_vars_wrt) then diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 index 4377cf5f0f..344ad83ea3 100644 --- a/src/pre_process/m_assign_variables.f90 +++ b/src/pre_process/m_assign_variables.f90 @@ -444,30 +444,30 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & ! Elastic Shear Stress if (hyperelasticity) then - xi_cart(1) = x_cc(j) - xi_cart(2) = y_cc(k) - xi_cart(3) = z_cc(l) - if (pre_stress) then ! pre stressed initial condition in spatial domain - rcoord = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2)) - theta = atan2(y_cc(k), x_cc(j)) - phi = atan2(sqrt(x_cc(j)**2 + y_cc(k)**2), z_cc(l)) - xi_sph = (rcoord**3 - R0ref**3 + 1d0 )**( 1d0 / 3d0 ) !spherical coord, assuming Rmax=1 - xi_cart(1) = xi_sph*sin(phi)*cos(theta) - xi_cart(2) = xi_sph*sin(phi)*sin(theta) - xi_cart(3) = xi_sph*cos(phi) - end if - do i = 1, (stress_idx%end - stress_idx%beg) + 1 - q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = xi_cart(i) - - !(eta*xi_cart(i) + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1)) - - !if (proc_rank ==0) print *, 'q(',i,') ::', q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) + xi_cart(1) = x_cc(j) + xi_cart(2) = y_cc(k) + xi_cart(3) = z_cc(l) + if (pre_stress) then ! pre stressed initial condition in spatial domain + rcoord = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2)) + theta = atan2(y_cc(k), x_cc(j)) + phi = atan2(sqrt(x_cc(j)**2 + y_cc(k)**2), z_cc(l)) + xi_sph = (rcoord**3 - R0ref**3 + 1d0)**(1d0/3d0) !spherical coord, assuming Rmax=1 + xi_cart(1) = xi_sph*sin(phi)*cos(theta) + xi_cart(2) = xi_sph*sin(phi)*sin(theta) + xi_cart(3) = xi_sph*cos(phi) + end if + do i = 1, (stress_idx%end - stress_idx%beg) + 1 + q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = xi_cart(i) + + !(eta*xi_cart(i) + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1)) + + !if (proc_rank ==0) print *, 'q(',i,') ::', q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) !if (proc_rank == 0) then - ! write(*,*) 'q(',i,') :: ',q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l)& - ! ,', xi_cart :: ',xi_cart(i) + ! write(*,*) 'q(',i,') :: ',q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l)& + ! ,', xi_cart :: ',xi_cart(i) !end if - end do - end if + end do + end if !if (proc_rank ==0) stop !if(proc_rank == 0) print *, 'I got to after hyperelasticity for patch :: ', patch_id diff --git a/src/pre_process/m_checker.f90 b/src/pre_process/m_checker.f90 index 25b2fd5f34..e427660353 100644 --- a/src/pre_process/m_checker.f90 +++ b/src/pre_process/m_checker.f90 @@ -104,7 +104,7 @@ subroutine s_check_inputs() call s_mpi_abort('hypoelasticity requires model_eqns = 2'// & 'exiting ...') end if - + if (hyperelasticity .and. (model_eqns /= 2)) then call s_mpi_abort('hyperelasticity requires model_eqns =2'// & 'exiting ...') @@ -120,7 +120,7 @@ subroutine s_check_inputs() 'exiting ...') end if - ! phase change checkers. + ! phase change checkers. if (relax) then if (model_eqns /= 3) then call s_mpi_abort('phase change requires model_eqns = 3. '// & @@ -715,14 +715,14 @@ subroutine s_check_inputs() call s_mpi_abort('Unsupported value of '// & 'fluid_pp('//trim(iStr)//')%'// & 'cv. Make sure cv is positive. Exiting ...') - ! elseif ((hyperelasticity .or. hypoelasticity) & - ! .and. & - ! fluid_pp(i)%G /= dflt_real) then - ! call s_mpi_abort('Unsupported combination '// & - ! 'of values of model_eqns '// & - ! 'and fluid_pp('//trim(iStr)//')%'// & - ! 'hyperelasticity. Exiting ...') - end if + ! elseif ((hyperelasticity .or. hypoelasticity) & + ! .and. & + ! fluid_pp(i)%G /= dflt_real) then + ! call s_mpi_abort('Unsupported combination '// & + ! 'of values of model_eqns '// & + ! 'and fluid_pp('//trim(iStr)//')%'// & + ! 'hyperelasticity. Exiting ...') + end if end do ! Moving Boundaries Checks: x boundaries diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 19dc43a71e..be128bdcd6 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -597,7 +597,7 @@ contains if (hyperelasticity) then ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + stress_idx%end = sys_size + num_dims !(num_dims*(num_dims + 1))/2 sys_size = stress_idx%end ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp index 8d880893e1..7d5aacc300 100644 --- a/src/pre_process/m_initial_condition.fpp +++ b/src/pre_process/m_initial_condition.fpp @@ -48,6 +48,8 @@ module m_initial_condition type(scalar_field), allocatable, dimension(:) :: q_cons_vf !< conservative variables + !type(scalar_field), allocatable, dimension(:) :: q_btensor !< btensor vector field + integer, allocatable, dimension(:, :, :) :: patch_id_fp !< !! Bookkepping variable used to track the patch identities (id) associated !! with each of the cells in the computational domain. Note that only one @@ -69,12 +71,17 @@ contains ! Allocating the primitive and conservative variables allocate (q_prim_vf(1:sys_size)) allocate (q_cons_vf(1:sys_size)) + !allocate (q_btensor(1:b_size)) do i = 1, sys_size allocate (q_prim_vf(i)%sf(0:m, 0:n, 0:p)) allocate (q_cons_vf(i)%sf(0:m, 0:n, 0:p)) end do + !do i = 1, b_size + ! allocate (q_btensor(i)%sf(0:m, 0:n, 0:p)) + !end do + ! Allocating the patch identities bookkeeping variable allocate (patch_id_fp(0:m, 0:n, 0:p)) @@ -100,6 +107,12 @@ contains q_prim_vf(i)%sf = dflt_real end do + ! Similarly for the btensor field + !do i = 1, b_size + ! q_btensor(i)%sf = dflt_real + !end do + + ! Setting default values for patch identities bookkeeping variable. ! This is necessary to avoid any confusion in the assessment of the ! extent of application that the overwrite permissions give a patch @@ -123,10 +136,10 @@ contains ! Converting the conservative variables to the primitive ones given ! preexisting initial condition data files were read in on start-up - !if (old_ic) then - ! call s_convert_conservative_to_primitive_variables(q_cons_vf, & - ! q_prim_vf) - !end if + if (old_ic) then + call s_convert_conservative_to_primitive_variables(q_cons_vf, & + q_prim_vf) + end if ! 3D Patch Geometries ============================================= if (p > 0) then @@ -319,8 +332,8 @@ contains q_cons_vf) !TODO REMOVE AFTER DEBUGGING - call s_convert_conservative_to_primitive_variables(q_cons_vf, & - q_prim_vf) + !call s_convert_conservative_to_primitive_variables(q_cons_vf, & + ! q_prim_vf) if (qbmm .and. .not. polytropic) then !Initialize pb and mv diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 1c60475d5f..b7061342f8 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -331,12 +331,12 @@ contains ! Compute mixture sound speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c) - - if ( c .lt. 10d-12 ) then - print*, 'code has crashed at processor: ',proc_rank,' at j :: ',j,', k :: ',k,' l :: ',l,'with alph1a ::',alpha(1),'and alpha2 ::', alpha(2) - print*, 'ICFL ERROR, I TOLD YOU AGAIN!' - ! call s_mpi_abort() - endif + + if (c < 10d-12) then + print *, 'code has crashed at processor: ', proc_rank, ' at j :: ', j, ', k :: ', k, ' l :: ', l, 'with alph1a ::', alpha(1), 'and alpha2 ::', alpha(2) + print *, 'ICFL ERROR, I TOLD YOU AGAIN!' + ! call s_mpi_abort() + end if if (grid_geometry == 3) then if (k == 0) then diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 3cf211f9c8..9e00a4d437 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -24,60 +24,62 @@ module m_hyperelastic contains subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf) - type(scalar_field), dimension(sys_size), intent(INOUT) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(IN) :: btensor - - real(kind(0d0)), dimension(b_size) :: sigma, tensorb, devbtensor - real(kind(0d0)) :: jacobian - integer :: i, j, k, l !< Generic loop iterators - - - !if (proc_rank ==0) print*, 'this is btensor ::', btensor - ! extracting the nxn tensor for the calculation - !$acc parallel loop collapse(3) gang vector default(present) - do l = 0, p - do k = 0, n - do j = 0, m - do i = 1, b_size-1 - tensorb(i) = btensor(i)%sf(j, k, l) - end do - jacobian = btensor(b_size+1)%sf(j, k, l) - call s_calculate_deviatoric(tensorb, devbtensor) - sigma(:) = devbtensor(:)/jacobian - do i = 1, b_size-1 - q_prim_vf(i)%sf(j, k, l) = sigma(i) + !!!!$acc routine seq + type(scalar_field), dimension(sys_size), intent(INOUT) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(IN) :: btensor + + real(kind(0d0)), dimension(b_size) :: sigma, tensorb, devbtensor + real(kind(0d0)) :: jacobian + integer :: i, j, k, l !< Generic loop iterators + + !if (proc_rank ==0) print*, 'this is btensor ::', btensor + ! extracting the nxn tensor for the calculation + !$acc parallel loop collapse(3) gang vector default(present) + do l = 0, p + do k = 0, n + do j = 0, m + do i = 1, b_size - 1 + tensorb(i) = btensor(i)%sf(j, k, l) + end do + jacobian = btensor(b_size + 1)%sf(j, k, l) + call s_calculate_deviatoric(tensorb, devbtensor) + sigma(:) = devbtensor(:)/jacobian + do i = 1, b_size - 1 + q_prim_vf(i)%sf(j, k, l) = sigma(i) + end do + end do end do - end do - end do - end do - if (proc_rank ==0) print*, 'J is ::', jacobian, 'this is sigma ::', sigma + end do + if (proc_rank == 0) print *, 'J is ::', jacobian, 'this is sigma ::', sigma end subroutine s_calculate_cauchy_from_btensor function f_trace(symtensor) + !!!$acc routine seq real(kind(0d0)), dimension(num_dims**2), intent(IN) :: symtensor - real(kind(0d0)) :: f_trace + real(kind(0d0)) :: f_trace - f_trace = symtensor(1) + f_trace = symtensor(1) if (num_dims == 2) then - f_trace = symtensor(1)+symtensor(3) + f_trace = symtensor(1) + symtensor(3) else - f_trace = symtensor(1)+symtensor(4)+symtensor(6) - endif + f_trace = symtensor(1) + symtensor(4) + symtensor(6) + end if end function f_trace subroutine s_calculate_deviatoric(symtensor, devtensor) + !!!!$acc routine seq real(kind(0d0)), dimension(num_dims*2 + 1), intent(IN) :: symtensor real(kind(0d0)), dimension(num_dims*2), intent(OUT) :: devtensor real(kind(0d0)) :: trace devtensor = symtensor trace = f_trace(symtensor) - devtensor(1) = symtensor(1) - (1d0/3d0)*trace + devtensor(1) = symtensor(1) - (1d0/3d0)*trace if (num_dims == 2) then - devtensor(3) = symtensor(3) - (1d0/3d0)*trace + devtensor(3) = symtensor(3) - (1d0/3d0)*trace else - devtensor(4) = symtensor(4) - (1d0/3d0)*trace - devtensor(6) = symtensor(6) - (1d0/3d0)*trace - end if + devtensor(4) = symtensor(4) - (1d0/3d0)*trace + devtensor(6) = symtensor(6) - (1d0/3d0)*trace + end if end subroutine s_calculate_deviatoric end module m_hyperelastic diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index 42a269212c..e7aeb89a4f 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -200,7 +200,7 @@ contains & 'bc_y%vb1','bc_y%vb2','bc_y%vb3','bc_y%ve1','bc_y%ve2','bc_y%ve3', & & 'bc_z%vb1','bc_z%vb2','bc_z%vb3','bc_z%ve1','bc_z%ve2','bc_z%ve3', & & 'x_domain%beg', 'x_domain%end', 'y_domain%beg', 'y_domain%end', & - & 'z_domain%beg', 'z_domain%end', 'x_a', 'x_b', 'y_a', 'y_b', 'z_a', & + & 'z_domain%beg', 'z_domain%end', 'x_a', 'x_b', 'y_a', 'y_b', 'z_a', & & 'z_b'] call MPI_BCAST(${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) #:endfor From c61706405d366957bd2a1e0cd4439e4973663b4c Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 19 May 2024 23:16:32 -0500 Subject: [PATCH 099/380] compilation issue with m_variable conversion, will need to transfer btensor calculation to m_variables_conversion --- src/common/m_rmt_tensor_calc.f90 | 264 ----------- src/common/m_rmt_tensor_calc.fpp | 592 ++++++++++++++++++++++++ src/common/m_variables_conversion.fpp | 70 +-- src/pre_process/m_initial_condition.fpp | 17 - src/simulation/m_hypoelastic.fpp | 15 + src/simulation/m_rhs.fpp | 11 +- src/simulation/m_start_up.fpp | 5 + 7 files changed, 661 insertions(+), 313 deletions(-) delete mode 100644 src/common/m_rmt_tensor_calc.f90 create mode 100644 src/common/m_rmt_tensor_calc.fpp diff --git a/src/common/m_rmt_tensor_calc.f90 b/src/common/m_rmt_tensor_calc.f90 deleted file mode 100644 index 9ecdb99e9e..0000000000 --- a/src/common/m_rmt_tensor_calc.f90 +++ /dev/null @@ -1,264 +0,0 @@ -!> -!! @file m_variables_conversion.f90 -!! @brief Contains module m_variables_conversion -!#:include 'macros.fpp' - -!> @brief This module consists of subroutines used in the calculation of matrix -!! operations for the reference map tensor - -module m_rmt_tensor_calc - - ! Dependencies ============================================================= - use m_derived_types !< Definitions of the derived types - - use m_global_parameters !< Definitions of the global parameters - - use m_mpi_proxy !< Message passing interface (MPI) module proxy - - use m_helper - ! ========================================================================== - - implicit none - - private; public :: s_calculate_btensor, & - f_elastic_energy - -#ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), grad_xi) - !$acc declare link(grad_xi) -#else - real(kind(0d0)), allocatable, dimension(:) :: grad_xi - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - !$acc declare create(grad_xi) -#endif - -contains - - subroutine s_calculate_btensor(q_prim_vf, j, k, l, btensor) - !$acc routine seq - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(OUT) :: btensor - integer, intent(IN) :: j, k, l - real(kind(0d0)), dimension(num_dims**2) :: grad_xi, ftensor, tensorb - - ! calculate the grad_xi, grad_xi is a nxn tensor - call s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) - ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - call s_calculate_ainverse(grad_xi,ftensor) - ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - call s_calculate_atransposea(ftensor,tensorb) - ! btensor is symmetric, save the data space - ! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensorb(1) - if (num_dims > 1) then ! 2D - btensor(2)%sf(j,k,l) = tensorb(2) - btensor(3)%sf(j,k,l) = tensorb(4) - end if - if (num_dims > 2) then ! 3D - btensor(3)%sf(j,k,l) = tensorb(3) - btensor(4)%sf(j,k,l) = tensorb(5) - btensor(5)%sf(j,k,l) = tensorb(6) - btensor(6)%sf(j,k,l) = tensorb(9) - end if - ! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j,k,l) = f_determinant(ftensor) - - end subroutine s_calculate_btensor - - function f_determinant(tensor) - !$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)) :: f_determinant - - if (num_dims == 1) then - f_determinant = tensor(1) - elseif (num_dims == 2) then - f_determinant = tensor(1)*tensor(4) - tensor(2)*tensor(3) - else - f_determinant = tensor(1)*(tensor(5)*tensor(9) - tensor(6)*tensor(8)) & - - tensor(2)*(tensor(4)*tensor(9) - tensor(6)*tensor(7)) & - + tensor(3)*(tensor(4)*tensor(8) - tensor(5)*tensor(7)) - end if - ! error checking - if (f_determinant == 0) then - print *, 'f_determinant :: ', f_determinant - print *, 'ERROR: Determinant was zero' - STOP - end if - end function f_determinant - - subroutine s_calculate_atransposea(tensor, ata) - !$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ata - - ata(1) = tensor(1)**2 - if (num_dims == 2) then - ata(1) = ata(1) + tensor(3)**2 - ata(2) = tensor(1)*tensor(2) + tensor(3)*tensor(4) - ata(3) = ata(2) - ata(4) = tensor(2)**2 + tensor(4)**2 - elseif (num_dims == 3) then - ata(1) = ata(1) + tensor(4)**2 + tensor(7)**2 - ata(5) = tensor(2) + tensor(5)**2 + tensor(8)**2 - ata(9) = tensor(3) + tensor(6)**2 + tensor(9)**2 - ata(2) = tensor(1)*tensor(2) + tensor(4)*tensor(5) + tensor(7)*tensor(8) - ata(3) = tensor(1)*tensor(3) + tensor(4)*tensor(6) + tensor(7)*tensor(9) - ata(6) = tensor(2)*tensor(3) + tensor(5)*tensor(6) + tensor(8)*tensor(9) - ata(4) = ata(2) - ata(7) = ata(3) - ata(8) = ata(4) - end if - end subroutine s_calculate_atransposea - - subroutine s_calculate_adjointa(tensor, dja) - !$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: dja - - if (num_dims == 1) then - dja(1) = 1 - elseif (num_dims == 2) then - dja(1) = tensor(4) - dja(2) = -tensor(3) - dja(3) = -tensor(2) - dja(4) = tensor(1) - elseif (num_dims == 3) then - dja(1) = tensor(5)*tensor(9) - tensor(6)*tensor(8) - dja(2) = -(tensor(2)*tensor(9) - tensor(3)*tensor(8)) - dja(3) = tensor(2)*tensor(6) - tensor(3)*tensor(5) - dja(4) = -(tensor(4)*tensor(9) - tensor(6)*tensor(7)) - dja(5) = tensor(1)*tensor(9) - tensor(3)*tensor(7) - dja(6) = -(tensor(1)*tensor(6) - tensor(4)*tensor(3)) - dja(7) = tensor(4)*tensor(8) - tensor(5)*tensor(7) - dja(8) = -(tensor(1)*tensor(8) - tensor(2)*tensor(7)) - dja(9) = tensor(1)*tensor(5) - tensor(2)*tensor(4) - end if - end subroutine s_calculate_adjointa - - subroutine s_calculate_ainverse(tensor, ainv) - !$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ainv - real(kind(0d0)), dimension(num_dims**2) :: dja - real(kind(0d0)) :: det - integer :: i - call s_calculate_adjointa(tensor, dja) - det = f_determinant(tensor) - ainv(:) = dja(:)/det - end subroutine s_calculate_ainverse - - ! neo-Hookean only at this time, will need to be changed later - function f_elastic_energy(btensor, j, k, l) - !$acc routine seq - type(scalar_field), dimension(b_size), intent(IN) :: btensor - integer, intent(IN) :: j, k, l - real(kind(0d0)) :: invariant1, f_elastic_energy - - invariant1 = btensor(1)%sf(j, k, l) - - if (num_dims == 2) then - invariant1 = invariant1 + btensor(3)%sf(j, k, l) - elseif (num_dims == 3) then - invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) - end if - ! compute the invariant without the elastic modulus - f_elastic_energy = 0.5d0*(invariant1 - 3)/btensor(b_size)%sf(j, k, l) - end function f_elastic_energy - - subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) - !$acc routine seq - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(num_dims**2), intent(INOUT) :: grad_xi - integer, intent(IN) :: j, k, l - integer :: i - - ! dxix/dx - grad_xi(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - - - if (num_dims > 1) then - ! dxiy / dx - grad_xi(2) = & - (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxix / dy - grad_xi(3) = & - (q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - grad_xi(4) = & - (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - ! 3D - if (num_dims > 2) then - ! using results from upper if statement to map form 2x2 to 3x3 tensor - grad_xi(5) = grad_xi(4) - grad_xi(4) = grad_xi(3) - ! dxix / dz - grad_xi(3) = & - (q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - q_prim_vf(xibeg)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - grad_xi(6) = & - (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dx - grad_xi(7) = & - (q_prim_vf(xiend)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - q_prim_vf(xiend)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dy - grad_xi(8) = & - (q_prim_vf(xiend)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dz - grad_xi(9) = & - (q_prim_vf(xiend)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - q_prim_vf(xiend)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - - if (proc_rank ==0) then - do i = 1, num_dims**2 - print *, 'grad_xi(',i,') ::', grad_xi(i) - end do - do i = 1, 5 - print *, 'i :: ',i,", qprim :: ",q_prim_vf(xiend)%sf(j,k,l+i-3) - end do - print *,'x_cb :: ',x_cb(j),", and x_cb-1 :: ",x_cb(j-1) - print *,'z_cb :: ',z_cb(l),", and z_cb-1 :: ",z_cb(l-1) - STOP - end if - end subroutine s_compute_grad_xi - -end module m_rmt_tensor_calc diff --git a/src/common/m_rmt_tensor_calc.fpp b/src/common/m_rmt_tensor_calc.fpp new file mode 100644 index 0000000000..d2ad564839 --- /dev/null +++ b/src/common/m_rmt_tensor_calc.fpp @@ -0,0 +1,592 @@ +#:include 'macros.fpp' + +!> +!! @file m_variables_conversion.f90 +!! @brief Contains module m_variables_conversion + +!> @brief This module consists of subroutines used in the calculation of matrix +!! operations for the reference map tensor + +module m_rmt_tensor_calc + + ! Dependencies ============================================================= + use m_derived_types !< Definitions of the derived types + + use m_global_parameters !< Definitions of the global parameters + + ! ========================================================================== + + implicit none + + private; public :: s_initialize_rmt_module, & + s_finalize_rmt_module, & + s_calculate_btensor, & + f_elastic_energy + + +#ifdef CRAY_ACC_WAR + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), grad_xi) + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), ftensor) + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), tensorb) + !$acc declare link(grad_xi,ftensor,tensorb) +#else + real(kind(0d0)), allocatable, dimension(:) :: grad_xi, ftensor, tensorb + !$acc declare create(grad_xi,ftensor,tensorb) +#endif + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz + +contains + + subroutine s_initialize_rmt_module() ! -------------------- + + integer :: i + #ifdef MFC_SIMULATION + @:ALLOCATE(grad_xi(1:num_dims**2)) + @:ALLOCATE(ftensor(1:num_dims**2)) + @:ALLOCATE(tensorb(1:num_dims**2)) + #endif + grad_xi(:) = 0d0 + ftensor(:) = 0d0 + tensorb(:) = 0d0 +!$acc update device(grad_xi,ftensor,tensorb) + + end subroutine s_initialize_rmt_module + + subroutine s_calculate_btensor(q_prim_vf, btensor) + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(OUT) :: btensor + integer :: j, k, l + !real(kind(0d0)), dimension(num_dims**2) :: grad_xi, ftensor, tensorb + + !$acc parallel loop collapse(3) gang vector default(present) private(grad_xi,ftensor,tensorb) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe + ! STEP 1: calculate the grad_xi, grad_xi is a nxn tensor + call s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) + ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + call s_calculate_ainverse(grad_xi,ftensor) + ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + call s_calculate_atransposea(ftensor,tensorb) + ! btensor is symmetric, save the data space + ! 1: 1D, 3: 2D, 6: 3D + btensor(1)%sf(j, k, l) = tensorb(1) + if (num_dims > 1) then ! 2D + btensor(2)%sf(j,k,l) = tensorb(2) + btensor(3)%sf(j,k,l) = tensorb(4) + end if + if (num_dims > 2) then ! 3D + btensor(3)%sf(j,k,l) = tensorb(3) + btensor(4)%sf(j,k,l) = tensorb(5) + btensor(5)%sf(j,k,l) = tensorb(6) + btensor(6)%sf(j,k,l) = tensorb(9) + end if + ! store the determinant at the last entry of the btensor sf + btensor(b_size)%sf(j,k,l) = f_determinant(ftensor) + end do + end do + end do + !$acc end parallel loop + + end subroutine s_calculate_btensor + + function f_determinant(tensor) + !$acc routine seq + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)) :: f_determinant + + if (num_dims == 1) then + f_determinant = tensor(1) + elseif (num_dims == 2) then + f_determinant = tensor(1)*tensor(4) - tensor(2)*tensor(3) + else + f_determinant = tensor(1)*(tensor(5)*tensor(9) - tensor(6)*tensor(8)) & + - tensor(2)*(tensor(4)*tensor(9) - tensor(6)*tensor(7)) & + + tensor(3)*(tensor(4)*tensor(8) - tensor(5)*tensor(7)) + end if + ! error checking + if (f_determinant == 0) then + print *, 'f_determinant :: ', f_determinant + print *, 'ERROR: Determinant was zero' + !STOP + end if + end function f_determinant + + subroutine s_calculate_atransposea(tensor, ata) + !$acc routine seq + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ata + + ata(1) = tensor(1)**2 + if (num_dims == 2) then + ata(1) = ata(1) + tensor(3)**2 + ata(2) = tensor(1)*tensor(2) + tensor(3)*tensor(4) + ata(3) = ata(2) + ata(4) = tensor(2)**2 + tensor(4)**2 + elseif (num_dims == 3) then + ata(1) = ata(1) + tensor(4)**2 + tensor(7)**2 + ata(5) = tensor(2) + tensor(5)**2 + tensor(8)**2 + ata(9) = tensor(3) + tensor(6)**2 + tensor(9)**2 + ata(2) = tensor(1)*tensor(2) + tensor(4)*tensor(5) + tensor(7)*tensor(8) + ata(3) = tensor(1)*tensor(3) + tensor(4)*tensor(6) + tensor(7)*tensor(9) + ata(6) = tensor(2)*tensor(3) + tensor(5)*tensor(6) + tensor(8)*tensor(9) + ata(4) = ata(2) + ata(7) = ata(3) + ata(8) = ata(4) + end if + end subroutine s_calculate_atransposea + + subroutine s_calculate_adjointa(tensor, dja) + !$acc routine seq + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: dja + + if (num_dims == 1) then + dja(1) = 1 + elseif (num_dims == 2) then + dja(1) = tensor(4) + dja(2) = -tensor(3) + dja(3) = -tensor(2) + dja(4) = tensor(1) + elseif (num_dims == 3) then + dja(1) = tensor(5)*tensor(9) - tensor(6)*tensor(8) + dja(2) = -(tensor(2)*tensor(9) - tensor(3)*tensor(8)) + dja(3) = tensor(2)*tensor(6) - tensor(3)*tensor(5) + dja(4) = -(tensor(4)*tensor(9) - tensor(6)*tensor(7)) + dja(5) = tensor(1)*tensor(9) - tensor(3)*tensor(7) + dja(6) = -(tensor(1)*tensor(6) - tensor(4)*tensor(3)) + dja(7) = tensor(4)*tensor(8) - tensor(5)*tensor(7) + dja(8) = -(tensor(1)*tensor(8) - tensor(2)*tensor(7)) + dja(9) = tensor(1)*tensor(5) - tensor(2)*tensor(4) + end if + end subroutine s_calculate_adjointa + + subroutine s_calculate_ainverse(tensor, ainv) + !$acc routine seq + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ainv + real(kind(0d0)), dimension(num_dims**2) :: dja + real(kind(0d0)) :: det + + call s_calculate_adjointa(tensor, dja) + ainv(:) = dja(:)/f_determinant(tensor) + + end subroutine s_calculate_ainverse + + ! neo-Hookean only at this time, will need to be changed later + function f_elastic_energy(btensor, j, k, l) + !$acc routine seq + type(scalar_field), dimension(b_size), intent(IN) :: btensor + integer, intent(IN) :: j, k, l + real(kind(0d0)) :: invariant1, f_elastic_energy + + invariant1 = btensor(1)%sf(j, k, l) + + if (num_dims == 2) then + invariant1 = invariant1 + btensor(3)%sf(j, k, l) + elseif (num_dims == 3) then + invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + end if + ! compute the invariant without the elastic modulus + f_elastic_energy = 0.5d0*(invariant1 - 3)/btensor(b_size)%sf(j, k, l) + end function f_elastic_energy + + subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) + !$acc routine seq + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + real(kind(0d0)), dimension(num_dims**2), intent(INOUT) :: grad_xi + integer, intent(IN) :: j, k, l + integer :: i + + if(j == 0) then + ! dxix/dx + grad_xi(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l) ) & + /(12d0*(x_cb(j+1) - x_cb(j))) + else if (j == 1) then + ! dxix/dx + grad_xi(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + q_prim_vf(xibeg)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == m - 1) then + ! dxix/dx + grad_xi(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - q_prim_vf(xibeg)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == m) then + ! dxix/dx + grad_xi(1) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l) ) & + /(12d0*(x_cb(j) - x_cb(j-1))) + else + ! dxix/dx + grad_xi(1) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + if (num_dims > 1) then + if(j == 0) then + ! dxiy / dx + grad_xi(2) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg+1)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg+1)%sf(j + 4, k, l) ) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + else if (j == 1) then + ! dxiy / dx + grad_xi(2) = (-3d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & + + q_prim_vf(xibeg+1)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == m - 1) then + ! dxiy / dx + grad_xi(2) = (3d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + - q_prim_vf(xibeg+1)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == m) then + ! dxiy / dx + grad_xi(2) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg+1)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg+1)%sf(j - 4, k, l) ) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxiy / dx + grad_xi(2) = ( q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg+1)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + if(k == 0) then + ! dxix / dy + grad_xi(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l) ) & + /(12d0*(y_cb(k+1) - y_cb(k))) + else if (k == 1) then + ! dxix / dy + grad_xi(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + q_prim_vf(xibeg)%sf(j, k + 3, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + else if (k == n - 1) then + ! dxix / dy + grad_xi(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - q_prim_vf(xibeg)%sf(j, k - 3, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + else if (k == n) then + ! dxix / dy + grad_xi(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l) ) & + /(12d0*(y_cb(j) - y_cb(j-1))) + else + ! dxix / dy + grad_xi(3) = ( q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + end if + + if(k == 0) then + ! dxiy / dy + grad_xi(4) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg+1)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg+1)%sf(j, k + 4, l) ) & + /(12d0*(y_cb(k+1) - y_cb(k))) + else if (k == 1) then + ! dxiy / dy + grad_xi(4) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & + + q_prim_vf(xibeg+1)%sf(j, k + 3, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + else if (k == n - 1) then + ! dxiy / dy + grad_xi(4) = (3d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + - q_prim_vf(xibeg+1)%sf(j, k - 3, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + else if (k == n) then + ! dxiy / dy + grad_xi(4) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg+1)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg+1)%sf(j, k - 4, l) ) & + /(12d0*(y_cb(j) - y_cb(j-1))) + else + ! dxiy / dy + grad_xi(4) = ( q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg+1)%sf(j, k + 2, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + end if + + end if + ! 3D + if (num_dims > 2) then + ! using results from upper if statement to map form 2x2 to 3x3 tensor + grad_xi(5) = grad_xi(4) + grad_xi(4) = grad_xi(3) + + if(l == 0) then + ! dxix / dz + grad_xi(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + - 36d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & + + 16d0*q_prim_vf(xibeg)%sf(j, k , l + 3) & + - 3d0*q_prim_vf(xibeg)%sf(j, k , l + 4) ) & + /(12d0*(z_cb(k+1) - z_cb(k))) + else if (l == 1) then + ! dxix / dz + grad_xi(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + - 6d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & + + q_prim_vf(xibeg)%sf(j, k , l + 3)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + else if (l == p - 1) then + ! dxix / dz + grad_xi(3) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & + - q_prim_vf(xibeg)%sf(j, k , l - 3)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + else if (l == p) then + ! dxix / dz + grad_xi(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(j) - z_cb(j-1))) + else + ! dxix / dz + grad_xi(3) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + - q_prim_vf(xibeg)%sf(j, k , l + 2)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + end if + + if(l == 0) then + ! dxiy / dz + grad_xi(6) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + - 36d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & + + 16d0*q_prim_vf(xibeg+1)%sf(j, k , l + 3) & + - 3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 4) ) & + /(12d0*(z_cb(k+1) - z_cb(k))) + else if (l == 1) then + ! dxiy / dz + grad_xi(6) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + - 6d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & + + q_prim_vf(xibeg+1)%sf(j, k , l + 3)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + else if (l == p - 1) then + ! dxiy / dz + grad_xi(6) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - q_prim_vf(xibeg+1)%sf(j, k , l - 3)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + else if (l == p) then + ! dxiy / dz + grad_xi(6) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(j) - z_cb(j-1))) + else + ! dxiy / dz + grad_xi(6) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + end if + + if(j == 0) then + ! dxiz / dx + grad_xi(7) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l) ) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + else if (j == 1) then + ! dxiz / dx + grad_xi(7) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + q_prim_vf(xiend)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == m - 1) then + ! dxiz / dx + grad_xi(7) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xiend)%sf(j,k,l) & + - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - q_prim_vf(xiend)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == m) then + ! dxiz / dx + grad_xi(7) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l) ) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxiz / dx + grad_xi(7) = ( q_prim_vf(xiend)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - q_prim_vf(xiend)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + if(k == 0) then + ! dxiz / dy + grad_xi(8) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l) ) & + /(12d0*(y_cb(k+1) - y_cb(k))) + else if (k == 1) then + ! dxiz / dy + grad_xi(8) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + q_prim_vf(xiend)%sf(j, k + 3, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + else if (k == n - 1) then + ! dxiz / dy + grad_xi(8) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xiend)%sf(j,k,l) & + - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - q_prim_vf(xiend)%sf(j, k - 3, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + else if (k == n) then + ! dxiz / dy + grad_xi(8) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l) ) & + /(12d0*(y_cb(j) - y_cb(j-1))) + else + ! dxiz / dy + grad_xi(8) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - q_prim_vf(xiend)%sf(j, k + 2, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + end if + + if(l == 0) then + ! dxiz / dz + grad_xi(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + - 36d0*q_prim_vf(xiend)%sf(j, k , l + 2) & + + 16d0*q_prim_vf(xiend)%sf(j, k , l + 3) & + - 3d0*q_prim_vf(xiend)%sf(j, k , l + 4) ) & + /(12d0*(z_cb(k+1) - z_cb(k))) + else if (l == 1) then + ! dxiz / dz + grad_xi(9) = (-3d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + + 18d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + - 6d0*q_prim_vf(xiend)%sf(j, k , l + 2) & + + q_prim_vf(xiend)%sf(j, k , l + 3)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + else if (l == p - 1) then + ! dxiz / dz + grad_xi(9) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xiend)%sf(j,k,l) & + - 18d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & + - q_prim_vf(xiend)%sf(j, k , l - 3)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + else if (l == p) then + ! dxiz / dz + grad_xi(9) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xiend)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xiend)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xiend)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(j) - z_cb(j-1))) + else + ! dxiz / dz + grad_xi(9) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + - q_prim_vf(xiend)%sf(j, k , l + 2)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + end if + + end if + end subroutine s_compute_grad_xi + + subroutine s_finalize_rmt_module() ! -------------------- + + #ifdef MFC_SIMULATION + @:DEALLOCATE(grad_xi,ftensor,tensorb) + #endif + + end subroutine s_finalize_rmt_module + +end module m_rmt_tensor_calc diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 1b8f51e784..1ef117147e 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -171,11 +171,7 @@ contains end if end do - pres = ( & - energy - & - 0.5d0*(mom**2.d0)/rho - & - pi_inf - qv - E_e & - )/gamma + pres = (energy - 0.5d0*(mom**2.d0)/rho - pi_inf - qv - E_e )/gamma end if @@ -873,7 +869,7 @@ contains type(int_bounds_info), optional, intent(IN) :: ix, iy, iz - type(scalar_field), optional, dimension(b_size), intent(OUT) :: qK_btensor_vf + type(scalar_field), optional, dimension(b_size), intent(INOUT) :: qK_btensor_vf real(kind(0d0)), dimension(num_fluids) :: alpha_K, alpha_rho_K real(kind(0d0)), dimension(2) :: Re_K @@ -915,7 +911,7 @@ contains end if #:endif - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp) + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) do l = izb, ize do k = iyb, iye do j = ixb, ixe @@ -1025,33 +1021,23 @@ contains ! subtracting elastic contribution for pressure calculation if (G_K > 1000) then !TODO: check if stable for >0 qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K + ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K ! extra terms in 2 and 3D if ((i == strxb + 1) .or. & (i == strxb + 3) .or. & (i == strxb + 4)) then qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K + ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K end if end if end do end if if (hyperelasticity .and. .not. bubbles) then ! .and. G_K > 100 ) then - !$acc loop seq - do i = strxb, strxe - qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & - /rho_K - end do - call s_calculate_btensor(qK_prim_vf, j, k, l, qK_btensor_vf) - - !qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - ! G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K - - else - ! Mostly in the non-solid material - !qK_btensor_vf(:)%sf(j,k,l) = 0d0 - + !$acc loop seq + do i = strxb, strxe + qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) / rho_K + end do end if !$acc loop seq @@ -1064,6 +1050,22 @@ contains end do !$acc end parallel loop + ! going through hyperelasticity again due to the btensor calculation + if (hyperelasticity .and. .not. bubbles) then + ! s_calculate_btensor has its own triple nested for loop with openacc + call s_calculate_btensor(qK_prim_vf, qK_btensor_vf) + !$acc parallel loop collapse(3) gang vector default(present) private(gamma_K,G_K) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K + end do + end do + end do + !$acc end parallel loop + end if + end subroutine s_convert_conservative_to_primitive_variables ! --------- !> The following procedure handles the conversion between @@ -1213,20 +1215,32 @@ contains end if end do end if - - if (hyperelasticity) then + ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 + if ( hyperelasticity .and. .not. bubbles ) then ! adding the elastic contribution do i = stress_idx%beg, stress_idx%end q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) end do - call s_calculate_btensor(q_prim_vf, j, k, l, q_btensor) - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - G*f_elastic_energy(q_btensor, j, k, l) end if end do end do end do + ! going through hyperelasticity again due to the btensor calculation + if (hyperelasticity .and. .not. bubbles) then + ! s_calculate_btensor has its own triple nested for loop, with openacc + call s_calculate_btensor(q_prim_vf, q_btensor) + ! triple nested for loop to update the total energy using the btensor information + ! openacc is not needed here as this function is used only in pre_process/post_process + do l = 0, p + do k = 0, n + do j = 0, m + q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & + G*f_elastic_energy(q_btensor, j, k, l) + end do + end do + end do + end if #else if (proc_rank == 0) then diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp index 7d5aacc300..dc29206d8f 100644 --- a/src/pre_process/m_initial_condition.fpp +++ b/src/pre_process/m_initial_condition.fpp @@ -48,8 +48,6 @@ module m_initial_condition type(scalar_field), allocatable, dimension(:) :: q_cons_vf !< conservative variables - !type(scalar_field), allocatable, dimension(:) :: q_btensor !< btensor vector field - integer, allocatable, dimension(:, :, :) :: patch_id_fp !< !! Bookkepping variable used to track the patch identities (id) associated !! with each of the cells in the computational domain. Note that only one @@ -71,17 +69,12 @@ contains ! Allocating the primitive and conservative variables allocate (q_prim_vf(1:sys_size)) allocate (q_cons_vf(1:sys_size)) - !allocate (q_btensor(1:b_size)) do i = 1, sys_size allocate (q_prim_vf(i)%sf(0:m, 0:n, 0:p)) allocate (q_cons_vf(i)%sf(0:m, 0:n, 0:p)) end do - !do i = 1, b_size - ! allocate (q_btensor(i)%sf(0:m, 0:n, 0:p)) - !end do - ! Allocating the patch identities bookkeeping variable allocate (patch_id_fp(0:m, 0:n, 0:p)) @@ -107,12 +100,6 @@ contains q_prim_vf(i)%sf = dflt_real end do - ! Similarly for the btensor field - !do i = 1, b_size - ! q_btensor(i)%sf = dflt_real - !end do - - ! Setting default values for patch identities bookkeeping variable. ! This is necessary to avoid any confusion in the assessment of the ! extent of application that the overwrite permissions give a patch @@ -331,10 +318,6 @@ contains call s_convert_primitive_to_conservative_variables(q_prim_vf, & q_cons_vf) - !TODO REMOVE AFTER DEBUGGING - !call s_convert_conservative_to_primitive_variables(q_cons_vf, & - ! q_prim_vf) - if (qbmm .and. .not. polytropic) then !Initialize pb and mv call s_initialize_mv(q_cons_vf, mv%sf) diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index 48951541e1..29cb2e5a4e 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -20,6 +20,7 @@ module m_hypoelastic implicit none private; public :: s_initialize_hypoelastic_module, & + s_finalize_hypoelastic_module, & s_compute_hypoelastic_rhs #ifdef CRAY_ACC_WAR @@ -314,4 +315,18 @@ contains end subroutine s_compute_hypoelastic_rhs + subroutine s_finalize_hypoelastic_module() ! -------------------- + + @:DEALLOCATE_GLOBAL(Gs) + @:DEALLOCATE_GLOBAL(rho_K_field, G_K_field) + @:DEALLOCATE_GLOBAL(du_dx) + if (n > 0) then + @:DEALLOCATE_GLOBAL(du_dy,dv_dx,dv_dy) + if (p > 0) then + @:DEALLOCATE_GLOBAL(du_dz, dv_dz, dw_dx, dw_dy, dw_dz) + end if + end if + + end subroutine s_finalize_hypoelastic_module + end module m_hypoelastic diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 02e254957c..035cee14d0 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -725,6 +725,8 @@ contains end do end if + print *, 'I got here 1 !' + call nvtxStartRange("RHS-CONVERT") call s_convert_conservative_to_primitive_variables( & q_cons_qp%vf, & @@ -732,14 +734,15 @@ contains gm_alpha_qp%vf, & ix, iy, iz, & q_btensor%vf) - call nvtxEndRange + print *, 'I got here 2 !' call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") - if (hyperelasticity) then - call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf) - end if + !if (hyperelasticity) then + ! call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf) + !end if call nvtxEndRange + print *, 'I got here 3 !' call nvtxStartRange("RHS-MPI") call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 9522ee23c4..d26201a500 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -48,6 +48,8 @@ module m_start_up !! from the conservative and primitive variables use m_hypoelastic + use m_rmt_tensor_calc !< State variables type conversion procedures + use m_phase_change !< Phase-change module use m_viscous @@ -1248,6 +1250,7 @@ contains #endif if (hypoelasticity) call s_initialize_hypoelastic_module() + if (hyperelasticity) call s_initialize_rmt_module() if (relax) call s_initialize_phasechange_module() call s_initialize_data_output_module() call s_initialize_derived_variables_module() @@ -1389,6 +1392,8 @@ contains s_write_data_files => null() call s_finalize_time_steppers_module() + if (hypoelasticity) call s_finalize_hypoelastic_module() + if (hyperelasticity) call s_finalize_rmt_module() call s_finalize_derived_variables_module() call s_finalize_data_output_module() call s_finalize_rhs_module() From 196ab5a3bbe7bb3bd4bb38af9d71ea81a9d88de9 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 20 May 2024 16:13:32 -0500 Subject: [PATCH 100/380] modified pressure relaxation slightly, not yet verified --- src/common/m_constants.fpp | 2 +- src/simulation/m_rhs.fpp | 25 +++++++++++++++---------- 2 files changed, 16 insertions(+), 11 deletions(-) diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp index 733eb38e06..9eb842b56b 100644 --- a/src/common/m_constants.fpp +++ b/src/common/m_constants.fpp @@ -7,7 +7,7 @@ module m_constants character, parameter :: dflt_char = ' ' !< Default string value real(kind(0d0)), parameter :: dflt_real = -1d6 !< Default real value - real(kind(0d0)), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance + real(kind(0d0)), parameter :: sgm_eps = 1d-12 !< Segmentation tolerance real(kind(0d0)), parameter :: small_alf = 1d-11 !< Small alf tolerance real(kind(0d0)), parameter :: pi = 3.141592653589793d0 !< Pi real(kind(0d0)), parameter :: verysmall = 1.d-12 !< Very small number diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 9f67297029..f2fcb6b536 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -1621,11 +1621,7 @@ contains (q_cons_vf(i + intxb - 1)%sf(j, k, l)/ & q_cons_vf(i + advxb - 1)%sf(j, k, l) & - pi_infs(i))/gammas(i) - - if (pres_K_init(i) <= -(1d0 - 1d-8)*pres_inf(i) + 1d-8) & - pres_K_init(i) = -(1d0 - 1d-8)*pres_inf(i) + 1d-8 - else - pres_K_init(i) = 0d0 + if (pres_k_init(i) .le. 0d0) pres_k_init = 1e-2 end if pres_relax = pres_relax + q_cons_vf(i + advxb - 1)%sf(j, k, l)*pres_K_init(i) end do @@ -1640,7 +1636,7 @@ contains end do !$acc loop seq - do iter = 0, 49 + do iter = 0, 25 if (DABS(f_pres) > 1d-10) then pres_relax = pres_relax - f_pres/df_pres @@ -1658,10 +1654,16 @@ contains !$acc loop seq do i = 1, num_fluids if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > sgm_eps) then + !rho_K_s(i) = q_cons_vf(i + contxb - 1)%sf(j, k, l)/ & + ! max(q_cons_vf(i + advxb - 1)%sf(j, k, l), sgm_eps) & + ! *((pres_relax + pres_inf(i))/(pres_K_init(i) + & + ! pres_inf(i)))**(1d0/gamma_min(i)) + rho_K_s(i) = q_cons_vf(i + contxb - 1)%sf(j, k, l)/ & - max(q_cons_vf(i + advxb - 1)%sf(j, k, l), sgm_eps) & - *((pres_relax + pres_inf(i))/(pres_K_init(i) + & - pres_inf(i)))**(1d0/gamma_min(i)) + (max(q_cons_vf(i + advxb - 1)%sf(j, k, l), sgm_eps) & + *(gamma_min(i)*(pres_relax + pres_inf(i)) & + /(gamma_min(i)*(pres_relax + pres_inf(i)) + pres_K_init(i) - & + pres_relax))) f_pres = f_pres + q_cons_vf(i + contxb - 1)%sf(j, k, l) & /rho_K_s(i) @@ -1677,7 +1679,7 @@ contains ! Cell update of the volume fraction !$acc loop seq do i = 1, num_fluids - if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > sgm_eps) & + !if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > sgm_eps) & q_cons_vf(i + advxb - 1)%sf(j, k, l) = q_cons_vf(i + contxb - 1)%sf(j, k, l) & /rho_K_s(i) end do @@ -1767,6 +1769,9 @@ contains end if end if + + + dyn_pres = 0d0 !$acc loop seq From ee5b18959c13d570b367fa4cf56ffc93d704b4af Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 20 May 2024 23:48:37 -0500 Subject: [PATCH 101/380] fixed pre_process compilation and runs, need to rework xi_calc to integrate the array calculations, simulation compiles but does not run --- src/common/m_variables_conversion.fpp | 77 ++++++++++++- ...t_tensor_calc.fpp => m_xi_tensor_calc.fpp} | 108 +++--------------- src/post_process/m_global_parameters.fpp | 8 +- src/pre_process/m_assign_variables.f90 | 25 ++-- src/pre_process/m_global_parameters.fpp | 8 +- src/simulation/m_global_parameters.fpp | 8 +- src/simulation/m_start_up.fpp | 4 - 7 files changed, 113 insertions(+), 125 deletions(-) rename src/common/{m_rmt_tensor_calc.fpp => m_xi_tensor_calc.fpp} (87%) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 1ef117147e..ff16c7f1af 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -19,7 +19,7 @@ module m_variables_conversion use m_mpi_proxy !< Message passing interface (MPI) module proxy - use m_rmt_tensor_calc !< Using reference map matrix calculations + use m_xi_tensor_calc !< Using reference map matrix calculations use m_helper ! ========================================================================== @@ -110,6 +110,20 @@ module m_variables_conversion real(kind(0d0)), allocatable, dimension(:, :, :), public :: pi_inf_sf !< Scalar liquid stiffness function real(kind(0d0)), allocatable, dimension(:, :, :), public :: qv_sf !< Scalar liquid energy reference function +#ifdef CRAY_ACC_WAR + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), grad_xi) + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), ftensor) + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), tensorb) + !$acc declare link(grad_xi,ftensor,tensorb) +#else + real(kind(0d0)), allocatable, dimension(:) :: grad_xi, ftensor, tensorb + !$acc declare create(grad_xi,ftensor,tensorb) +#endif + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz + procedure(s_convert_xxxxx_to_mixture_variables), & pointer :: s_convert_to_mixture_variables => null() !< !! Pointer referencing the subroutine s_convert_mixture_to_mixture_variables @@ -770,6 +784,14 @@ contains end if #endif + @:ALLOCATE(grad_xi(1:num_dims**2)) + @:ALLOCATE(ftensor(1:num_dims**2)) + @:ALLOCATE(tensorb(1:num_dims**2)) + grad_xi(:) = 0d0 + ftensor(:) = 0d0 + tensorb(:) = 0d0 +!$acc update device(grad_xi,ftensor,tensorb) + if (model_eqns == 1) then ! Gamma/pi_inf model s_convert_to_mixture_variables => & s_convert_mixture_to_mixture_variables @@ -1035,7 +1057,7 @@ contains if (hyperelasticity .and. .not. bubbles) then ! .and. G_K > 100 ) then !$acc loop seq - do i = strxb, strxe + do i = xibeg, xiend qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) / rho_K end do end if @@ -1218,14 +1240,15 @@ contains ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 if ( hyperelasticity .and. .not. bubbles ) then ! adding the elastic contribution - do i = stress_idx%beg, stress_idx%end + do i = xibeg, xiend q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) end do end if end do end do - end do + end do + ! going through hyperelasticity again due to the btensor calculation if (hyperelasticity .and. .not. bubbles) then ! s_calculate_btensor has its own triple nested for loop, with openacc @@ -1241,7 +1264,6 @@ contains end do end do end if - #else if (proc_rank == 0) then call s_mpi_abort('Conversion from primitive to '// & @@ -1386,6 +1408,47 @@ contains end subroutine s_convert_primitive_to_flux_variables ! ----------------- + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + subroutine s_calculate_btensor(q_prim_vf, btensor) + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(OUT) :: btensor + integer :: j, k, l + + !$acc parallel loop collapse(3) gang vector default(present) private(grad_xi,ftensor,tensorb) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe + ! STEP 1: calculate the grad_xi, grad_xi is a nxn tensor + call s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) + ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + call s_calculate_ainverse(grad_xi,ftensor) + ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + call s_calculate_atransposea(ftensor,tensorb) + ! btensor is symmetric, save the data space + ! 1: 1D, 3: 2D, 6: 3D + btensor(1)%sf(j, k, l) = tensorb(1) + if (num_dims > 1) then ! 2D + btensor(2)%sf(j,k,l) = tensorb(2) + btensor(3)%sf(j,k,l) = tensorb(4) + end if + if (num_dims > 2) then ! 3D + btensor(3)%sf(j,k,l) = tensorb(3) + btensor(4)%sf(j,k,l) = tensorb(5) + btensor(5)%sf(j,k,l) = tensorb(6) + btensor(6)%sf(j,k,l) = tensorb(9) + end if + ! store the determinant at the last entry of the btensor sf + btensor(b_size)%sf(j,k,l) = f_determinant(ftensor) + end do + end do + end do + !$acc end parallel loop + + end subroutine s_calculate_btensor + subroutine s_finalize_variables_conversion_module() ! ------------------ ! Deallocating the density, the specific heat ratio function and the @@ -1406,6 +1469,10 @@ contains end if #endif +#ifdef MFC_SIMULATION + @:DEALLOCATE(grad_xi,ftensor,tensorb) +#endif + ! Nullifying the procedure pointer to the subroutine transferring/ ! computing the mixture/species variables to the mixture variables s_convert_to_mixture_variables => null() diff --git a/src/common/m_rmt_tensor_calc.fpp b/src/common/m_xi_tensor_calc.fpp similarity index 87% rename from src/common/m_rmt_tensor_calc.fpp rename to src/common/m_xi_tensor_calc.fpp index d2ad564839..589312f7d7 100644 --- a/src/common/m_rmt_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.fpp @@ -1,98 +1,28 @@ -#:include 'macros.fpp' - !> -!! @file m_variables_conversion.f90 -!! @brief Contains module m_variables_conversion +!! @file m_xi_tensor_calc.f90 +!! @brief Contains module m_xi_tensor_calc !> @brief This module consists of subroutines used in the calculation of matrix !! operations for the reference map tensor -module m_rmt_tensor_calc +module m_xi_tensor_calc ! Dependencies ============================================================= use m_derived_types !< Definitions of the derived types use m_global_parameters !< Definitions of the global parameters - ! ========================================================================== implicit none - private; public :: s_initialize_rmt_module, & - s_finalize_rmt_module, & - s_calculate_btensor, & - f_elastic_energy - - -#ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), grad_xi) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), ftensor) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), tensorb) - !$acc declare link(grad_xi,ftensor,tensorb) -#else - real(kind(0d0)), allocatable, dimension(:) :: grad_xi, ftensor, tensorb - !$acc declare create(grad_xi,ftensor,tensorb) -#endif - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz + private; public :: s_calculate_ainverse, & + s_calculate_atransposea, & + f_determinant, & + f_elastic_energy, & + s_compute_grad_xi contains - subroutine s_initialize_rmt_module() ! -------------------- - - integer :: i - #ifdef MFC_SIMULATION - @:ALLOCATE(grad_xi(1:num_dims**2)) - @:ALLOCATE(ftensor(1:num_dims**2)) - @:ALLOCATE(tensorb(1:num_dims**2)) - #endif - grad_xi(:) = 0d0 - ftensor(:) = 0d0 - tensorb(:) = 0d0 -!$acc update device(grad_xi,ftensor,tensorb) - - end subroutine s_initialize_rmt_module - - subroutine s_calculate_btensor(q_prim_vf, btensor) - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(OUT) :: btensor - integer :: j, k, l - !real(kind(0d0)), dimension(num_dims**2) :: grad_xi, ftensor, tensorb - - !$acc parallel loop collapse(3) gang vector default(present) private(grad_xi,ftensor,tensorb) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe - ! STEP 1: calculate the grad_xi, grad_xi is a nxn tensor - call s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) - ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - call s_calculate_ainverse(grad_xi,ftensor) - ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - call s_calculate_atransposea(ftensor,tensorb) - ! btensor is symmetric, save the data space - ! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensorb(1) - if (num_dims > 1) then ! 2D - btensor(2)%sf(j,k,l) = tensorb(2) - btensor(3)%sf(j,k,l) = tensorb(4) - end if - if (num_dims > 2) then ! 3D - btensor(3)%sf(j,k,l) = tensorb(3) - btensor(4)%sf(j,k,l) = tensorb(5) - btensor(5)%sf(j,k,l) = tensorb(6) - btensor(6)%sf(j,k,l) = tensorb(9) - end if - ! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j,k,l) = f_determinant(ftensor) - end do - end do - end do - !$acc end parallel loop - - end subroutine s_calculate_btensor - function f_determinant(tensor) !$acc routine seq real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor @@ -111,7 +41,7 @@ contains if (f_determinant == 0) then print *, 'f_determinant :: ', f_determinant print *, 'ERROR: Determinant was zero' - !STOP + stop end if end function f_determinant @@ -184,7 +114,7 @@ contains real(kind(0d0)) :: invariant1, f_elastic_energy invariant1 = btensor(1)%sf(j, k, l) - + f_elastic_energy = 0d0 if (num_dims == 2) then invariant1 = invariant1 + btensor(3)%sf(j, k, l) elseif (num_dims == 3) then @@ -197,7 +127,7 @@ contains subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(num_dims**2), intent(INOUT) :: grad_xi + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: grad_xi integer, intent(IN) :: j, k, l integer :: i @@ -577,16 +507,14 @@ contains - q_prim_vf(xiend)%sf(j, k , l + 2)) & /(12d0*(z_cb(j) - z_cb(j - 1))) end if - end if - end subroutine s_compute_grad_xi - - subroutine s_finalize_rmt_module() ! -------------------- - #ifdef MFC_SIMULATION - @:DEALLOCATE(grad_xi,ftensor,tensorb) - #endif + !if(proc_rank == 0) then + ! do i = 1, num_dims**2 + ! print *, "i :: ",i,", grad_xi :: ",grad_xi(i) + ! end do + !end if - end subroutine s_finalize_rmt_module + end subroutine s_compute_grad_xi -end module m_rmt_tensor_calc +end module m_xi_tensor_calc diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 7dc330c591..9d43856d66 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -490,8 +490,8 @@ contains if (hyperelasticity) then ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + num_dims - sys_size = stress_idx%end + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + sys_size = stress_idx%end + num_dims ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 end if @@ -585,8 +585,8 @@ contains strxe = stress_idx%end intxb = internalEnergies_idx%beg intxe = internalEnergies_idx%end - xibeg = stress_idx%beg - xiend = stress_idx%end + xibeg = stress_idx%end+1 + xiend = stress_idx%end+num_dims ! ================================================================== #ifdef MFC_MPI diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 index 344ad83ea3..1c05aa5bf5 100644 --- a/src/pre_process/m_assign_variables.f90 +++ b/src/pre_process/m_assign_variables.f90 @@ -444,32 +444,29 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & ! Elastic Shear Stress if (hyperelasticity) then - xi_cart(1) = x_cc(j) - xi_cart(2) = y_cc(k) - xi_cart(3) = z_cc(l) if (pre_stress) then ! pre stressed initial condition in spatial domain rcoord = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2)) theta = atan2(y_cc(k), x_cc(j)) phi = atan2(sqrt(x_cc(j)**2 + y_cc(k)**2), z_cc(l)) - xi_sph = (rcoord**3 - R0ref**3 + 1d0)**(1d0/3d0) !spherical coord, assuming Rmax=1 + !spherical coord, assuming Rmax=1 + xi_sph = (rcoord**3 - R0ref**3 + 1d0)**(1d0/3d0) xi_cart(1) = xi_sph*sin(phi)*cos(theta) xi_cart(2) = xi_sph*sin(phi)*sin(theta) xi_cart(3) = xi_sph*cos(phi) + else + xi_cart(1) = x_cc(j) + xi_cart(2) = y_cc(k) + xi_cart(3) = z_cc(l) end if - do i = 1, (stress_idx%end - stress_idx%beg) + 1 - q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = xi_cart(i) - + do i = 1, num_dims + q_prim_vf(i+stress_idx%end)%sf(j,k,l) = xi_cart(i) + end do !(eta*xi_cart(i) + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1)) - - !if (proc_rank ==0) print *, 'q(',i,') ::', q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) !if (proc_rank == 0) then - ! write(*,*) 'q(',i,') :: ',q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l)& - ! ,', xi_cart :: ',xi_cart(i) + ! write(*,*) 'q(',i,') :: ',q_prim_vf(i+stress_idx%end)%sf(j, k, l), & + ! ', xi_cart :: ',xi_cart(i) !end if - end do end if - !if (proc_rank ==0) stop - !if(proc_rank == 0) print *, 'I got to after hyperelasticity for patch :: ', patch_id if (mpp_lim .and. bubbles) then !adjust volume fractions, according to modeled gas void fraction diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index be128bdcd6..f9e47286a2 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -597,8 +597,8 @@ contains if (hyperelasticity) then ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + num_dims !(num_dims*(num_dims + 1))/2 - sys_size = stress_idx%end + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + sys_size = stress_idx%end + num_dims ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 end if @@ -692,8 +692,8 @@ contains strxe = stress_idx%end intxb = internalEnergies_idx%beg intxe = internalEnergies_idx%end - xibeg = stress_idx%beg - xiend = stress_idx%end + xibeg = stress_idx%end+1 + xiend = stress_idx%end+num_dims ! ================================================================== diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index d85f042f8f..df906cb245 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -790,8 +790,8 @@ contains if (hyperelasticity) then ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + num_dims - sys_size = stress_idx%end + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + sys_size = stress_idx%end + num_dims ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 end if @@ -992,8 +992,8 @@ contains strxe = stress_idx%end intxb = internalEnergies_idx%beg intxe = internalEnergies_idx%end - xibeg = stress_idx%beg - xiend = stress_idx%end + xibeg = stress_idx%end+1 + xiend = stress_idx%end+num_dims !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe, b_size, xibeg, xiend) !$acc update device(m, n, p) diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index d26201a500..4c4a159b80 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -48,8 +48,6 @@ module m_start_up !! from the conservative and primitive variables use m_hypoelastic - use m_rmt_tensor_calc !< State variables type conversion procedures - use m_phase_change !< Phase-change module use m_viscous @@ -1250,7 +1248,6 @@ contains #endif if (hypoelasticity) call s_initialize_hypoelastic_module() - if (hyperelasticity) call s_initialize_rmt_module() if (relax) call s_initialize_phasechange_module() call s_initialize_data_output_module() call s_initialize_derived_variables_module() @@ -1393,7 +1390,6 @@ contains call s_finalize_time_steppers_module() if (hypoelasticity) call s_finalize_hypoelastic_module() - if (hyperelasticity) call s_finalize_rmt_module() call s_finalize_derived_variables_module() call s_finalize_data_output_module() call s_finalize_rhs_module() From 08d99ee0f0aa7356ba37ba5b864a21d1f0f7ad6c Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 22 May 2024 13:45:44 -0500 Subject: [PATCH 102/380] broken simulation that does not compile, will try to fix --- src/common/m_variables_conversion.fpp | 96 +++++-------- src/common/m_xi_tensor_calc.fpp | 184 ++++++++++++------------- src/simulation/m_global_parameters.fpp | 7 +- src/simulation/m_hyperelastic.fpp | 4 + src/simulation/m_rhs.fpp | 3 - src/simulation/m_start_up.fpp | 11 +- 6 files changed, 135 insertions(+), 170 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index ff16c7f1af..676df727ff 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -110,19 +110,6 @@ module m_variables_conversion real(kind(0d0)), allocatable, dimension(:, :, :), public :: pi_inf_sf !< Scalar liquid stiffness function real(kind(0d0)), allocatable, dimension(:, :, :), public :: qv_sf !< Scalar liquid energy reference function -#ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), grad_xi) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), ftensor) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), tensorb) - !$acc declare link(grad_xi,ftensor,tensorb) -#else - real(kind(0d0)), allocatable, dimension(:) :: grad_xi, ftensor, tensorb - !$acc declare create(grad_xi,ftensor,tensorb) -#endif - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz procedure(s_convert_xxxxx_to_mixture_variables), & pointer :: s_convert_to_mixture_variables => null() !< @@ -784,14 +771,6 @@ contains end if #endif - @:ALLOCATE(grad_xi(1:num_dims**2)) - @:ALLOCATE(ftensor(1:num_dims**2)) - @:ALLOCATE(tensorb(1:num_dims**2)) - grad_xi(:) = 0d0 - ftensor(:) = 0d0 - tensorb(:) = 0d0 -!$acc update device(grad_xi,ftensor,tensorb) - if (model_eqns == 1) then ! Gamma/pi_inf model s_convert_to_mixture_variables => & s_convert_mixture_to_mixture_variables @@ -933,6 +912,14 @@ contains end if #:endif + ! going through hyperelasticity again due to the btensor calculation + ! s_calculate_btensor has its own triple nested for loop with openacc + print *, 'I got here A1' + if (hyperelasticity .and. .not. bubbles) then + !call s_calculate_btensor(qK_prim_vf, qK_btensor_vf) + end if + print *, 'I got here A2' + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) do l = izb, ize do k = iyb, iye @@ -1055,11 +1042,13 @@ contains end do end if - if (hyperelasticity .and. .not. bubbles) then ! .and. G_K > 100 ) then + if ( hyperelasticity .and. .not. bubbles ) then !$acc loop seq do i = xibeg, xiend qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) / rho_K end do + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + G_K * f_elastic_energy( qK_btensor_vf, j, k, l) / gamma_K end if !$acc loop seq @@ -1072,22 +1061,6 @@ contains end do !$acc end parallel loop - ! going through hyperelasticity again due to the btensor calculation - if (hyperelasticity .and. .not. bubbles) then - ! s_calculate_btensor has its own triple nested for loop with openacc - call s_calculate_btensor(qK_prim_vf, qK_btensor_vf) - !$acc parallel loop collapse(3) gang vector default(present) private(gamma_K,G_K) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K - end do - end do - end do - !$acc end parallel loop - end if - end subroutine s_convert_conservative_to_primitive_variables ! --------- !> The following procedure handles the conversion between @@ -1126,10 +1099,17 @@ contains integer :: i, j, k, l, q !< Generic loop iterators do l = 1, b_size - @:ALLOCATE(q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) + @:ALLOCATE_GLOBAL(q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) end do #ifndef MFC_SIMULATION + + ! going through hyperelasticity again due to the btensor calculation + if ( hyperelasticity .and. .not. bubbles) then + ! s_calculate_btensor has its own triple nested for loop, no openacc + !call s_calculate_btensor(q_prim_vf, q_btensor) + end if + ! Converting the primitive variables to the conservative variables do l = 0, p do k = 0, n @@ -1237,33 +1217,21 @@ contains end if end do end if + ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 if ( hyperelasticity .and. .not. bubbles ) then ! adding the elastic contribution do i = xibeg, xiend q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) end do + q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & + G*f_elastic_energy(q_btensor, j, k, l) end if - + end do end do end do - ! going through hyperelasticity again due to the btensor calculation - if (hyperelasticity .and. .not. bubbles) then - ! s_calculate_btensor has its own triple nested for loop, with openacc - call s_calculate_btensor(q_prim_vf, q_btensor) - ! triple nested for loop to update the total energy using the btensor information - ! openacc is not needed here as this function is used only in pre_process/post_process - do l = 0, p - do k = 0, n - do j = 0, m - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - G*f_elastic_energy(q_btensor, j, k, l) - end do - end do - end do - end if #else if (proc_rank == 0) then call s_mpi_abort('Conversion from primitive to '// & @@ -1413,20 +1381,24 @@ contains !! @param q_prim_vf Primitive variables !! @param btensor is the output subroutine s_calculate_btensor(q_prim_vf, btensor) + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf type(scalar_field), dimension(b_size), intent(OUT) :: btensor + real(kind(0d0)), dimension(num_dims**2+1) :: tensorb + real(kind(0d0)), dimension(num_dims**2+1) :: tensora, tensorc integer :: j, k, l - !$acc parallel loop collapse(3) gang vector default(present) private(grad_xi,ftensor,tensorb) + !$acc parallel loop collapse(3) gang vector default(present) private(tensorb, tensora, tensorc) do l = izb, ize do k = iyb, iye do j = ixb, ixe ! STEP 1: calculate the grad_xi, grad_xi is a nxn tensor - call s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) + !call s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) + call s_compute_grad_xi(q_prim_vf, j, k, l, tensorb, tensora, tensorc) ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - call s_calculate_ainverse(grad_xi,ftensor) + !call s_calculate_ainverse(grad_xi,ftensor) ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - call s_calculate_atransposea(ftensor,tensorb) + !call s_calculate_atransposea(ftensor,tensorb) ! btensor is symmetric, save the data space ! 1: 1D, 3: 2D, 6: 3D btensor(1)%sf(j, k, l) = tensorb(1) @@ -1441,7 +1413,7 @@ contains btensor(6)%sf(j,k,l) = tensorb(9) end if ! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j,k,l) = f_determinant(ftensor) + btensor(b_size)%sf(j,k,l) = tensorb(10) end do end do end do @@ -1469,10 +1441,6 @@ contains end if #endif -#ifdef MFC_SIMULATION - @:DEALLOCATE(grad_xi,ftensor,tensorb) -#endif - ! Nullifying the procedure pointer to the subroutine transferring/ ! computing the mixture/species variables to the mixture variables s_convert_to_mixture_variables => null() diff --git a/src/common/m_xi_tensor_calc.fpp b/src/common/m_xi_tensor_calc.fpp index 589312f7d7..0cdf716503 100644 --- a/src/common/m_xi_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.fpp @@ -15,97 +15,11 @@ module m_xi_tensor_calc implicit none - private; public :: s_calculate_ainverse, & - s_calculate_atransposea, & - f_determinant, & - f_elastic_energy, & + private; public :: f_elastic_energy, & s_compute_grad_xi contains - function f_determinant(tensor) - !$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)) :: f_determinant - - if (num_dims == 1) then - f_determinant = tensor(1) - elseif (num_dims == 2) then - f_determinant = tensor(1)*tensor(4) - tensor(2)*tensor(3) - else - f_determinant = tensor(1)*(tensor(5)*tensor(9) - tensor(6)*tensor(8)) & - - tensor(2)*(tensor(4)*tensor(9) - tensor(6)*tensor(7)) & - + tensor(3)*(tensor(4)*tensor(8) - tensor(5)*tensor(7)) - end if - ! error checking - if (f_determinant == 0) then - print *, 'f_determinant :: ', f_determinant - print *, 'ERROR: Determinant was zero' - stop - end if - end function f_determinant - - subroutine s_calculate_atransposea(tensor, ata) - !$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ata - - ata(1) = tensor(1)**2 - if (num_dims == 2) then - ata(1) = ata(1) + tensor(3)**2 - ata(2) = tensor(1)*tensor(2) + tensor(3)*tensor(4) - ata(3) = ata(2) - ata(4) = tensor(2)**2 + tensor(4)**2 - elseif (num_dims == 3) then - ata(1) = ata(1) + tensor(4)**2 + tensor(7)**2 - ata(5) = tensor(2) + tensor(5)**2 + tensor(8)**2 - ata(9) = tensor(3) + tensor(6)**2 + tensor(9)**2 - ata(2) = tensor(1)*tensor(2) + tensor(4)*tensor(5) + tensor(7)*tensor(8) - ata(3) = tensor(1)*tensor(3) + tensor(4)*tensor(6) + tensor(7)*tensor(9) - ata(6) = tensor(2)*tensor(3) + tensor(5)*tensor(6) + tensor(8)*tensor(9) - ata(4) = ata(2) - ata(7) = ata(3) - ata(8) = ata(4) - end if - end subroutine s_calculate_atransposea - - subroutine s_calculate_adjointa(tensor, dja) - !$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: dja - - if (num_dims == 1) then - dja(1) = 1 - elseif (num_dims == 2) then - dja(1) = tensor(4) - dja(2) = -tensor(3) - dja(3) = -tensor(2) - dja(4) = tensor(1) - elseif (num_dims == 3) then - dja(1) = tensor(5)*tensor(9) - tensor(6)*tensor(8) - dja(2) = -(tensor(2)*tensor(9) - tensor(3)*tensor(8)) - dja(3) = tensor(2)*tensor(6) - tensor(3)*tensor(5) - dja(4) = -(tensor(4)*tensor(9) - tensor(6)*tensor(7)) - dja(5) = tensor(1)*tensor(9) - tensor(3)*tensor(7) - dja(6) = -(tensor(1)*tensor(6) - tensor(4)*tensor(3)) - dja(7) = tensor(4)*tensor(8) - tensor(5)*tensor(7) - dja(8) = -(tensor(1)*tensor(8) - tensor(2)*tensor(7)) - dja(9) = tensor(1)*tensor(5) - tensor(2)*tensor(4) - end if - end subroutine s_calculate_adjointa - - subroutine s_calculate_ainverse(tensor, ainv) - !$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ainv - real(kind(0d0)), dimension(num_dims**2) :: dja - real(kind(0d0)) :: det - - call s_calculate_adjointa(tensor, dja) - ainv(:) = dja(:)/f_determinant(tensor) - - end subroutine s_calculate_ainverse - ! neo-Hookean only at this time, will need to be changed later function f_elastic_energy(btensor, j, k, l) !$acc routine seq @@ -121,16 +35,25 @@ contains invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) end if ! compute the invariant without the elastic modulus - f_elastic_energy = 0.5d0*(invariant1 - 3)/btensor(b_size)%sf(j, k, l) + f_elastic_energy = 0.5d0*(invariant1 - 3.0d0)/btensor(b_size)%sf(j, k, l) end function f_elastic_energy - subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) + subroutine s_compute_grad_xi(q_prim_vf, j, k, l, ftensor, grad_xi, tensorb) !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: grad_xi + real(kind(0d0)), dimension(num_dims**2+1), intent(INOUT) :: ftensor + real(kind(0d0)), dimension(num_dims**2+1), intent(INOUT) :: grad_xi, tensorb integer, intent(IN) :: j, k, l + + real(kind(0d0)) :: determinant integer :: i + !print *, 'xibeg :: ',xibeg,', qprim :: ',q_prim_vf(xibeg)%sf(j,k,l) + + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz if(j == 0) then ! dxix/dx grad_xi(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & @@ -509,11 +432,82 @@ contains end if end if - !if(proc_rank == 0) then - ! do i = 1, num_dims**2 - ! print *, "i :: ",i,", grad_xi :: ",grad_xi(i) - ! end do - !end if + !do i = 1, num_dims**2 + ! print *, 'i :: ',i,', grad_xi :: ',grad_xi(i) + !end do + + ! calculating the adjoint of grad_xi tensor in preparation for + ! calculating the inverse of the tensor + if (num_dims == 1) then + ftensor(1) = 1 + elseif (num_dims == 2) then + ftensor(1) = grad_xi(4) + ftensor(2) = -grad_xi(3) + ftensor(3) = -grad_xi(2) + ftensor(4) = grad_xi(1) + elseif (num_dims == 3) then + ftensor(1) = grad_xi(5)*grad_xi(9) - grad_xi(6)*grad_xi(8) + ftensor(2) = -(grad_xi(2)*grad_xi(9) - grad_xi(3)*grad_xi(8)) + ftensor(3) = grad_xi(2)*grad_xi(6) - grad_xi(3)*grad_xi(5) + ftensor(4) = -(grad_xi(4)*grad_xi(9) - grad_xi(6)*grad_xi(7)) + ftensor(5) = grad_xi(1)*grad_xi(9) - grad_xi(3)*grad_xi(7) + ftensor(6) = -(grad_xi(1)*grad_xi(6) - grad_xi(4)*grad_xi(3)) + ftensor(7) = grad_xi(4)*grad_xi(8) - grad_xi(5)*grad_xi(7) + ftensor(8) = -(grad_xi(1)*grad_xi(8) - grad_xi(2)*grad_xi(7)) + ftensor(9) = grad_xi(1)*grad_xi(5) - grad_xi(2)*grad_xi(4) + end if + + ! calculating the determinant of the grad_xi tensor + if (num_dims == 1) then + determinant = grad_xi(1) + elseif (num_dims == 2) then + determinant = grad_xi(1)*grad_xi(4) - grad_xi(2)*grad_xi(3) + else + determinant = grad_xi(1)*(grad_xi(5)*grad_xi(9) - grad_xi(6)*grad_xi(8)) & + - grad_xi(2)*(grad_xi(4)*grad_xi(9) - grad_xi(6)*grad_xi(7)) & + + grad_xi(3)*(grad_xi(4)*grad_xi(8) - grad_xi(5)*grad_xi(7)) + end if + + ! error checking + if (determinant == 0) then + if(proc_rank == 0) then + print *, 'determinant :: ', determinant + !print *, 'ERROR: Determinant was zero' + !stop + end if + end if + ! calculating the inverse and saving it in tensorb, which is F tensor + tensorb(:) = ftensor(:)/determinant + + ! calculating F transpose F + ftensor(1) = tensorb(1)**2 + if (num_dims == 2) then + ftensor(1) = ftensor(1) + tensorb(3)**2 + ftensor(2) = tensorb(1)*tensorb(2) + tensorb(3)*tensorb(4) + ftensor(3) = ftensor(2) + ftensor(4) = tensorb(2)**2 + tensorb(4)**2 + elseif (num_dims == 3) then + ftensor(1) = ftensor(1) + tensorb(4)**2 + tensorb(7)**2 + ftensor(5) = tensorb(2) + tensorb(5)**2 + tensorb(8)**2 + ftensor(9) = tensorb(3) + tensorb(6)**2 + tensorb(9)**2 + ftensor(2) = tensorb(1)*tensorb(2) + tensorb(4)*tensorb(5) + tensorb(7)*tensorb(8) + ftensor(3) = tensorb(1)*tensorb(3) + tensorb(4)*tensorb(6) + tensorb(7)*tensorb(9) + ftensor(6) = tensorb(2)*tensorb(3) + tensorb(5)*tensorb(6) + tensorb(8)*tensorb(9) + ftensor(4) = ftensor(2) + ftensor(7) = ftensor(3) + ftensor(8) = ftensor(4) + end if + + ! calculating the determinant of the F tensor and storing in last entry of ftensor + if (num_dims == 1) then ! 1D + ftensor(num_dims**2+1) = tensorb(1) + elseif (num_dims == 2) then ! 2D + ftensor(num_dims**2+1) = tensorb(1)*tensorb(4) - tensorb(2)*tensorb(3) + else ! 3D + ftensor(num_dims**2+1) = tensorb(1)*(tensorb(5)*tensorb(9) - tensorb(6)*tensorb(8)) & + - tensorb(2)*(tensorb(4)*tensorb(9) - tensorb(6)*tensorb(7)) & + + tensorb(3)*(tensorb(4)*tensorb(8) - tensorb(5)*tensorb(7)) + end if end subroutine s_compute_grad_xi diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index df906cb245..ffc4912935 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -780,17 +780,18 @@ contains end if end if - if (hypoelasticity) then + if ( hypoelasticity ) then stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D sys_size = stress_idx%end end if - if (hyperelasticity) then + if ( hyperelasticity ) then ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + ! adding three more equations for the \xi field sys_size = stress_idx%end + num_dims ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 9e00a4d437..2e79ad851e 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -21,6 +21,9 @@ module m_hyperelastic private; public :: s_calculate_cauchy_from_btensor + + + contains subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf) @@ -50,6 +53,7 @@ contains end do end do end do + !$acc end parallel loop if (proc_rank == 0) print *, 'J is ::', jacobian, 'this is sigma ::', sigma end subroutine s_calculate_cauchy_from_btensor diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 035cee14d0..92f0fa518e 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -567,7 +567,6 @@ contains if (riemann_solver /= 1) then do l = adv_idx%beg + 1, adv_idx%end flux_src_n(i)%vf(l)%sf => flux_src_n(i)%vf(adv_idx%beg)%sf - !$acc enter data attach(flux_src_n(i)%vf(l)%sf) end do end if @@ -575,7 +574,6 @@ contains do l = 1, sys_size flux_n(i)%vf(l)%sf => flux_n(1)%vf(l)%sf flux_src_n(i)%vf(l)%sf => flux_src_n(1)%vf(l)%sf - !$acc enter data attach(flux_n(i)%vf(l)%sf,flux_src_n(i)%vf(l)%sf) end do end if @@ -726,7 +724,6 @@ contains end if print *, 'I got here 1 !' - call nvtxStartRange("RHS-CONVERT") call s_convert_conservative_to_primitive_variables( & q_cons_qp%vf, & diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 4c4a159b80..dd04223cce 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -152,7 +152,7 @@ contains relax, relax_model, & palpha_eps, ptgalpha_eps, & R0_type, file_per_process, & - pi_fac, adv_n, adap_dt, R0ref, + pi_fac, adv_n, adap_dt, R0ref ! Checking that an input file has been provided by the user. If it ! has, then the input file is read in, otherwise, simulation exits. @@ -575,8 +575,8 @@ contains NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) ! Read the data for each variable - if (bubbles .or. hypoelasticity) then - + if ( bubbles .or. hypoelasticity .or. hyperelasticity ) then + print *, 'I was here AA' do i = 1, sys_size!adv_idx%end var_MOK = int(i, MPI_OFFSET_KIND) @@ -600,6 +600,8 @@ contains MPI_DOUBLE_PRECISION, status, ierr) end do end if + + print *, 'i :: ',xibeg,', data :: ',MPI_IO_DATA%var(xibeg)%sf(1,1,1) call s_mpi_barrier() @@ -661,7 +663,7 @@ contains NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) ! Read the data for each variable - if (bubbles .or. hypoelasticity) then + if ( bubbles .or. hypoelasticity .or. hyperelasticity ) then do i = 1, sys_size!adv_idx%end var_MOK = int(i, MPI_OFFSET_KIND) @@ -1375,7 +1377,6 @@ contains !$acc update device(bc_y%vb1, bc_y%vb2, bc_y%vb3, bc_y%ve1, bc_y%ve2, bc_y%ve3) !$acc update device(bc_z%vb1, bc_z%vb2, bc_z%vb3, bc_z%ve1, bc_z%ve2, bc_z%ve3) - !$acc update device(relax, relax_model) if (relax) then !$acc update device(palpha_eps, ptgalpha_eps) From 5a084e42f3558df29f5fe8210537fbeb79f2d095 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 22 May 2024 15:49:29 -0500 Subject: [PATCH 103/380] code compiles, integrating the grad_xi function --- src/common/m_variables_conversion.fpp | 54 ++++++++++---------------- src/simulation/m_global_parameters.fpp | 2 +- src/simulation/m_hyperelastic.fpp | 5 ++- src/simulation/m_start_up.fpp | 2 +- 4 files changed, 26 insertions(+), 37 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index ff16c7f1af..351a2f9dc2 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -933,6 +933,12 @@ contains end if #:endif + ! going through hyperelasticity again due to the btensor calculation + if (hyperelasticity) then + ! s_calculate_btensor has its own triple nested for loop with openacc + call s_calculate_btensor(qK_prim_vf, qK_btensor_vf) + end if + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) do l = izb, ize do k = iyb, iye @@ -1055,38 +1061,24 @@ contains end do end if - if (hyperelasticity .and. .not. bubbles) then ! .and. G_K > 100 ) then + if ( hyperelasticity ) then !$acc loop seq do i = xibeg, xiend qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) / rho_K end do + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K end if !$acc loop seq do i = advxb, advxe qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) end do - end do end do end do !$acc end parallel loop - ! going through hyperelasticity again due to the btensor calculation - if (hyperelasticity .and. .not. bubbles) then - ! s_calculate_btensor has its own triple nested for loop with openacc - call s_calculate_btensor(qK_prim_vf, qK_btensor_vf) - !$acc parallel loop collapse(3) gang vector default(present) private(gamma_K,G_K) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K - end do - end do - end do - !$acc end parallel loop - end if end subroutine s_convert_conservative_to_primitive_variables ! --------- @@ -1125,11 +1117,18 @@ contains real(kind(0d0)), dimension(2) :: Re_K integer :: i, j, k, l, q !< Generic loop iterators + +#ifndef MFC_SIMULATION do l = 1, b_size - @:ALLOCATE(q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) + @:ALLOCATE_GLOBAL(q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) end do -#ifndef MFC_SIMULATION + ! going through hyperelasticity again due to the btensor calculation + if (hyperelasticity ) then + ! s_calculate_btensor has its own triple nested for loop, with openacc + call s_calculate_btensor(q_prim_vf, q_btensor) + end if + ! Converting the primitive variables to the conservative variables do l = 0, p do k = 0, n @@ -1243,27 +1242,14 @@ contains do i = xibeg, xiend q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) end do + q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & + G*f_elastic_energy(q_btensor, j, k, l) end if end do end do end do - ! going through hyperelasticity again due to the btensor calculation - if (hyperelasticity .and. .not. bubbles) then - ! s_calculate_btensor has its own triple nested for loop, with openacc - call s_calculate_btensor(q_prim_vf, q_btensor) - ! triple nested for loop to update the total energy using the btensor information - ! openacc is not needed here as this function is used only in pre_process/post_process - do l = 0, p - do k = 0, n - do j = 0, m - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - G*f_elastic_energy(q_btensor, j, k, l) - end do - end do - end do - end if #else if (proc_rank == 0) then call s_mpi_abort('Conversion from primitive to '// & diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index df906cb245..6f255466cc 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -999,7 +999,7 @@ contains !$acc update device(m, n, p) !$acc update device(alt_soundspeed, monopole, num_mono) - !$acc update device(dt, sys_size, buff_size, pref, rhoref, gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim, bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids, model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord, mapped_weno, mp_weno, weno_eps) + !$acc update device(dt, sys_size, buff_size, pref, rhoref, gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim, bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids, model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord, mapped_weno, mp_weno, weno_eps, hyperelasticity) !$acc enter data copyin(nb, R0ref, Ca, Web, Re_inv, weight, R0, V0, bubbles, polytropic, polydisperse, qbmm, R0_type, ptil, bubble_model, thermal, poly_sigma) !$acc enter data copyin(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v, k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN , mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 9e00a4d437..e915d0950a 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -50,7 +50,10 @@ contains end do end do end do - if (proc_rank == 0) print *, 'J is ::', jacobian, 'this is sigma ::', sigma + !$acc end parallel loop + + !if (proc_rank == 0) print *, 'J is ::', jacobian, 'this is sigma ::', sigma + end subroutine s_calculate_cauchy_from_btensor function f_trace(symtensor) diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 4c4a159b80..b1cf042ecf 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -152,7 +152,7 @@ contains relax, relax_model, & palpha_eps, ptgalpha_eps, & R0_type, file_per_process, & - pi_fac, adv_n, adap_dt, R0ref, + pi_fac, adv_n, adap_dt, R0ref ! Checking that an input file has been provided by the user. If it ! has, then the input file is read in, otherwise, simulation exits. From 28caa5d019513433bfac305e677661002a4780a8 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 22 May 2024 16:10:33 -0500 Subject: [PATCH 104/380] next step towards merging the compute grad xi function --- src/common/m_variables_conversion.fpp | 12 +++++++----- src/common/m_xi_tensor_calc.fpp | 2 +- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 351a2f9dc2..17b122e95c 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1401,18 +1401,20 @@ contains subroutine s_calculate_btensor(q_prim_vf, btensor) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf type(scalar_field), dimension(b_size), intent(OUT) :: btensor + real(kind(0d0)), dimension(num_dims**2+1) :: tensorb + integer :: j, k, l - !$acc parallel loop collapse(3) gang vector default(present) private(grad_xi,ftensor,tensorb) + !$acc parallel loop collapse(3) gang vector default(present) private(tensorb) do l = izb, ize do k = iyb, iye do j = ixb, ixe ! STEP 1: calculate the grad_xi, grad_xi is a nxn tensor - call s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) + call s_compute_grad_xi(q_prim_vf, j, k, l, tensorb) ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - call s_calculate_ainverse(grad_xi,ftensor) + !call s_calculate_ainverse(grad_xi,ftensor) ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - call s_calculate_atransposea(ftensor,tensorb) + !call s_calculate_atransposea(ftensor,tensorb) ! btensor is symmetric, save the data space ! 1: 1D, 3: 2D, 6: 3D btensor(1)%sf(j, k, l) = tensorb(1) @@ -1427,7 +1429,7 @@ contains btensor(6)%sf(j,k,l) = tensorb(9) end if ! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j,k,l) = f_determinant(ftensor) + btensor(b_size)%sf(j,k,l) = tensorb(num_dims**2+1) end do end do end do diff --git a/src/common/m_xi_tensor_calc.fpp b/src/common/m_xi_tensor_calc.fpp index 589312f7d7..254149c024 100644 --- a/src/common/m_xi_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.fpp @@ -127,7 +127,7 @@ contains subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: grad_xi + real(kind(0d0)), dimension(num_dims**2+1), intent(OUT) :: grad_xi integer, intent(IN) :: j, k, l integer :: i From 9155e378e04409ec6a15f4be1becf0a266cd0d72 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 22 May 2024 16:27:50 -0500 Subject: [PATCH 105/380] more incremental changes, simulation compiles --- src/common/m_variables_conversion.fpp | 4 ++-- src/common/m_xi_tensor_calc.fpp | 17 ++++++++++------- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 17b122e95c..34e167be93 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1401,7 +1401,7 @@ contains subroutine s_calculate_btensor(q_prim_vf, btensor) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf type(scalar_field), dimension(b_size), intent(OUT) :: btensor - real(kind(0d0)), dimension(num_dims**2+1) :: tensorb + real(kind(0d0)), dimension(num_dims**2+1) :: tensorb, tensora, tensorc integer :: j, k, l @@ -1410,7 +1410,7 @@ contains do k = iyb, iye do j = ixb, ixe ! STEP 1: calculate the grad_xi, grad_xi is a nxn tensor - call s_compute_grad_xi(q_prim_vf, j, k, l, tensorb) + call s_compute_grad_xi(q_prim_vf, j, k, l, tensorb, tensora, tensorc) ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !call s_calculate_ainverse(grad_xi,ftensor) ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor diff --git a/src/common/m_xi_tensor_calc.fpp b/src/common/m_xi_tensor_calc.fpp index 254149c024..f6fbe12096 100644 --- a/src/common/m_xi_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.fpp @@ -15,11 +15,11 @@ module m_xi_tensor_calc implicit none - private; public :: s_calculate_ainverse, & - s_calculate_atransposea, & - f_determinant, & - f_elastic_energy, & - s_compute_grad_xi + private; public :: s_compute_grad_xi, f_elastic_energy + !s_calculate_ainverse, & + !s_calculate_atransposea, & + !f_determinant, & + !s_compute_grad_xi contains @@ -124,10 +124,13 @@ contains f_elastic_energy = 0.5d0*(invariant1 - 3)/btensor(b_size)%sf(j, k, l) end function f_elastic_energy - subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi) + subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi, tensora, tensorc) !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(num_dims**2+1), intent(OUT) :: grad_xi + real(kind(0d0)), dimension(num_dims**2+1), intent(OUT) :: grad_xi + real(kind(0d0)), dimension(num_dims**2+1), intent(OUT) :: tensora + real(kind(0d0)), dimension(num_dims**2+1), intent(OUT) :: tensorc + integer, intent(IN) :: j, k, l integer :: i From 74846fcad135c4b4ec61f5adbc8951009fcf466e Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 22 May 2024 16:42:59 -0500 Subject: [PATCH 106/380] additional incremental changes, simulation compiles --- src/common/m_variables_conversion.fpp | 22 +++--- src/common/m_xi_tensor_calc.fpp | 110 +++++++++++++------------- 2 files changed, 65 insertions(+), 67 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 34e167be93..909f5da348 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1401,8 +1401,8 @@ contains subroutine s_calculate_btensor(q_prim_vf, btensor) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf type(scalar_field), dimension(b_size), intent(OUT) :: btensor - real(kind(0d0)), dimension(num_dims**2+1) :: tensorb, tensora, tensorc - + real(kind(0d0)), dimension(num_dims**2+1) :: tensora, tensorb, tensorc + integer :: j, k, l !$acc parallel loop collapse(3) gang vector default(present) private(tensorb) @@ -1410,26 +1410,26 @@ contains do k = iyb, iye do j = ixb, ixe ! STEP 1: calculate the grad_xi, grad_xi is a nxn tensor - call s_compute_grad_xi(q_prim_vf, j, k, l, tensorb, tensora, tensorc) + call s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb, tensorc) ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !call s_calculate_ainverse(grad_xi,ftensor) ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !call s_calculate_atransposea(ftensor,tensorb) ! btensor is symmetric, save the data space ! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensorb(1) + btensor(1)%sf(j, k, l) = tensora(1) if (num_dims > 1) then ! 2D - btensor(2)%sf(j,k,l) = tensorb(2) - btensor(3)%sf(j,k,l) = tensorb(4) + btensor(2)%sf(j,k,l) = tensora(2) + btensor(3)%sf(j,k,l) = tensora(4) end if if (num_dims > 2) then ! 3D - btensor(3)%sf(j,k,l) = tensorb(3) - btensor(4)%sf(j,k,l) = tensorb(5) - btensor(5)%sf(j,k,l) = tensorb(6) - btensor(6)%sf(j,k,l) = tensorb(9) + btensor(3)%sf(j,k,l) = tensora(3) + btensor(4)%sf(j,k,l) = tensora(5) + btensor(5)%sf(j,k,l) = tensora(6) + btensor(6)%sf(j,k,l) = tensora(9) end if ! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j,k,l) = tensorb(num_dims**2+1) + btensor(b_size)%sf(j,k,l) = tensora(num_dims**2+1) end do end do end do diff --git a/src/common/m_xi_tensor_calc.fpp b/src/common/m_xi_tensor_calc.fpp index f6fbe12096..f3709bb9d6 100644 --- a/src/common/m_xi_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.fpp @@ -15,11 +15,11 @@ module m_xi_tensor_calc implicit none - private; public :: s_compute_grad_xi, f_elastic_energy + private; public :: s_compute_gradient_xi, f_elastic_energy !s_calculate_ainverse, & !s_calculate_atransposea, & !f_determinant, & - !s_compute_grad_xi + !s_compute_tensora contains @@ -124,19 +124,17 @@ contains f_elastic_energy = 0.5d0*(invariant1 - 3)/btensor(b_size)%sf(j, k, l) end function f_elastic_energy - subroutine s_compute_grad_xi(q_prim_vf, j, k, l, grad_xi, tensora, tensorc) + subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb, tensorc) !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(num_dims**2+1), intent(OUT) :: grad_xi - real(kind(0d0)), dimension(num_dims**2+1), intent(OUT) :: tensora - real(kind(0d0)), dimension(num_dims**2+1), intent(OUT) :: tensorc - + real(kind(0d0)), dimension(num_dims**2+1), intent(OUT) :: tensora, tensorb, tensorc integer, intent(IN) :: j, k, l + integer :: i if(j == 0) then ! dxix/dx - grad_xi(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & @@ -144,7 +142,7 @@ contains /(12d0*(x_cb(j+1) - x_cb(j))) else if (j == 1) then ! dxix/dx - grad_xi(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & @@ -152,7 +150,7 @@ contains /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == m - 1) then ! dxix/dx - grad_xi(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & @@ -160,7 +158,7 @@ contains /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == m) then ! dxix/dx - grad_xi(1) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensora(1) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & @@ -168,7 +166,7 @@ contains /(12d0*(x_cb(j) - x_cb(j-1))) else ! dxix/dx - grad_xi(1) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & + tensora(1) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - q_prim_vf(xibeg)%sf(j + 2, k, l)) & @@ -178,7 +176,7 @@ contains if (num_dims > 1) then if(j == 0) then ! dxiy / dx - grad_xi(2) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + tensora(2) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - 36d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & + 16d0*q_prim_vf(xibeg+1)%sf(j + 3, k, l) & @@ -186,7 +184,7 @@ contains /(12d0*(x_cb(j + 1) - x_cb(j))) else if (j == 1) then ! dxiy / dx - grad_xi(2) = (-3d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + tensora(2) = (-3d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - 6d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & @@ -194,7 +192,7 @@ contains /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == m - 1) then ! dxiy / dx - grad_xi(2) = (3d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + tensora(2) = (3d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + 6d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & @@ -202,7 +200,7 @@ contains /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == m) then ! dxiy / dx - grad_xi(2) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + tensora(2) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + 36d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - 16d0*q_prim_vf(xibeg+1)%sf(j - 3, k, l) & @@ -210,7 +208,7 @@ contains /(12d0*(x_cb(j) - x_cb(j - 1))) else ! dxiy / dx - grad_xi(2) = ( q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + tensora(2) = ( q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - 8d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + 8d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - q_prim_vf(xibeg+1)%sf(j + 2, k, l)) & @@ -219,7 +217,7 @@ contains if(k == 0) then ! dxix / dy - grad_xi(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & @@ -227,7 +225,7 @@ contains /(12d0*(y_cb(k+1) - y_cb(k))) else if (k == 1) then ! dxix / dy - grad_xi(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & @@ -235,7 +233,7 @@ contains /(12d0*(y_cb(j) - y_cb(j - 1))) else if (k == n - 1) then ! dxix / dy - grad_xi(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & @@ -243,7 +241,7 @@ contains /(12d0*(y_cb(j) - y_cb(j - 1))) else if (k == n) then ! dxix / dy - grad_xi(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & @@ -251,7 +249,7 @@ contains /(12d0*(y_cb(j) - y_cb(j-1))) else ! dxix / dy - grad_xi(3) = ( q_prim_vf(xibeg)%sf(j, k - 2, l) & + tensora(3) = ( q_prim_vf(xibeg)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - q_prim_vf(xibeg)%sf(j, k + 2, l)) & @@ -260,7 +258,7 @@ contains if(k == 0) then ! dxiy / dy - grad_xi(4) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + tensora(4) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - 36d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & + 16d0*q_prim_vf(xibeg+1)%sf(j, k + 3, l) & @@ -268,7 +266,7 @@ contains /(12d0*(y_cb(k+1) - y_cb(k))) else if (k == 1) then ! dxiy / dy - grad_xi(4) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + tensora(4) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - 6d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & @@ -276,7 +274,7 @@ contains /(12d0*(y_cb(j) - y_cb(j - 1))) else if (k == n - 1) then ! dxiy / dy - grad_xi(4) = (3d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + tensora(4) = (3d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + 6d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & @@ -284,7 +282,7 @@ contains /(12d0*(y_cb(j) - y_cb(j - 1))) else if (k == n) then ! dxiy / dy - grad_xi(4) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + tensora(4) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + 36d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - 16d0*q_prim_vf(xibeg+1)%sf(j, k - 3, l) & @@ -292,7 +290,7 @@ contains /(12d0*(y_cb(j) - y_cb(j-1))) else ! dxiy / dy - grad_xi(4) = ( q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + tensora(4) = ( q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - q_prim_vf(xibeg+1)%sf(j, k + 2, l)) & @@ -303,12 +301,12 @@ contains ! 3D if (num_dims > 2) then ! using results from upper if statement to map form 2x2 to 3x3 tensor - grad_xi(5) = grad_xi(4) - grad_xi(4) = grad_xi(3) + tensora(5) = tensora(4) + tensora(4) = tensora(3) if(l == 0) then ! dxix / dz - grad_xi(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - 36d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & + 16d0*q_prim_vf(xibeg)%sf(j, k , l + 3) & @@ -316,7 +314,7 @@ contains /(12d0*(z_cb(k+1) - z_cb(k))) else if (l == 1) then ! dxix / dz - grad_xi(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - 6d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & @@ -324,7 +322,7 @@ contains /(12d0*(z_cb(j) - z_cb(j - 1))) else if (l == p - 1) then ! dxix / dz - grad_xi(3) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & @@ -332,7 +330,7 @@ contains /(12d0*(z_cb(j) - z_cb(j - 1))) else if (l == p) then ! dxix / dz - grad_xi(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & @@ -340,7 +338,7 @@ contains /(12d0*(z_cb(j) - z_cb(j-1))) else ! dxix / dz - grad_xi(3) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & + tensora(3) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - q_prim_vf(xibeg)%sf(j, k , l + 2)) & @@ -349,7 +347,7 @@ contains if(l == 0) then ! dxiy / dz - grad_xi(6) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + tensora(6) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - 36d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & + 16d0*q_prim_vf(xibeg+1)%sf(j, k , l + 3) & @@ -357,7 +355,7 @@ contains /(12d0*(z_cb(k+1) - z_cb(k))) else if (l == 1) then ! dxiy / dz - grad_xi(6) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + tensora(6) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - 6d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & @@ -365,7 +363,7 @@ contains /(12d0*(z_cb(j) - z_cb(j - 1))) else if (l == p - 1) then ! dxiy / dz - grad_xi(6) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + tensora(6) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & @@ -373,7 +371,7 @@ contains /(12d0*(z_cb(j) - z_cb(j - 1))) else if (l == p) then ! dxiy / dz - grad_xi(6) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + tensora(6) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & @@ -381,7 +379,7 @@ contains /(12d0*(z_cb(j) - z_cb(j-1))) else ! dxiy / dz - grad_xi(6) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + tensora(6) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & @@ -390,7 +388,7 @@ contains if(j == 0) then ! dxiz / dx - grad_xi(7) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(7) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & @@ -398,7 +396,7 @@ contains /(12d0*(x_cb(j + 1) - x_cb(j))) else if (j == 1) then ! dxiz / dx - grad_xi(7) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + tensora(7) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & @@ -406,7 +404,7 @@ contains /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == m - 1) then ! dxiz / dx - grad_xi(7) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + tensora(7) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & @@ -414,7 +412,7 @@ contains /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == m) then ! dxiz / dx - grad_xi(7) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(7) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & @@ -422,7 +420,7 @@ contains /(12d0*(x_cb(j) - x_cb(j - 1))) else ! dxiz / dx - grad_xi(7) = ( q_prim_vf(xiend)%sf(j - 2, k, l) & + tensora(7) = ( q_prim_vf(xiend)%sf(j - 2, k, l) & - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - q_prim_vf(xiend)%sf(j + 2, k, l)) & @@ -431,7 +429,7 @@ contains if(k == 0) then ! dxiz / dy - grad_xi(8) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(8) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & @@ -439,7 +437,7 @@ contains /(12d0*(y_cb(k+1) - y_cb(k))) else if (k == 1) then ! dxiz / dy - grad_xi(8) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + tensora(8) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & @@ -447,7 +445,7 @@ contains /(12d0*(y_cb(j) - y_cb(j - 1))) else if (k == n - 1) then ! dxiz / dy - grad_xi(8) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + tensora(8) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & @@ -455,7 +453,7 @@ contains /(12d0*(y_cb(j) - y_cb(j - 1))) else if (k == n) then ! dxiz / dy - grad_xi(8) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(8) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & @@ -463,7 +461,7 @@ contains /(12d0*(y_cb(j) - y_cb(j-1))) else ! dxiz / dy - grad_xi(8) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & + tensora(8) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - q_prim_vf(xiend)%sf(j, k + 2, l)) & @@ -472,7 +470,7 @@ contains if(l == 0) then ! dxiz / dz - grad_xi(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + 48d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - 36d0*q_prim_vf(xiend)%sf(j, k , l + 2) & + 16d0*q_prim_vf(xiend)%sf(j, k , l + 3) & @@ -480,7 +478,7 @@ contains /(12d0*(z_cb(k+1) - z_cb(k))) else if (l == 1) then ! dxiz / dz - grad_xi(9) = (-3d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + 18d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - 6d0*q_prim_vf(xiend)%sf(j, k , l + 2) & @@ -488,7 +486,7 @@ contains /(12d0*(z_cb(j) - z_cb(j - 1))) else if (l == p - 1) then ! dxiz / dz - grad_xi(9) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - 18d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & @@ -496,7 +494,7 @@ contains /(12d0*(z_cb(j) - z_cb(j - 1))) else if (l == p) then ! dxiz / dz - grad_xi(9) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(9) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - 48d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + 36d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - 16d0*q_prim_vf(xiend)%sf(j, k , l - 3) & @@ -504,7 +502,7 @@ contains /(12d0*(z_cb(j) - z_cb(j-1))) else ! dxiz / dz - grad_xi(9) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & + tensora(9) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & - 8d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + 8d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - q_prim_vf(xiend)%sf(j, k , l + 2)) & @@ -514,10 +512,10 @@ contains !if(proc_rank == 0) then ! do i = 1, num_dims**2 - ! print *, "i :: ",i,", grad_xi :: ",grad_xi(i) + ! print *, "i :: ",i,", tensora :: ",tensora(i) ! end do !end if - end subroutine s_compute_grad_xi + end subroutine s_compute_gradient_xi end module m_xi_tensor_calc From 0d7ea28d7be964c9b874f947082ab20981e9196f Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 22 May 2024 16:54:50 -0500 Subject: [PATCH 107/380] incremental changes, simulation still complies --- src/common/m_variables_conversion.fpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 909f5da348..97cb3fcde7 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1405,7 +1405,7 @@ contains integer :: j, k, l - !$acc parallel loop collapse(3) gang vector default(present) private(tensorb) + !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb,tensorc) do l = izb, ize do k = iyb, iye do j = ixb, ixe From be3470b5694138827dd84da79d779513379dfcd3 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 22 May 2024 17:14:46 -0500 Subject: [PATCH 108/380] beginning the integration into grad xi, not meant to compile --- src/common/m_variables_conversion.fpp | 26 ---- src/common/m_xi_tensor_calc.fpp | 214 +++++++++++++------------- 2 files changed, 107 insertions(+), 133 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 97cb3fcde7..3ebb4ae211 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -110,20 +110,6 @@ module m_variables_conversion real(kind(0d0)), allocatable, dimension(:, :, :), public :: pi_inf_sf !< Scalar liquid stiffness function real(kind(0d0)), allocatable, dimension(:, :, :), public :: qv_sf !< Scalar liquid energy reference function -#ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), grad_xi) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), ftensor) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), tensorb) - !$acc declare link(grad_xi,ftensor,tensorb) -#else - real(kind(0d0)), allocatable, dimension(:) :: grad_xi, ftensor, tensorb - !$acc declare create(grad_xi,ftensor,tensorb) -#endif - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - procedure(s_convert_xxxxx_to_mixture_variables), & pointer :: s_convert_to_mixture_variables => null() !< !! Pointer referencing the subroutine s_convert_mixture_to_mixture_variables @@ -784,14 +770,6 @@ contains end if #endif - @:ALLOCATE(grad_xi(1:num_dims**2)) - @:ALLOCATE(ftensor(1:num_dims**2)) - @:ALLOCATE(tensorb(1:num_dims**2)) - grad_xi(:) = 0d0 - ftensor(:) = 0d0 - tensorb(:) = 0d0 -!$acc update device(grad_xi,ftensor,tensorb) - if (model_eqns == 1) then ! Gamma/pi_inf model s_convert_to_mixture_variables => & s_convert_mixture_to_mixture_variables @@ -1457,10 +1435,6 @@ contains end if #endif -#ifdef MFC_SIMULATION - @:DEALLOCATE(grad_xi,ftensor,tensorb) -#endif - ! Nullifying the procedure pointer to the subroutine transferring/ ! computing the mixture/species variables to the mixture variables s_convert_to_mixture_variables => null() diff --git a/src/common/m_xi_tensor_calc.fpp b/src/common/m_xi_tensor_calc.fpp index f3709bb9d6..2990a77cc9 100644 --- a/src/common/m_xi_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.fpp @@ -16,113 +16,8 @@ module m_xi_tensor_calc implicit none private; public :: s_compute_gradient_xi, f_elastic_energy - !s_calculate_ainverse, & - !s_calculate_atransposea, & - !f_determinant, & - !s_compute_tensora -contains - - function f_determinant(tensor) - !$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)) :: f_determinant - - if (num_dims == 1) then - f_determinant = tensor(1) - elseif (num_dims == 2) then - f_determinant = tensor(1)*tensor(4) - tensor(2)*tensor(3) - else - f_determinant = tensor(1)*(tensor(5)*tensor(9) - tensor(6)*tensor(8)) & - - tensor(2)*(tensor(4)*tensor(9) - tensor(6)*tensor(7)) & - + tensor(3)*(tensor(4)*tensor(8) - tensor(5)*tensor(7)) - end if - ! error checking - if (f_determinant == 0) then - print *, 'f_determinant :: ', f_determinant - print *, 'ERROR: Determinant was zero' - stop - end if - end function f_determinant - - subroutine s_calculate_atransposea(tensor, ata) - !$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ata - - ata(1) = tensor(1)**2 - if (num_dims == 2) then - ata(1) = ata(1) + tensor(3)**2 - ata(2) = tensor(1)*tensor(2) + tensor(3)*tensor(4) - ata(3) = ata(2) - ata(4) = tensor(2)**2 + tensor(4)**2 - elseif (num_dims == 3) then - ata(1) = ata(1) + tensor(4)**2 + tensor(7)**2 - ata(5) = tensor(2) + tensor(5)**2 + tensor(8)**2 - ata(9) = tensor(3) + tensor(6)**2 + tensor(9)**2 - ata(2) = tensor(1)*tensor(2) + tensor(4)*tensor(5) + tensor(7)*tensor(8) - ata(3) = tensor(1)*tensor(3) + tensor(4)*tensor(6) + tensor(7)*tensor(9) - ata(6) = tensor(2)*tensor(3) + tensor(5)*tensor(6) + tensor(8)*tensor(9) - ata(4) = ata(2) - ata(7) = ata(3) - ata(8) = ata(4) - end if - end subroutine s_calculate_atransposea - - subroutine s_calculate_adjointa(tensor, dja) - !$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: dja - - if (num_dims == 1) then - dja(1) = 1 - elseif (num_dims == 2) then - dja(1) = tensor(4) - dja(2) = -tensor(3) - dja(3) = -tensor(2) - dja(4) = tensor(1) - elseif (num_dims == 3) then - dja(1) = tensor(5)*tensor(9) - tensor(6)*tensor(8) - dja(2) = -(tensor(2)*tensor(9) - tensor(3)*tensor(8)) - dja(3) = tensor(2)*tensor(6) - tensor(3)*tensor(5) - dja(4) = -(tensor(4)*tensor(9) - tensor(6)*tensor(7)) - dja(5) = tensor(1)*tensor(9) - tensor(3)*tensor(7) - dja(6) = -(tensor(1)*tensor(6) - tensor(4)*tensor(3)) - dja(7) = tensor(4)*tensor(8) - tensor(5)*tensor(7) - dja(8) = -(tensor(1)*tensor(8) - tensor(2)*tensor(7)) - dja(9) = tensor(1)*tensor(5) - tensor(2)*tensor(4) - end if - end subroutine s_calculate_adjointa - - subroutine s_calculate_ainverse(tensor, ainv) - !$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ainv - real(kind(0d0)), dimension(num_dims**2) :: dja - real(kind(0d0)) :: det - - call s_calculate_adjointa(tensor, dja) - ainv(:) = dja(:)/f_determinant(tensor) - - end subroutine s_calculate_ainverse - - ! neo-Hookean only at this time, will need to be changed later - function f_elastic_energy(btensor, j, k, l) - !$acc routine seq - type(scalar_field), dimension(b_size), intent(IN) :: btensor - integer, intent(IN) :: j, k, l - real(kind(0d0)) :: invariant1, f_elastic_energy - - invariant1 = btensor(1)%sf(j, k, l) - f_elastic_energy = 0d0 - if (num_dims == 2) then - invariant1 = invariant1 + btensor(3)%sf(j, k, l) - elseif (num_dims == 3) then - invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) - end if - ! compute the invariant without the elastic modulus - f_elastic_energy = 0.5d0*(invariant1 - 3)/btensor(b_size)%sf(j, k, l) - end function f_elastic_energy + contains subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb, tensorc) !$acc routine seq @@ -131,7 +26,10 @@ contains integer, intent(IN) :: j, k, l integer :: i - + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz if(j == 0) then ! dxix/dx tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & @@ -516,6 +414,108 @@ contains ! end do !end if + subroutine s_calculate_adjointa(tensor, dja) + !$acc routine seq + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: dja + + if (num_dims == 1) then + dja(1) = 1 + elseif (num_dims == 2) then + dja(1) = tensor(4) + dja(2) = -tensor(3) + dja(3) = -tensor(2) + dja(4) = tensor(1) + elseif (num_dims == 3) then + dja(1) = tensor(5)*tensor(9) - tensor(6)*tensor(8) + dja(2) = -(tensor(2)*tensor(9) - tensor(3)*tensor(8)) + dja(3) = tensor(2)*tensor(6) - tensor(3)*tensor(5) + dja(4) = -(tensor(4)*tensor(9) - tensor(6)*tensor(7)) + dja(5) = tensor(1)*tensor(9) - tensor(3)*tensor(7) + dja(6) = -(tensor(1)*tensor(6) - tensor(4)*tensor(3)) + dja(7) = tensor(4)*tensor(8) - tensor(5)*tensor(7) + dja(8) = -(tensor(1)*tensor(8) - tensor(2)*tensor(7)) + dja(9) = tensor(1)*tensor(5) - tensor(2)*tensor(4) + end if + end subroutine s_calculate_adjointa + + function f_determinant(tensor) + !$acc routine seq + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)) :: f_determinant + + if (num_dims == 1) then + f_determinant = tensor(1) + elseif (num_dims == 2) then + f_determinant = tensor(1)*tensor(4) - tensor(2)*tensor(3) + else + f_determinant = tensor(1)*(tensor(5)*tensor(9) - tensor(6)*tensor(8)) & + - tensor(2)*(tensor(4)*tensor(9) - tensor(6)*tensor(7)) & + + tensor(3)*(tensor(4)*tensor(8) - tensor(5)*tensor(7)) + end if + ! error checking + if (f_determinant == 0) then + print *, 'f_determinant :: ', f_determinant + print *, 'ERROR: Determinant was zero' + stop + end if + end function f_determinant + + subroutine s_calculate_ainverse(tensor, ainv) + !$acc routine seq + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ainv + real(kind(0d0)), dimension(num_dims**2) :: dja + real(kind(0d0)) :: det + + call s_calculate_adjointa(tensor, dja) + ainv(:) = dja(:)/f_determinant(tensor) + + end subroutine s_calculate_ainverse + + + subroutine s_calculate_atransposea(tensor, ata) + !$acc routine seq + real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor + real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ata + + ata(1) = tensor(1)**2 + if (num_dims == 2) then + ata(1) = ata(1) + tensor(3)**2 + ata(2) = tensor(1)*tensor(2) + tensor(3)*tensor(4) + ata(3) = ata(2) + ata(4) = tensor(2)**2 + tensor(4)**2 + elseif (num_dims == 3) then + ata(1) = ata(1) + tensor(4)**2 + tensor(7)**2 + ata(5) = tensor(2) + tensor(5)**2 + tensor(8)**2 + ata(9) = tensor(3) + tensor(6)**2 + tensor(9)**2 + ata(2) = tensor(1)*tensor(2) + tensor(4)*tensor(5) + tensor(7)*tensor(8) + ata(3) = tensor(1)*tensor(3) + tensor(4)*tensor(6) + tensor(7)*tensor(9) + ata(6) = tensor(2)*tensor(3) + tensor(5)*tensor(6) + tensor(8)*tensor(9) + ata(4) = ata(2) + ata(7) = ata(3) + ata(8) = ata(4) + end if + end subroutine s_calculate_atransposea + end subroutine s_compute_gradient_xi + ! neo-Hookean only at this time, will need to be changed later + function f_elastic_energy(btensor, j, k, l) + !$acc routine seq + type(scalar_field), dimension(b_size), intent(IN) :: btensor + integer, intent(IN) :: j, k, l + real(kind(0d0)) :: invariant1, f_elastic_energy + + invariant1 = btensor(1)%sf(j, k, l) + f_elastic_energy = 0d0 + if (num_dims == 2) then + invariant1 = invariant1 + btensor(3)%sf(j, k, l) + elseif (num_dims == 3) then + invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + end if + ! compute the invariant without the elastic modulus + f_elastic_energy = 0.5d0*(invariant1 - 3)/btensor(b_size)%sf(j, k, l) + end function f_elastic_energy + end module m_xi_tensor_calc From 685aa0720e8bd5cee54e773b5576f4565edc547f Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 22 May 2024 17:53:28 -0500 Subject: [PATCH 109/380] this commit compiles on simulation --- src/common/m_variables_conversion.fpp | 6 +- src/common/m_xi_tensor_calc.fpp | 115 +++++++++++--------------- 2 files changed, 51 insertions(+), 70 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 3ebb4ae211..98e6bbf7f6 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1379,16 +1379,16 @@ contains subroutine s_calculate_btensor(q_prim_vf, btensor) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf type(scalar_field), dimension(b_size), intent(OUT) :: btensor - real(kind(0d0)), dimension(num_dims**2+1) :: tensora, tensorb, tensorc + real(kind(0d0)), dimension(num_dims**2+1) :: tensora, tensorb integer :: j, k, l - !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb,tensorc) + !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) do l = izb, ize do k = iyb, iye do j = ixb, ixe ! STEP 1: calculate the grad_xi, grad_xi is a nxn tensor - call s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb, tensorc) + call s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !call s_calculate_ainverse(grad_xi,ftensor) ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor diff --git a/src/common/m_xi_tensor_calc.fpp b/src/common/m_xi_tensor_calc.fpp index 2990a77cc9..8208563fb5 100644 --- a/src/common/m_xi_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.fpp @@ -19,13 +19,16 @@ module m_xi_tensor_calc contains - subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb, tensorc) + subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(num_dims**2+1), intent(OUT) :: tensora, tensorb, tensorc + real(kind(0d0)), dimension(num_dims**2+1), intent(OUT) :: tensora, tensorb integer, intent(IN) :: j, k, l + real(kind(0d0)) :: determinant integer :: i + + ! STEP 1: computing the grad_xi tensor ! grad_xi definition / organization ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy @@ -414,89 +417,67 @@ module m_xi_tensor_calc ! end do !end if - subroutine s_calculate_adjointa(tensor, dja) - !$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: dja - + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse if (num_dims == 1) then - dja(1) = 1 + tensorb(1) = 1 elseif (num_dims == 2) then - dja(1) = tensor(4) - dja(2) = -tensor(3) - dja(3) = -tensor(2) - dja(4) = tensor(1) + tensorb(1) = tensora(4) + tensorb(2) = -tensora(3) + tensorb(3) = -tensora(2) + tensorb(4) = tensora(1) elseif (num_dims == 3) then - dja(1) = tensor(5)*tensor(9) - tensor(6)*tensor(8) - dja(2) = -(tensor(2)*tensor(9) - tensor(3)*tensor(8)) - dja(3) = tensor(2)*tensor(6) - tensor(3)*tensor(5) - dja(4) = -(tensor(4)*tensor(9) - tensor(6)*tensor(7)) - dja(5) = tensor(1)*tensor(9) - tensor(3)*tensor(7) - dja(6) = -(tensor(1)*tensor(6) - tensor(4)*tensor(3)) - dja(7) = tensor(4)*tensor(8) - tensor(5)*tensor(7) - dja(8) = -(tensor(1)*tensor(8) - tensor(2)*tensor(7)) - dja(9) = tensor(1)*tensor(5) - tensor(2)*tensor(4) + tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) + tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) + tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) + tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) + tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) + tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) + tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) + tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) + tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) end if - end subroutine s_calculate_adjointa - - function f_determinant(tensor) - !$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)) :: f_determinant + ! STEP 2b: computing the determinant of the grad_xi tensor if (num_dims == 1) then - f_determinant = tensor(1) + determinant = tensora(1) elseif (num_dims == 2) then - f_determinant = tensor(1)*tensor(4) - tensor(2)*tensor(3) + determinant = tensora(1)*tensora(4) - tensora(2)*tensora(3) else - f_determinant = tensor(1)*(tensor(5)*tensor(9) - tensor(6)*tensor(8)) & - - tensor(2)*(tensor(4)*tensor(9) - tensor(6)*tensor(7)) & - + tensor(3)*(tensor(4)*tensor(8) - tensor(5)*tensor(7)) + determinant = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) end if ! error checking - if (f_determinant == 0) then - print *, 'f_determinant :: ', f_determinant + if (determinant == 0) then + print *, 'determinant :: ', determinant print *, 'ERROR: Determinant was zero' stop end if - end function f_determinant - - subroutine s_calculate_ainverse(tensor, ainv) - !$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ainv - real(kind(0d0)), dimension(num_dims**2) :: dja - real(kind(0d0)) :: det - - call s_calculate_adjointa(tensor, dja) - ainv(:) = dja(:)/f_determinant(tensor) - - end subroutine s_calculate_ainverse + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse + tensora(:) = tensorb(:)/determinant - subroutine s_calculate_atransposea(tensor, ata) - !$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: tensor - real(kind(0d0)), dimension(num_dims**2), intent(OUT) :: ata - - ata(1) = tensor(1)**2 + ! STEP 3: computing F tranpose F + tensorb(1) = tensora(1)**2 if (num_dims == 2) then - ata(1) = ata(1) + tensor(3)**2 - ata(2) = tensor(1)*tensor(2) + tensor(3)*tensor(4) - ata(3) = ata(2) - ata(4) = tensor(2)**2 + tensor(4)**2 + tensorb(1) = tensorb(1) + tensora(3)**2 + tensorb(2) = tensora(1)*tensora(2) + tensora(3)*tensora(4) + tensorb(3) = tensorb(2) + tensorb(4) = tensora(2)**2 + tensora(4)**2 elseif (num_dims == 3) then - ata(1) = ata(1) + tensor(4)**2 + tensor(7)**2 - ata(5) = tensor(2) + tensor(5)**2 + tensor(8)**2 - ata(9) = tensor(3) + tensor(6)**2 + tensor(9)**2 - ata(2) = tensor(1)*tensor(2) + tensor(4)*tensor(5) + tensor(7)*tensor(8) - ata(3) = tensor(1)*tensor(3) + tensor(4)*tensor(6) + tensor(7)*tensor(9) - ata(6) = tensor(2)*tensor(3) + tensor(5)*tensor(6) + tensor(8)*tensor(9) - ata(4) = ata(2) - ata(7) = ata(3) - ata(8) = ata(4) + tensorb(1) = tensorb(1) + tensora(4)**2 + tensora(7)**2 + tensorb(5) = tensora(2) + tensora(5)**2 + tensora(8)**2 + tensorb(9) = tensora(3) + tensora(6)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(2) + tensora(4)*tensora(5) + tensora(7)*tensora(8) + tensorb(3) = tensora(1)*tensora(3) + tensora(4)*tensora(6) + tensora(7)*tensora(9) + tensorb(6) = tensora(2)*tensora(3) + tensora(5)*tensora(6) + tensora(8)*tensora(9) + tensorb(4) = tensorb(2) + tensorb(7) = tensorb(3) + tensorb(8) = tensorb(4) end if - end subroutine s_calculate_atransposea + ! STEP 4: store the determinant of F in the last entry of the tensor + tensorb(num_dims**2+1) = determinant end subroutine s_compute_gradient_xi From 3d49cb33d064769aee2c96ce180c4720055e1e4e Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 22 May 2024 21:48:33 -0500 Subject: [PATCH 110/380] code fully compiles, beginning testing of pre_process and simulation --- src/common/m_variables_conversion.fpp | 31 ++++----- src/common/m_xi_tensor_calc.fpp | 6 +- src/simulation/m_hyperelastic.f90 | 73 +++++++++++++++++++++ src/simulation/m_hyperelastic.fpp | 91 --------------------------- src/simulation/m_rhs.fpp | 8 ++- 5 files changed, 100 insertions(+), 109 deletions(-) create mode 100644 src/simulation/m_hyperelastic.f90 delete mode 100644 src/simulation/m_hyperelastic.fpp diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index d55d7a064d..91041c80d8 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -912,11 +912,13 @@ contains #:endif ! going through hyperelasticity again due to the btensor calculation + ! s_calculate_btensor has its own triple nested for loop with openacc print *, 'I got here A1' + if (hyperelasticity) then - ! s_calculate_btensor has its own triple nested for loop with openacc call s_calculate_btensor(qK_prim_vf, qK_btensor_vf) end if + print *, 'I got here A2' !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) @@ -1054,6 +1056,7 @@ contains do i = advxb, advxe qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) end do + end do end do end do @@ -1103,8 +1106,8 @@ contains end do ! going through hyperelasticity again due to the btensor calculation + ! s_calculate_btensor has its own triple nested for loop, with openacc if (hyperelasticity ) then - ! s_calculate_btensor has its own triple nested for loop, with openacc call s_calculate_btensor(q_prim_vf, q_btensor) end if @@ -1231,11 +1234,13 @@ contains end do #else + if (proc_rank == 0) then call s_mpi_abort('Conversion from primitive to '// & 'conservative variables not '// & 'implemented. Exiting ...') end if + #endif end subroutine s_convert_primitive_to_conservative_variables ! --------- @@ -1390,27 +1395,25 @@ contains do l = izb, ize do k = iyb, iye do j = ixb, ixe - ! STEP 1: calculate the grad_xi, grad_xi is a nxn tensor - call s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) + ! calculate the grad_xi, grad_xi is a nxn tensor ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !call s_calculate_ainverse(grad_xi,ftensor) ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !call s_calculate_atransposea(ftensor,tensorb) ! btensor is symmetric, save the data space + call s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) ! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensora(1) + btensor(1)%sf(j, k, l) = tensorb(1) if (num_dims > 1) then ! 2D - btensor(2)%sf(j,k,l) = tensora(2) - btensor(3)%sf(j,k,l) = tensora(4) + btensor(2)%sf(j,k,l) = tensorb(2) + btensor(3)%sf(j,k,l) = tensorb(4) end if if (num_dims > 2) then ! 3D - btensor(3)%sf(j,k,l) = tensora(3) - btensor(4)%sf(j,k,l) = tensora(5) - btensor(5)%sf(j,k,l) = tensora(6) - btensor(6)%sf(j,k,l) = tensora(9) + btensor(3)%sf(j,k,l) = tensorb(3) + btensor(4)%sf(j,k,l) = tensorb(5) + btensor(5)%sf(j,k,l) = tensorb(6) + btensor(6)%sf(j,k,l) = tensorb(9) end if ! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j,k,l) = tensora(num_dims**2+1) + btensor(b_size)%sf(j,k,l) = tensorb(num_dims**2+1) end do end do end do diff --git a/src/common/m_xi_tensor_calc.fpp b/src/common/m_xi_tensor_calc.fpp index 0ae0a7394d..8fa6eb9cd7 100644 --- a/src/common/m_xi_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.fpp @@ -488,15 +488,19 @@ module m_xi_tensor_calc integer, intent(IN) :: j, k, l real(kind(0d0)) :: invariant1, f_elastic_energy - invariant1 = btensor(1)%sf(j, k, l) f_elastic_energy = 0d0 + + invariant1 = btensor(1)%sf(j, k, l) + if (num_dims == 2) then invariant1 = invariant1 + btensor(3)%sf(j, k, l) elseif (num_dims == 3) then invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) end if + ! compute the invariant without the elastic modulus f_elastic_energy = 0.5d0*(invariant1 - 3.0d0)/btensor(b_size)%sf(j, k, l) + end function f_elastic_energy end module m_xi_tensor_calc diff --git a/src/simulation/m_hyperelastic.f90 b/src/simulation/m_hyperelastic.f90 new file mode 100644 index 0000000000..4c7b265fee --- /dev/null +++ b/src/simulation/m_hyperelastic.f90 @@ -0,0 +1,73 @@ +!> +!! @file m_hyperelastic.f90 +!! @brief Contains module m_hyperelastic + +!> @brief This module is used to compute source terms for hyperelastic model +module m_hyperelastic + + ! Dependencies ============================================================= + + use m_derived_types !< Definitions of the derived types + + use m_global_parameters !< Definitions of the global parameters + + ! ========================================================================== + + implicit none + + private; public :: s_calculate_cauchy_from_btensor + + contains + + subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf) + type(scalar_field), dimension(sys_size), intent(INOUT) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(IN) :: btensor + + real(kind(0d0)), dimension(b_size-1) :: tensor + real(kind(0d0)) :: trace + integer :: i, j, k, l !< Generic loop iterators + + !$acc parallel loop collapse(3) gang vector default(present) private(trace, tensor) + do l = 0, p + do k = 0, n + do j = 0, m + ! tensor is the symmetric tensor + + !$acc loop seq + do i = 1, b_size - 1 + tensor(i) = btensor(i)%sf(j, k, l) + end do + + ! calculate the trace of the tensor + trace = tensor(1) + if (num_dims == 2) then + trace = trace + tensor(3) + else + trace = trace + tensor(4) + tensor(6) + end if + ! calculate the deviatoric of the tensor + tensor(1) = tensor(1) - (1d0/3d0)*trace + if (num_dims == 2) then + tensor(3) = tensor(3) - (1d0/3d0)*trace + else + tensor(4) = tensor(4) - (1d0/3d0)*trace + tensor(6) = tensor(6) - (1d0/3d0)*trace + end if + ! dividing by the jacobian for neo-Hookean model + tensor(:) = tensor(:)/btensor(b_size)%sf(j, k, l) + + ! setting the tensor to the stresses for riemann solver + !$acc loop seq + do i = 1, b_size - 1 + q_prim_vf(strxb+i)%sf(j, k, l) = tensor(i) + end do + + end do + end do + end do + !$acc end parallel loop + + !if (proc_rank == 0) print *, 'J is ::', jacobian, 'this is sigma ::', sigma + end subroutine s_calculate_cauchy_from_btensor + +end module m_hyperelastic diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp deleted file mode 100644 index 7ea51dae62..0000000000 --- a/src/simulation/m_hyperelastic.fpp +++ /dev/null @@ -1,91 +0,0 @@ -!> -!! @file m_hyperelastic.f90 -!! @brief Contains module m_hyperelastic - -#:include 'macros.fpp' - -!> @brief This module is used to compute source terms for hyperelastic model -module m_hyperelastic - - ! Dependencies ============================================================= - - use m_derived_types !< Definitions of the derived types - - use m_global_parameters !< Definitions of the global parameters - - use m_mpi_proxy !< Message passing interface (MPI) module proxy - - ! ========================================================================== - - implicit none - - private; public :: s_calculate_cauchy_from_btensor - - - - -contains - - subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf) - !!!!$acc routine seq - type(scalar_field), dimension(sys_size), intent(INOUT) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(IN) :: btensor - - real(kind(0d0)), dimension(b_size) :: sigma, tensorb, devbtensor - real(kind(0d0)) :: jacobian - integer :: i, j, k, l !< Generic loop iterators - - !if (proc_rank ==0) print*, 'this is btensor ::', btensor - ! extracting the nxn tensor for the calculation - !$acc parallel loop collapse(3) gang vector default(present) - do l = 0, p - do k = 0, n - do j = 0, m - do i = 1, b_size - 1 - tensorb(i) = btensor(i)%sf(j, k, l) - end do - jacobian = btensor(b_size + 1)%sf(j, k, l) - call s_calculate_deviatoric(tensorb, devbtensor) - sigma(:) = devbtensor(:)/jacobian - do i = 1, b_size - 1 - q_prim_vf(i)%sf(j, k, l) = sigma(i) - end do - end do - end do - end do - !$acc end parallel loop - - !if (proc_rank == 0) print *, 'J is ::', jacobian, 'this is sigma ::', sigma - - end subroutine s_calculate_cauchy_from_btensor - - function f_trace(symtensor) - !!!$acc routine seq - real(kind(0d0)), dimension(num_dims**2), intent(IN) :: symtensor - real(kind(0d0)) :: f_trace - - f_trace = symtensor(1) - if (num_dims == 2) then - f_trace = symtensor(1) + symtensor(3) - else - f_trace = symtensor(1) + symtensor(4) + symtensor(6) - end if - end function f_trace - - subroutine s_calculate_deviatoric(symtensor, devtensor) - !!!!$acc routine seq - real(kind(0d0)), dimension(num_dims*2 + 1), intent(IN) :: symtensor - real(kind(0d0)), dimension(num_dims*2), intent(OUT) :: devtensor - real(kind(0d0)) :: trace - devtensor = symtensor - trace = f_trace(symtensor) - devtensor(1) = symtensor(1) - (1d0/3d0)*trace - if (num_dims == 2) then - devtensor(3) = symtensor(3) - (1d0/3d0)*trace - else - devtensor(4) = symtensor(4) - (1d0/3d0)*trace - devtensor(6) = symtensor(6) - (1d0/3d0)*trace - end if - end subroutine s_calculate_deviatoric - -end module m_hyperelastic diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 92f0fa518e..6cac2b43a9 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -732,13 +732,15 @@ contains ix, iy, iz, & q_btensor%vf) call nvtxEndRange + print *, 'I got here 2 !' call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") - !if (hyperelasticity) then - ! call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf) - !end if + if ( hyperelasticity ) then + call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf) + end if call nvtxEndRange + print *, 'I got here 3 !' call nvtxStartRange("RHS-MPI") From a1273a616f46388fc2f4f790299e802608bf4987 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 23 May 2024 00:18:20 -0500 Subject: [PATCH 111/380] code compiles and still debugging --- src/common/m_variables_conversion.fpp | 8 +++++++- src/common/m_xi_tensor_calc.fpp | 18 +++++++++++------- src/simulation/m_global_parameters.fpp | 2 +- src/simulation/m_rhs.fpp | 5 +++++ src/simulation/m_riemann_solvers.fpp | 10 +++++----- src/simulation/m_start_up.fpp | 3 +-- 6 files changed, 30 insertions(+), 16 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 91041c80d8..4b4df30cb6 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1102,14 +1102,16 @@ contains #ifndef MFC_SIMULATION do l = 1, b_size - @:ALLOCATE_GLOBAL(q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) + @:ALLOCATE(q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) end do ! going through hyperelasticity again due to the btensor calculation ! s_calculate_btensor has its own triple nested for loop, with openacc + print *, 'I got here B1' if (hyperelasticity ) then call s_calculate_btensor(q_prim_vf, q_btensor) end if + print *, 'I got here B2' ! Converting the primitive variables to the conservative variables do l = 0, p @@ -1390,6 +1392,7 @@ contains real(kind(0d0)), dimension(num_dims**2+1) :: tensora, tensorb integer :: j, k, l + print *, 'I got here in btensor calc' !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) do l = izb, ize @@ -1399,7 +1402,9 @@ contains ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor ! btensor is symmetric, save the data space + print *, 'I got here in triple do loop ' call s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) + print *, 'I got out of gradient_xi' ! 1: 1D, 3: 2D, 6: 3D btensor(1)%sf(j, k, l) = tensorb(1) if (num_dims > 1) then ! 2D @@ -1418,6 +1423,7 @@ contains end do end do !$acc end parallel loop + print *, 'I got to the end of triple do loop of tensorb calc' end subroutine s_calculate_btensor diff --git a/src/common/m_xi_tensor_calc.fpp b/src/common/m_xi_tensor_calc.fpp index 8fa6eb9cd7..4e977d32bd 100644 --- a/src/common/m_xi_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.fpp @@ -22,7 +22,7 @@ module m_xi_tensor_calc subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(num_dims**2+1), intent(OUT) :: tensora, tensorb + real(kind(0d0)), dimension(num_dims**2+1), intent(INOUT) :: tensora, tensorb integer, intent(IN) :: j, k, l real(kind(0d0)) :: determinant @@ -200,6 +200,9 @@ module m_xi_tensor_calc end if ! 3D + + print *, 'I got half way !' + if (num_dims > 2) then ! using results from upper if statement to map form 2x2 to 3x3 tensor tensora(5) = tensora(4) @@ -416,7 +419,7 @@ module m_xi_tensor_calc ! print *, "i :: ",i,", tensora :: ",tensora(i) ! end do !end if - + print *, 'I got to before the inverse' ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse if (num_dims == 1) then tensorb(1) = 1 @@ -448,15 +451,16 @@ module m_xi_tensor_calc + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) end if ! error checking - if (determinant == 0) then - print *, 'determinant :: ', determinant - print *, 'ERROR: Determinant was zero' - stop - end if + !if (determinant == 0) then + ! print *, 'determinant :: ', determinant + ! print *, 'ERROR: Determinant was zero' + ! stop + !end if ! STEP 2c: computing the inverse of grad_xi tensor = F ! tensorb is the adjoint, tensora becomes the inverse tensora(:) = tensorb(:)/determinant + print *, 'I got to F tranpose F' ! STEP 3: computing F tranpose F tensorb(1) = tensora(1)**2 diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index c6cef8e5f3..fb9e1b2347 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -146,7 +146,7 @@ module m_global_parameters !$acc declare create(num_dims, weno_polyn, weno_order, num_fluids) #:endif - !$acc declare create(mpp_lim, model_eqns, mixture_err, alt_soundspeed, avg_state, mapped_weno, mp_weno, weno_eps, hypoelasticity) + !$acc declare create(mpp_lim, model_eqns, mixture_err, alt_soundspeed, avg_state, mapped_weno, mp_weno, weno_eps,hypoelasticity,hyperelasticity) logical :: relax !< activate phase change integer :: relax_model !< Relaxation model diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 6cac2b43a9..43ea1b4dc9 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -699,6 +699,11 @@ contains end do end do + print *, 'A qconsvf :: ',q_cons_vf(xibeg)%sf(1,1,1) + print *, 'B qconsvf :: ',q_cons_vf(xibeg)%sf(10,10,10) + print *, 'C qconsvf :: ',q_cons_vf(xibeg)%sf(20,20,20) + print *, 'D qconsvf :: ',q_cons_vf(xibeg)%sf(30,30,30) + ! ================================================================== ! Converting Conservative to Primitive Variables ================== diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 08918fffc3..de02976cd2 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -473,7 +473,7 @@ contains H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R - if (hypoelasticity) then + if (hypoelasticity .or. hyperelasticity) then !$acc loop seq do i = 1, strxe - strxb + 1 tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) @@ -526,7 +526,7 @@ contains end if if (wave_speeds == 1) then - if (hypoelasticity) then + if (hypoelasticity .or. hyperelasticity) then s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & (((4d0*G_L)/3d0) + & tau_e_L(dir_idx_tau(1)))/rho_L) & @@ -607,7 +607,7 @@ contains - rho_R*vel_R(dir_idx(i)))) & /(s_M - s_P) end do - else if (hypoelasticity) then + else if (hypoelasticity .or. hyperelasticity) then !$acc loop seq do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & @@ -646,7 +646,7 @@ contains - s_P*vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) & + s_M*s_P*(E_L - E_R)) & /(s_M - s_P) - else if (hypoelasticity) then + else if (hypoelasticity .or. hyperelasticity) then !TODO: simplify this so it's not split into 3 if (num_dims == 1) then flux_rs${XYZ}$_vf(j, k, l, E_idx) = & @@ -2485,7 +2485,7 @@ contains !$acc update device(is1, is2, is3) - if (hypoelasticity) then + if (hypoelasticity .or. hyperelasticity) then if (norm_dir == 1) then dir_idx_tau = (/1, 2, 4/) else if (norm_dir == 2) then diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index dd04223cce..81c48cff4e 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -576,7 +576,7 @@ contains ! Read the data for each variable if ( bubbles .or. hypoelasticity .or. hyperelasticity ) then - print *, 'I was here AA' + do i = 1, sys_size!adv_idx%end var_MOK = int(i, MPI_OFFSET_KIND) @@ -601,7 +601,6 @@ contains end do end if - print *, 'i :: ',xibeg,', data :: ',MPI_IO_DATA%var(xibeg)%sf(1,1,1) call s_mpi_barrier() From 6eb5ecaaff2c406f25451019e9c9faf9ecfbc582 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 23 May 2024 12:38:51 -0500 Subject: [PATCH 112/380] still testing simulation, compiles not sure if it runs --- src/common/m_variables_conversion.fpp | 52 +++++++++++++++++--------- src/common/m_xi_tensor_calc.fpp | 17 +++++---- src/simulation/m_global_parameters.fpp | 8 ++-- 3 files changed, 49 insertions(+), 28 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 4b4df30cb6..5cdec145c2 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -911,15 +911,6 @@ contains end if #:endif - ! going through hyperelasticity again due to the btensor calculation - ! s_calculate_btensor has its own triple nested for loop with openacc - print *, 'I got here A1' - - if (hyperelasticity) then - call s_calculate_btensor(qK_prim_vf, qK_btensor_vf) - end if - - print *, 'I got here A2' !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) do l = izb, ize @@ -1048,8 +1039,6 @@ contains do i = xibeg, xiend qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) / rho_K end do - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K end if !$acc loop seq @@ -1062,6 +1051,33 @@ contains end do !$acc end parallel loop + ! going through hyperelasticity again due to the btensor calculation + ! s_calculate_btensor has its own triple nested for loop with openacc + print *, 'I got here A1' + if (hyperelasticity) then + call s_calculate_btensor(qK_prim_vf, qK_btensor_vf) + !$acc parallel loop collapse(3) gang vector default(present) private(gamma_K, G_K) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe +#ifdef MFC_SIMULATION + ! If in simulation, use acc mixture subroutines + call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & + alpha_rho_K, Re_K, j, k, l, G_K, Gs) +#else + ! If pre-processing, use non acc mixture subroutines + call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & + rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) +#endif + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K + end do + end do + end do + !$acc end parallel loop + end if + print *, 'I got here A2' + end subroutine s_convert_conservative_to_primitive_variables ! --------- !> The following procedure handles the conversion between @@ -1389,10 +1405,9 @@ contains type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf type(scalar_field), dimension(b_size), intent(OUT) :: btensor - real(kind(0d0)), dimension(num_dims**2+1) :: tensora, tensorb + real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb integer :: j, k, l - print *, 'I got here in btensor calc' !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) do l = izb, ize @@ -1402,9 +1417,9 @@ contains ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor ! btensor is symmetric, save the data space - print *, 'I got here in triple do loop ' + !print *, 'I got here in triple do loop ' call s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) - print *, 'I got out of gradient_xi' + !print *, 'I got out of gradient_xi' ! 1: 1D, 3: 2D, 6: 3D btensor(1)%sf(j, k, l) = tensorb(1) if (num_dims > 1) then ! 2D @@ -1418,13 +1433,16 @@ contains btensor(6)%sf(j,k,l) = tensorb(9) end if ! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j,k,l) = tensorb(num_dims**2+1) + btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) end do end do + if(l == ize) print *, 'I got to the end of triple do loop of tensorb calc' end do !$acc end parallel loop - print *, 'I got to the end of triple do loop of tensorb calc' + print *, 'I got to finish the parallel loop' + print *, 'STOPPING THE CODE' + stop end subroutine s_calculate_btensor subroutine s_finalize_variables_conversion_module() ! ------------------ diff --git a/src/common/m_xi_tensor_calc.fpp b/src/common/m_xi_tensor_calc.fpp index 4e977d32bd..31c4fc223a 100644 --- a/src/common/m_xi_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.fpp @@ -22,7 +22,7 @@ module m_xi_tensor_calc subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(num_dims**2+1), intent(INOUT) :: tensora, tensorb + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora, tensorb integer, intent(IN) :: j, k, l real(kind(0d0)) :: determinant @@ -199,10 +199,8 @@ module m_xi_tensor_calc end if end if - ! 3D - - print *, 'I got half way !' + ! 3D if (num_dims > 2) then ! using results from upper if statement to map form 2x2 to 3x3 tensor tensora(5) = tensora(4) @@ -419,7 +417,7 @@ module m_xi_tensor_calc ! print *, "i :: ",i,", tensora :: ",tensora(i) ! end do !end if - print *, 'I got to before the inverse' + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse if (num_dims == 1) then tensorb(1) = 1 @@ -459,8 +457,9 @@ module m_xi_tensor_calc ! STEP 2c: computing the inverse of grad_xi tensor = F ! tensorb is the adjoint, tensora becomes the inverse - tensora(:) = tensorb(:)/determinant - print *, 'I got to F tranpose F' + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/determinant + end do ! STEP 3: computing F tranpose F tensorb(1) = tensora(1)**2 @@ -481,7 +480,9 @@ module m_xi_tensor_calc tensorb(8) = tensorb(4) end if ! STEP 4: store the determinant of F in the last entry of the tensor - tensorb(num_dims**2+1) = determinant + tensorb(tensor_size) = determinant + + !print *, 'succeeded, j :: ',j,', k :: ',k,', l :: ',l end subroutine s_compute_gradient_xi diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index fb9e1b2347..0780989e38 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -202,7 +202,8 @@ module m_global_parameters integer :: gamma_idx !< Index of specific heat ratio func. eqn. integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. type(int_bounds_info) :: stress_idx !< Indexes of first and last shear stress eqns. - integer :: b_size !< Number of elements in the symmetric b tensor + integer :: b_size !< Number of elements in the symmetric b tensor, plus one + integer :: tensor_size !< Number of elements in the full tensor plus one !> @} !$acc declare create(bub_idx) @@ -255,7 +256,7 @@ module m_global_parameters integer :: startx, starty, startz - !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx, b_size) + !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx, b_size, tensor_size) ! END: Simulation Algorithm Parameters ===================================== @@ -795,6 +796,7 @@ contains sys_size = stress_idx%end + num_dims ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 + tensor_size = num_dims**2 + 1 end if else if (model_eqns == 3) then @@ -996,7 +998,7 @@ contains xibeg = stress_idx%end+1 xiend = stress_idx%end+num_dims - !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe, b_size, xibeg, xiend) + !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe, b_size, xibeg, xiend, tensor_size) !$acc update device(m, n, p) !$acc update device(alt_soundspeed, monopole, num_mono) From c3460528e8a111a49b9e769495038ad68932faf3 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 23 May 2024 13:07:48 -0500 Subject: [PATCH 113/380] updating tensor_size on pre and post process, still debugging simulation --- src/common/m_variables_conversion.fpp | 9 ++++++--- src/post_process/m_global_parameters.fpp | 2 ++ src/pre_process/m_global_parameters.fpp | 2 ++ 3 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 5cdec145c2..ba08b9f675 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1408,11 +1408,14 @@ contains real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb integer :: j, k, l + !do l = izb, ize + ! do k = iyb, iye + ! do j = ixb, ixe !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe + do l = 0, p + do k = 0, n + do j = 0, m ! calculate the grad_xi, grad_xi is a nxn tensor ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 9d43856d66..22a63c647c 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -95,6 +95,7 @@ module m_global_parameters logical :: hypoelasticity !< Turn hypoelasticity on logical :: hyperelasticity !< Turn hyperelasticity on integer :: b_size !< Number of components in the b tensor + integer :: tensor_size !< Number of components in the nonsymmetric tensor !> @} !> @name Annotations of the structure, i.e. the organization, of the state vectors @@ -494,6 +495,7 @@ contains sys_size = stress_idx%end + num_dims ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 + tensor_size = num_dims**2 + 1 end if ! ================================================================== diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index f9e47286a2..15ba45a4ec 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -86,6 +86,7 @@ module m_global_parameters logical :: hypoelasticity !< activate hypoelasticity logical :: hyperelasticity !< activate hyperelasticity integer :: b_size !< Number of components in the b tensor + integer :: tensor_size !< Number of components in the nonsymmetric tensor logical :: pre_stress !< activate pre_stressed domain ! Annotations of the structure, i.e. the organization, of the state vectors @@ -601,6 +602,7 @@ contains sys_size = stress_idx%end + num_dims ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 + tensor_size = num_dims**2 + 1 end if ! ================================================================== From f11ffa975ada1ef34a7881a66c3ad485a89ea5bb Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 23 May 2024 17:03:57 -0500 Subject: [PATCH 114/380] pre_process and simulation compiles --- src/common/m_variables_conversion.fpp | 105 +++++++++++++++++++------- src/common/m_xi_tensor_calc.fpp | 12 ++- 2 files changed, 84 insertions(+), 33 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index ba08b9f675..a29152d339 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1055,26 +1055,36 @@ contains ! s_calculate_btensor has its own triple nested for loop with openacc print *, 'I got here A1' if (hyperelasticity) then - call s_calculate_btensor(qK_prim_vf, qK_btensor_vf) - !$acc parallel loop collapse(3) gang vector default(present) private(gamma_K, G_K) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe #ifdef MFC_SIMULATION - ! If in simulation, use acc mixture subroutines - call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & - alpha_rho_K, Re_K, j, k, l, G_K, Gs) + call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf) + !$acc parallel loop collapse(3) gang vector default(present) private(gamma_K, G_K) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe + ! If in simulation, use acc mixture subroutines + call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & + alpha_rho_K, Re_K, j, k, l, G_K, Gs) + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K + end do + end do + end do + !$acc end parallel loop + print *, 'I got here A2' #else - ! If pre-processing, use non acc mixture subroutines - call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & - rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) -#endif - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K - end do - end do + call s_calculate_btensor(qK_prim_vf, qK_btensor_vf) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe + ! If pre-processing, use non acc mixture subroutines + call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & + rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K + end do end do - !$acc end parallel loop + end do +#endif end if print *, 'I got here A2' @@ -1397,16 +1407,65 @@ contains end subroutine s_convert_primitive_to_flux_variables ! ----------------- + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_calculate_btensor(q_prim_vf, btensor) + + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(OUT) :: btensor + real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb + + integer :: j, k, l + !do l = izb, ize + ! do k = iyb, iye + ! do j = ixb, ixe + do l = 0, p + do k = 0, n + do j = 0, m + call s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) + ! 1: 1D, 3: 2D, 6: 3D + btensor(1)%sf(j, k, l) = tensorb(1) + if (num_dims > 1) then ! 2D + btensor(2)%sf(j,k,l) = tensorb(2) + btensor(3)%sf(j,k,l) = tensorb(4) + end if + if (num_dims > 2) then ! 3D + btensor(3)%sf(j,k,l) = tensorb(3) + btensor(4)%sf(j,k,l) = tensorb(5) + btensor(5)%sf(j,k,l) = tensorb(6) + btensor(6)%sf(j,k,l) = tensorb(9) + end if + ! store the determinant at the last entry of the btensor sf + btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) + end do + end do + !if(l == ize) print *, 'I got to the end of triple do loop of tensorb calc' + end do + + print *, 'I got to finish the parallel loop' + print *, 'STOPPING THE CODE' + !stop + end subroutine s_calculate_btensor + !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. !! @param q_prim_vf Primitive variables !! @param btensor is the output - subroutine s_calculate_btensor(q_prim_vf, btensor) + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_calculate_btensor_acc(q_prim_vf, btensor) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf type(scalar_field), dimension(b_size), intent(OUT) :: btensor real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb - integer :: j, k, l !do l = izb, ize ! do k = iyb, iye @@ -1416,13 +1475,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - ! calculate the grad_xi, grad_xi is a nxn tensor - ! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - ! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - ! btensor is symmetric, save the data space - !print *, 'I got here in triple do loop ' call s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) - !print *, 'I got out of gradient_xi' ! 1: 1D, 3: 2D, 6: 3D btensor(1)%sf(j, k, l) = tensorb(1) if (num_dims > 1) then ! 2D @@ -1446,7 +1499,7 @@ contains print *, 'I got to finish the parallel loop' print *, 'STOPPING THE CODE' stop - end subroutine s_calculate_btensor + end subroutine s_calculate_btensor_acc subroutine s_finalize_variables_conversion_module() ! ------------------ diff --git a/src/common/m_xi_tensor_calc.fpp b/src/common/m_xi_tensor_calc.fpp index 31c4fc223a..4449cf2093 100644 --- a/src/common/m_xi_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.fpp @@ -449,11 +449,11 @@ module m_xi_tensor_calc + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) end if ! error checking - !if (determinant == 0) then - ! print *, 'determinant :: ', determinant - ! print *, 'ERROR: Determinant was zero' - ! stop - !end if + if (determinant == 0) then + print *, 'determinant :: ', determinant + print *, 'ERROR: Determinant was zero' + stop + end if ! STEP 2c: computing the inverse of grad_xi tensor = F ! tensorb is the adjoint, tensora becomes the inverse @@ -482,8 +482,6 @@ module m_xi_tensor_calc ! STEP 4: store the determinant of F in the last entry of the tensor tensorb(tensor_size) = determinant - !print *, 'succeeded, j :: ',j,', k :: ',k,', l :: ',l - end subroutine s_compute_gradient_xi ! neo-Hookean only at this time, will need to be changed later From 2e0fadb78091b70fae2d0583ed3dba3840a66a1a Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Thu, 23 May 2024 17:34:56 -0500 Subject: [PATCH 115/380] added checker in preprocess for hyperelasticity and HLL --- src/pre_process/m_checker.f90 | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/pre_process/m_checker.f90 b/src/pre_process/m_checker.f90 index e427660353..4adffce951 100644 --- a/src/pre_process/m_checker.f90 +++ b/src/pre_process/m_checker.f90 @@ -106,11 +106,16 @@ subroutine s_check_inputs() end if if (hyperelasticity .and. (model_eqns /= 2)) then - call s_mpi_abort('hyperelasticity requires model_eqns =2'// & + call s_mpi_abort('hyperelasticity requires model_eqns = 2'// & 'exiting ...') end if - if (pre_stress .and. .not. hyperelasticity) then + if (hyperelasticity .and. (riemann_solver /= 1)) then + call s_mpi_abort('hyperelasticity requires riemann_solver = 1 (HLL only)'// & + 'exiting ...') + end if + + if (pre_stress .and. .not. hyperelasticity) then call s_mpi_abort('pre_stress requires hyperelasticity'// & 'exiting ...') end if From 0f6ba8ec09d4e21167fbfb803c5b8b6093f5dc9d Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 23 May 2024 18:40:08 -0500 Subject: [PATCH 116/380] found the issue with the indexing in the fdiff scheme in grad_xi calculation --- src/common/m_variables_conversion.fpp | 18 +++--------------- 1 file changed, 3 insertions(+), 15 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index a29152d339..10de113b7c 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1422,9 +1422,6 @@ contains real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb integer :: j, k, l - !do l = izb, ize - ! do k = iyb, iye - ! do j = ixb, ixe do l = 0, p do k = 0, n do j = 0, m @@ -1445,12 +1442,7 @@ contains btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) end do end do - !if(l == ize) print *, 'I got to the end of triple do loop of tensorb calc' end do - - print *, 'I got to finish the parallel loop' - print *, 'STOPPING THE CODE' - !stop end subroutine s_calculate_btensor !> The following subroutine handles the calculation of the btensor. @@ -1467,10 +1459,6 @@ contains type(scalar_field), dimension(b_size), intent(OUT) :: btensor real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb integer :: j, k, l - !do l = izb, ize - ! do k = iyb, iye - ! do j = ixb, ixe - !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) do l = 0, p do k = 0, n @@ -1492,13 +1480,13 @@ contains btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) end do end do - if(l == ize) print *, 'I got to the end of triple do loop of tensorb calc' + !if(l == ize) print *, 'I got to the end of triple do loop of tensorb calc' end do !$acc end parallel loop print *, 'I got to finish the parallel loop' - print *, 'STOPPING THE CODE' - stop + !print *, 'STOPPING THE CODE' + !stop end subroutine s_calculate_btensor_acc subroutine s_finalize_variables_conversion_module() ! ------------------ From c2844351d2285310f9cd35399f1a6885da797b88 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 23 May 2024 18:49:40 -0500 Subject: [PATCH 117/380] additional incremental fixes to the private variables in m_variable conversion for simulation, debugger flags helped catch the issue --- src/common/m_variables_conversion.fpp | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 10de113b7c..990286008e 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1057,10 +1057,15 @@ contains if (hyperelasticity) then #ifdef MFC_SIMULATION call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf) - !$acc parallel loop collapse(3) gang vector default(present) private(gamma_K, G_K) + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) do l = izb, ize do k = iyb, iye do j = ixb, ixe + !$acc loop seq + do i = 1, num_fluids + alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) + alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) + end do ! If in simulation, use acc mixture subroutines call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & alpha_rho_K, Re_K, j, k, l, G_K, Gs) @@ -1070,12 +1075,15 @@ contains end do end do !$acc end parallel loop - print *, 'I got here A2' #else - call s_calculate_btensor(qK_prim_vf, qK_btensor_vf) + call s_calculate_btensor(qK_prim_vf, qK_btensor_vf) do l = izb, ize do k = iyb, iye do j = ixb, ixe + do i = 1, num_fluids + alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) + alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) + end do ! If pre-processing, use non acc mixture subroutines call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) @@ -1133,11 +1141,9 @@ contains ! going through hyperelasticity again due to the btensor calculation ! s_calculate_btensor has its own triple nested for loop, with openacc - print *, 'I got here B1' if (hyperelasticity ) then call s_calculate_btensor(q_prim_vf, q_btensor) end if - print *, 'I got here B2' ! Converting the primitive variables to the conservative variables do l = 0, p @@ -1459,6 +1465,7 @@ contains type(scalar_field), dimension(b_size), intent(OUT) :: btensor real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb integer :: j, k, l + !TODO FIX THE TRIPLE LOOPING INDEX HERE! !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) do l = 0, p do k = 0, n @@ -1480,13 +1487,9 @@ contains btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) end do end do - !if(l == ize) print *, 'I got to the end of triple do loop of tensorb calc' end do !$acc end parallel loop - print *, 'I got to finish the parallel loop' - !print *, 'STOPPING THE CODE' - !stop end subroutine s_calculate_btensor_acc subroutine s_finalize_variables_conversion_module() ! ------------------ From 84533fbe07034f749e6c30cb660821566c9cf10d Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 23 May 2024 21:08:34 -0500 Subject: [PATCH 118/380] debugged the checker issue that was created earlier, works correctly now --- src/common/m_variables_conversion.fpp | 5 +++-- src/pre_process/m_checker.f90 | 5 ----- src/simulation/m_checker.fpp | 4 ++-- 3 files changed, 5 insertions(+), 9 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 990286008e..4093b1bb1b 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1051,11 +1051,12 @@ contains end do !$acc end parallel loop - ! going through hyperelasticity again due to the btensor calculation + ! going through hyperelasticity to calculate btensor ! s_calculate_btensor has its own triple nested for loop with openacc - print *, 'I got here A1' if (hyperelasticity) then #ifdef MFC_SIMULATION + print *, 'I got here A1' + call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf) !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) do l = izb, ize diff --git a/src/pre_process/m_checker.f90 b/src/pre_process/m_checker.f90 index 4adffce951..a92a6c2103 100644 --- a/src/pre_process/m_checker.f90 +++ b/src/pre_process/m_checker.f90 @@ -110,11 +110,6 @@ subroutine s_check_inputs() 'exiting ...') end if - if (hyperelasticity .and. (riemann_solver /= 1)) then - call s_mpi_abort('hyperelasticity requires riemann_solver = 1 (HLL only)'// & - 'exiting ...') - end if - if (pre_stress .and. .not. hyperelasticity) then call s_mpi_abort('pre_stress requires hyperelasticity'// & 'exiting ...') diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index 2682048895..a54d56b5a2 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -290,8 +290,8 @@ contains elseif (riemann_solver /= 2 .and. alt_soundspeed) then call s_mpi_abort('Unsupported combination of riemann_solver '// & 'and alt_soundspeed. Exiting ...') - elseif (hypoelasticity .and. (riemann_solver /= 1)) then - call s_mpi_abort('hypoelasticity requires riemann_solver = 1'// & + elseif ((hypoelasticity .or. hyperelasticity) .and. (riemann_solver /= 1)) then + call s_mpi_abort('hypoelasticity and hyperelasticity requires riemann_solver = 1'// & 'Exiting ...') end if From 47205139790a2f2f8d237f31e474964ed611f58f Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 23 May 2024 22:22:27 -0500 Subject: [PATCH 119/380] large update, grad_xi acc update to prevent seg faults when doing fdifferences, compiles, not yet tested --- src/common/m_variables_conversion.fpp | 9 +- src/common/m_xi_tensor_calc.fpp | 472 +++++++++++++++++++++++++- src/simulation/m_rhs.fpp | 2 +- 3 files changed, 470 insertions(+), 13 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 4093b1bb1b..318b3d5371 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1468,10 +1468,11 @@ contains integer :: j, k, l !TODO FIX THE TRIPLE LOOPING INDEX HERE! !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) - do l = 0, p - do k = 0, n - do j = 0, m - call s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe + call s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, & + iye, izb, ize, j, k, l, tensora, tensorb) ! 1: 1D, 3: 2D, 6: 3D btensor(1)%sf(j, k, l) = tensorb(1) if (num_dims > 1) then ! 2D diff --git a/src/common/m_xi_tensor_calc.fpp b/src/common/m_xi_tensor_calc.fpp index 4449cf2093..eae06d21e9 100644 --- a/src/common/m_xi_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.fpp @@ -15,12 +15,11 @@ module m_xi_tensor_calc implicit none - private; public :: s_compute_gradient_xi, f_elastic_energy + private; public :: s_compute_gradient_xi, s_compute_gradient_xi_acc, f_elastic_energy contains subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) - !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora, tensorb integer, intent(IN) :: j, k, l @@ -412,12 +411,6 @@ module m_xi_tensor_calc end if end if - !if(proc_rank == 0) then - ! do i = 1, num_dims**2 - ! print *, "i :: ",i,", tensora :: ",tensora(i) - ! end do - !end if - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse if (num_dims == 1) then tensorb(1) = 1 @@ -484,6 +477,469 @@ module m_xi_tensor_calc end subroutine s_compute_gradient_xi + subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- + izb, ize, j, k, l, tensora, tensorb) + !$acc routine seq + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora, tensorb + integer, intent(IN) :: ixb, ixe, iyb, iye, izb, ize + integer, intent(IN) :: j, k, l + + real(kind(0d0)) :: determinant + integer :: i + + ! STEP 1: computing the grad_xi tensor + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz + if(j == ixb) then + ! dxix/dx + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l) ) & + /(12d0*(x_cb(j+1) - x_cb(j))) + else if (j == ixb + 1) then + ! dxix/dx + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + q_prim_vf(xibeg)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe - 1) then + ! dxix/dx + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - q_prim_vf(xibeg)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe) then + ! dxix/dx + tensora(1) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l) ) & + /(12d0*(x_cb(j) - x_cb(j-1))) + else + ! dxix/dx + tensora(1) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + if (num_dims > 1) then + if(j == ixb) then + ! dxiy / dx + tensora(2) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg+1)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg+1)%sf(j + 4, k, l) ) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + else if (j == ixb + 1) then + ! dxiy / dx + tensora(2) = (-3d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & + + q_prim_vf(xibeg+1)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe - 1) then + ! dxiy / dx + tensora(2) = (3d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + - q_prim_vf(xibeg+1)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe) then + ! dxiy / dx + tensora(2) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg+1)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg+1)%sf(j - 4, k, l) ) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxiy / dx + tensora(2) = ( q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg+1)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + if(k == iyb) then + ! dxix / dy + tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l) ) & + /(12d0*(y_cb(k+1) - y_cb(k))) + else if (k == iyb + 1) then + ! dxix / dy + tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + q_prim_vf(xibeg)%sf(j, k + 3, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + else if (k == iye - 1) then + ! dxix / dy + tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - q_prim_vf(xibeg)%sf(j, k - 3, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + else if (k == iye) then + ! dxix / dy + tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l) ) & + /(12d0*(y_cb(j) - y_cb(j-1))) + else + ! dxix / dy + tensora(3) = ( q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + end if + + if(k == iyb) then + ! dxiy / dy + tensora(4) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg+1)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg+1)%sf(j, k + 4, l) ) & + /(12d0*(y_cb(k+1) - y_cb(k))) + else if (k == iyb + 1) then + ! dxiy / dy + tensora(4) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & + + q_prim_vf(xibeg+1)%sf(j, k + 3, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + else if (k == iye - 1) then + ! dxiy / dy + tensora(4) = (3d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + - q_prim_vf(xibeg+1)%sf(j, k - 3, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + else if (k == iye) then + ! dxiy / dy + tensora(4) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg+1)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg+1)%sf(j, k - 4, l) ) & + /(12d0*(y_cb(j) - y_cb(j-1))) + else + ! dxiy / dy + tensora(4) = ( q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg+1)%sf(j, k + 2, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + end if + + end if + + ! 3D + if (num_dims > 2) then + ! using results from upper if statement to map form 2x2 to 3x3 tensor + tensora(5) = tensora(4) + tensora(4) = tensora(3) + + if(l == izb) then + ! dxix / dz + tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + - 36d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & + + 16d0*q_prim_vf(xibeg)%sf(j, k , l + 3) & + - 3d0*q_prim_vf(xibeg)%sf(j, k , l + 4) ) & + /(12d0*(z_cb(k+1) - z_cb(k))) + else if (l == izb + 1) then + ! dxix / dz + tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + - 6d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & + + q_prim_vf(xibeg)%sf(j, k , l + 3)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + else if (l == ize - 1) then + ! dxix / dz + tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & + - q_prim_vf(xibeg)%sf(j, k , l - 3)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + else if (l == ize) then + ! dxix / dz + tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(j) - z_cb(j-1))) + else + ! dxix / dz + tensora(3) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + - q_prim_vf(xibeg)%sf(j, k , l + 2)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + end if + + if(l == izb) then + ! dxiy / dz + tensora(6) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + - 36d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & + + 16d0*q_prim_vf(xibeg+1)%sf(j, k , l + 3) & + - 3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 4) ) & + /(12d0*(z_cb(k+1) - z_cb(k))) + else if (l == izb + 1) then + ! dxiy / dz + tensora(6) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + - 6d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & + + q_prim_vf(xibeg+1)%sf(j, k , l + 3)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + else if (l == ize - 1) then + ! dxiy / dz + tensora(6) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - q_prim_vf(xibeg+1)%sf(j, k , l - 3)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + else if (l == ize) then + ! dxiy / dz + tensora(6) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(j) - z_cb(j-1))) + else + ! dxiy / dz + tensora(6) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + end if + + if(j == ixb) then + ! dxiz / dx + tensora(7) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l) ) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + else if (j == ixb + 1) then + ! dxiz / dx + tensora(7) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + q_prim_vf(xiend)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe - 1) then + ! dxiz / dx + tensora(7) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xiend)%sf(j,k,l) & + - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - q_prim_vf(xiend)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe) then + ! dxiz / dx + tensora(7) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l) ) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxiz / dx + tensora(7) = ( q_prim_vf(xiend)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - q_prim_vf(xiend)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + if(k == iyb) then + ! dxiz / dy + tensora(8) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l) ) & + /(12d0*(y_cb(k+1) - y_cb(k))) + else if (k == iyb + 1) then + ! dxiz / dy + tensora(8) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + q_prim_vf(xiend)%sf(j, k + 3, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + else if (k == iye - 1) then + ! dxiz / dy + tensora(8) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xiend)%sf(j,k,l) & + - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - q_prim_vf(xiend)%sf(j, k - 3, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + else if (k == iye) then + ! dxiz / dy + tensora(8) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l) ) & + /(12d0*(y_cb(j) - y_cb(j-1))) + else + ! dxiz / dy + tensora(8) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - q_prim_vf(xiend)%sf(j, k + 2, l)) & + /(12d0*(y_cb(j) - y_cb(j - 1))) + end if + + if(l == izb) then + ! dxiz / dz + tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + - 36d0*q_prim_vf(xiend)%sf(j, k , l + 2) & + + 16d0*q_prim_vf(xiend)%sf(j, k , l + 3) & + - 3d0*q_prim_vf(xiend)%sf(j, k , l + 4) ) & + /(12d0*(z_cb(k+1) - z_cb(k))) + else if (l == izb + 1) then + ! dxiz / dz + tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + + 18d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + - 6d0*q_prim_vf(xiend)%sf(j, k , l + 2) & + + q_prim_vf(xiend)%sf(j, k , l + 3)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + else if (l == ize - 1) then + ! dxiz / dz + tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xiend)%sf(j,k,l) & + - 18d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & + - q_prim_vf(xiend)%sf(j, k , l - 3)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + else if (l == ize) then + ! dxiz / dz + tensora(9) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xiend)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xiend)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xiend)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(j) - z_cb(j-1))) + else + ! dxiz / dz + tensora(9) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + - q_prim_vf(xiend)%sf(j, k , l + 2)) & + /(12d0*(z_cb(j) - z_cb(j - 1))) + end if + end if + + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + if (num_dims == 1) then + tensorb(1) = 1 + elseif (num_dims == 2) then + tensorb(1) = tensora(4) + tensorb(2) = -tensora(3) + tensorb(3) = -tensora(2) + tensorb(4) = tensora(1) + elseif (num_dims == 3) then + tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) + tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) + tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) + tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) + tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) + tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) + tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) + tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) + tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) + end if + + ! STEP 2b: computing the determinant of the grad_xi tensor + if (num_dims == 1) then + determinant = tensora(1) + elseif (num_dims == 2) then + determinant = tensora(1)*tensora(4) - tensora(2)*tensora(3) + else + determinant = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + end if + ! error checking + !if (determinant == 0) then + ! print *, 'determinant :: ', determinant + ! print *, 'ERROR: Determinant was zero' + !stop + !end if + + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse + + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/determinant + end do + + ! STEP 3: computing F tranpose F + tensorb(1) = tensora(1)**2 + if (num_dims == 2) then + tensorb(1) = tensorb(1) + tensora(3)**2 + tensorb(2) = tensora(1)*tensora(2) + tensora(3)*tensora(4) + tensorb(3) = tensorb(2) + tensorb(4) = tensora(2)**2 + tensora(4)**2 + elseif (num_dims == 3) then + tensorb(1) = tensorb(1) + tensora(4)**2 + tensora(7)**2 + tensorb(5) = tensora(2) + tensora(5)**2 + tensora(8)**2 + tensorb(9) = tensora(3) + tensora(6)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(2) + tensora(4)*tensora(5) + tensora(7)*tensora(8) + tensorb(3) = tensora(1)*tensora(3) + tensora(4)*tensora(6) + tensora(7)*tensora(9) + tensorb(6) = tensora(2)*tensora(3) + tensora(5)*tensora(6) + tensora(8)*tensora(9) + tensorb(4) = tensorb(2) + tensorb(7) = tensorb(3) + tensorb(8) = tensorb(4) + end if + ! STEP 4: store the determinant of F in the last entry of the tensor + tensorb(tensor_size) = determinant + + end subroutine s_compute_gradient_xi_acc + ! neo-Hookean only at this time, will need to be changed later function f_elastic_energy(btensor, j, k, l) !$acc routine seq diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 43ea1b4dc9..4f17cde06d 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -745,8 +745,8 @@ contains call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf) end if call nvtxEndRange - print *, 'I got here 3 !' + STOP call nvtxStartRange("RHS-MPI") call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) From 07e8671d065c6c0fd29f644e8b67453e6f9bd06f Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 23 May 2024 23:43:04 -0500 Subject: [PATCH 120/380] implemented most of riemann solver, missing internal energy, for hyperelasticity, compiles, not yet tested --- src/common/m_variables_conversion.fpp | 4 +-- src/common/m_xi_tensor_calc.fpp | 37 ++++++++++++++------ src/simulation/m_hyperelastic.f90 | 27 +++++++++------ src/simulation/m_rhs.fpp | 9 ++--- src/simulation/m_riemann_solvers.fpp | 49 ++++++++++++++++++++++++++- 5 files changed, 95 insertions(+), 31 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 318b3d5371..be50879f91 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1466,7 +1466,7 @@ contains type(scalar_field), dimension(b_size), intent(OUT) :: btensor real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb integer :: j, k, l - !TODO FIX THE TRIPLE LOOPING INDEX HERE! + !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) do l = izb, ize do k = iyb, iye @@ -1491,7 +1491,7 @@ contains end do end do !$acc end parallel loop - print *, 'I got to finish the parallel loop' + end subroutine s_calculate_btensor_acc subroutine s_finalize_variables_conversion_module() ! ------------------ diff --git a/src/common/m_xi_tensor_calc.fpp b/src/common/m_xi_tensor_calc.fpp index eae06d21e9..61dd58ba37 100644 --- a/src/common/m_xi_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.fpp @@ -19,6 +19,14 @@ module m_xi_tensor_calc contains + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora, tensorb @@ -26,7 +34,6 @@ module m_xi_tensor_calc real(kind(0d0)) :: determinant integer :: i - ! STEP 1: computing the grad_xi tensor ! grad_xi definition / organization ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx @@ -477,6 +484,14 @@ module m_xi_tensor_calc end subroutine s_compute_gradient_xi + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- izb, ize, j, k, l, tensora, tensorb) !$acc routine seq @@ -902,12 +917,6 @@ module m_xi_tensor_calc - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) end if - ! error checking - !if (determinant == 0) then - ! print *, 'determinant :: ', determinant - ! print *, 'ERROR: Determinant was zero' - !stop - !end if ! STEP 2c: computing the inverse of grad_xi tensor = F ! tensorb is the adjoint, tensora becomes the inverse @@ -940,17 +949,25 @@ module m_xi_tensor_calc end subroutine s_compute_gradient_xi_acc - ! neo-Hookean only at this time, will need to be changed later + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + !! neo-Hookean only at this time, will need to be changed later function f_elastic_energy(btensor, j, k, l) +#ifdef MFC_SIMULATION !$acc routine seq +#endif type(scalar_field), dimension(b_size), intent(IN) :: btensor integer, intent(IN) :: j, k, l real(kind(0d0)) :: invariant1, f_elastic_energy f_elastic_energy = 0d0 - invariant1 = btensor(1)%sf(j, k, l) - if (num_dims == 2) then invariant1 = invariant1 + btensor(3)%sf(j, k, l) elseif (num_dims == 3) then diff --git a/src/simulation/m_hyperelastic.f90 b/src/simulation/m_hyperelastic.f90 index 4c7b265fee..45c3b16bd7 100644 --- a/src/simulation/m_hyperelastic.f90 +++ b/src/simulation/m_hyperelastic.f90 @@ -6,11 +6,9 @@ module m_hyperelastic ! Dependencies ============================================================= - use m_derived_types !< Definitions of the derived types use m_global_parameters !< Definitions of the global parameters - ! ========================================================================== implicit none @@ -19,25 +17,34 @@ module m_hyperelastic contains - subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf) + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, ix, iy, iz) + type(scalar_field), dimension(sys_size), intent(INOUT) :: q_prim_vf type(scalar_field), dimension(b_size), intent(IN) :: btensor + type(int_bounds_info), intent(IN) :: ix, iy, iz real(kind(0d0)), dimension(b_size-1) :: tensor real(kind(0d0)) :: trace integer :: i, j, k, l !< Generic loop iterators !$acc parallel loop collapse(3) gang vector default(present) private(trace, tensor) - do l = 0, p - do k = 0, n - do j = 0, m + do l = iz%beg, iz%end + do k = iy%beg, iy%end + do j = ix%beg, ix%end ! tensor is the symmetric tensor !$acc loop seq do i = 1, b_size - 1 tensor(i) = btensor(i)%sf(j, k, l) end do - ! calculate the trace of the tensor trace = tensor(1) if (num_dims == 2) then @@ -54,12 +61,11 @@ subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf) tensor(6) = tensor(6) - (1d0/3d0)*trace end if ! dividing by the jacobian for neo-Hookean model - tensor(:) = tensor(:)/btensor(b_size)%sf(j, k, l) - ! setting the tensor to the stresses for riemann solver + !$acc loop seq do i = 1, b_size - 1 - q_prim_vf(strxb+i)%sf(j, k, l) = tensor(i) + q_prim_vf(strxb+i)%sf(j, k, l) = tensor(i)/btensor(b_size)%sf(j, k, l) end do end do @@ -67,7 +73,6 @@ subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf) end do !$acc end parallel loop - !if (proc_rank == 0) print *, 'J is ::', jacobian, 'this is sigma ::', sigma end subroutine s_calculate_cauchy_from_btensor end module m_hyperelastic diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 4f17cde06d..ff366aa0d8 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -699,11 +699,6 @@ contains end do end do - print *, 'A qconsvf :: ',q_cons_vf(xibeg)%sf(1,1,1) - print *, 'B qconsvf :: ',q_cons_vf(xibeg)%sf(10,10,10) - print *, 'C qconsvf :: ',q_cons_vf(xibeg)%sf(20,20,20) - print *, 'D qconsvf :: ',q_cons_vf(xibeg)%sf(30,30,30) - ! ================================================================== ! Converting Conservative to Primitive Variables ================== @@ -742,11 +737,11 @@ contains call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") if ( hyperelasticity ) then - call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf) + call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) end if call nvtxEndRange + print *, 'I got here 3 !' - STOP call nvtxStartRange("RHS-MPI") call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index de02976cd2..3177997be2 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -311,6 +311,7 @@ contains real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R real(kind(0d0)) :: G_L, G_R real(kind(0d0)), dimension(2) :: Re_L, Re_R + real(kind(0d0)), dimension(3) :: xi_field_L, xi_field_R real(kind(0d0)) :: rho_avg real(kind(0d0)), dimension(num_dims) :: vel_avg @@ -473,7 +474,7 @@ contains H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R - if (hypoelasticity .or. hyperelasticity) then + if (hypoelasticity) then !$acc loop seq do i = 1, strxe - strxb + 1 tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) @@ -504,6 +505,39 @@ contains end do end if + if (hyperelasticity) then + G_L = 0d0 + G_R = 0d0 + !$acc loop seq + do i = 1, num_fluids + G_L = G_L + alpha_L(i)*Gs(i) + G_R = G_R + alpha_R(i)*Gs(i) + end do + + !$acc loop seq + do i = 1, strxe - strxb + 1 + tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + end do + + !$acc loop seq + do i = 1, xiend - xibeg + 1 + xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) + xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) + end do + + !$acc loop seq + do i = 1, strxe - strxb + 1 + ! Elastic contribution to energy if G large enough + ! TODO MRJ ADD THE ELASTIC ENERGY + if ((G_L > 1d0) .and. (G_R > 1d0)) then + E_L = E_L !+ + E_R = E_R !+ + end if + end do + + end if + @:compute_average_state() call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & @@ -714,6 +748,19 @@ contains /(s_M - s_P) end do + ! Xi field + if (hyperelasticity) then + !$acc loop seq + do i = 1, xiend - xibeg + 1 + flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & + (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & + - s_P*rho_L*vel_L(dir_idx(1))*xi_field_L(i) & + + s_M*s_P*(rho_L*xi_field_L(i) & + - rho_R*xi_field_R(i))) & + /(s_M - s_P) + end do + end if + ! Div(U)? !$acc loop seq do i = 1, num_dims From 62537edfefbb0772f6833d27c74348329cdd9fbe Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 25 May 2024 17:24:29 -0500 Subject: [PATCH 121/380] resolved the memory allocate issue with q_prim_vf, debugging the issue with m_xi_grad: 1D and 2D work --- src/common/m_variables_conversion.fpp | 86 ++++++++++++++----------- src/common/m_xi_tensor_calc.fpp | 80 ++++++++++++----------- src/simulation/m_rhs.fpp | 39 ++++++----- src/simulation/m_riemann_solvers.fpp | 93 ++++++++++++++------------- src/simulation/m_time_steppers.fpp | 28 +++++++- 5 files changed, 183 insertions(+), 143 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index be50879f91..e3bc38e175 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -932,7 +932,7 @@ contains if (model_eqns /= 4) then #ifdef MFC_SIMULATION ! If in simulation, use acc mixture subroutines - if (hypoelasticity .or. hyperelasticity) then + if (hypoelasticity) then ! .or. hyperelasticity) then call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & alpha_rho_K, Re_K, j, k, l, G_K, Gs) else if (bubbles) then @@ -944,7 +944,7 @@ contains end if #else ! If pre-processing, use non acc mixture subroutines - if (hypoelasticity .or. hyperelasticity) then + if (hypoelasticity) then !.or. hyperelasticity) then call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) else @@ -1034,12 +1034,12 @@ contains end do end if - if ( hyperelasticity ) then - !$acc loop seq - do i = xibeg, xiend - qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) / rho_K - end do - end if + !if ( hyperelasticity ) then + ! !$acc loop seq + ! do i = xibeg, xiend + ! qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) / rho_K + ! end do + !end if !$acc loop seq do i = advxb, advxe @@ -1053,34 +1053,37 @@ contains ! going through hyperelasticity to calculate btensor ! s_calculate_btensor has its own triple nested for loop with openacc - if (hyperelasticity) then #ifdef MFC_SIMULATION - print *, 'I got here A1' + if (hyperelasticity) then + print *, 'I got here A1' call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf) - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe - !$acc loop seq - do i = 1, num_fluids - alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) - alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) - end do + + !!!$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) + !do l = izb, ize + ! do k = iyb, iye + ! do j = ixb, ixe + ! !$acc loop seq + ! do i = 1, num_fluids + ! alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) + ! alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) + ! end do ! If in simulation, use acc mixture subroutines - call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & - alpha_rho_K, Re_K, j, k, l, G_K, Gs) - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K - end do - end do - end do - !$acc end parallel loop + !call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & + ! alpha_rho_K, Re_K, j, k, l, G_K, Gs) + !qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + ! G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K + ! end do + ! end do + !end do + !!!$acc end parallel loop + end if #else - call s_calculate_btensor(qK_prim_vf, qK_btensor_vf) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe + if (hyperelasticity) then + call s_calculate_btensor(qK_prim_vf, qK_btensor_vf) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe do i = 1, num_fluids alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) @@ -1090,11 +1093,11 @@ contains rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K - end do - end do - end do + end do + end do + end do + end if #endif - end if print *, 'I got here A2' end subroutine s_convert_conservative_to_primitive_variables ! --------- @@ -1425,7 +1428,7 @@ contains subroutine s_calculate_btensor(q_prim_vf, btensor) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(OUT) :: btensor + type(scalar_field), dimension(b_size), intent(INOUT) :: btensor real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb integer :: j, k, l @@ -1473,6 +1476,17 @@ contains do j = ixb, ixe call s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, & iye, izb, ize, j, k, l, tensora, tensorb) + +! if(j == ixb) then +! ! dxix/dx +! tensorb(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & +! + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & +! - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & +! + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & +! - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l) ) & +! /(12d0*(x_cb(j+1) - x_cb(j))) +! end if + ! 1: 1D, 3: 2D, 6: 3D btensor(1)%sf(j, k, l) = tensorb(1) if (num_dims > 1) then ! 2D diff --git a/src/common/m_xi_tensor_calc.fpp b/src/common/m_xi_tensor_calc.fpp index 61dd58ba37..a6048d7513 100644 --- a/src/common/m_xi_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.fpp @@ -500,9 +500,9 @@ module m_xi_tensor_calc integer, intent(IN) :: ixb, ixe, iyb, iye, izb, ize integer, intent(IN) :: j, k, l - real(kind(0d0)) :: determinant + !real(kind(0d0)) :: determinant integer :: i - + ! STEP 1: computing the grad_xi tensor ! grad_xi definition / organization ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx @@ -598,7 +598,7 @@ module m_xi_tensor_calc - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k+1) - y_cb(k))) + /(12d0*(y_cb(k + 1) - y_cb(k))) else if (k == iyb + 1) then ! dxix / dy tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & @@ -606,7 +606,7 @@ module m_xi_tensor_calc + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + q_prim_vf(xibeg)%sf(j, k + 3, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) else if (k == iye - 1) then ! dxix / dy tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & @@ -614,7 +614,7 @@ module m_xi_tensor_calc - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - q_prim_vf(xibeg)%sf(j, k - 3, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) else if (k == iye) then ! dxix / dy tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & @@ -622,14 +622,14 @@ module m_xi_tensor_calc + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(j) - y_cb(j-1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) else ! dxix / dy tensora(3) = ( q_prim_vf(xibeg)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) end if if(k == iyb) then @@ -639,7 +639,7 @@ module m_xi_tensor_calc - 36d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & + 16d0*q_prim_vf(xibeg+1)%sf(j, k + 3, l) & - 3d0*q_prim_vf(xibeg+1)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k+1) - y_cb(k))) + /(12d0*(y_cb(k + 1) - y_cb(k))) else if (k == iyb + 1) then ! dxiy / dy tensora(4) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & @@ -647,7 +647,7 @@ module m_xi_tensor_calc + 18d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - 6d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & + q_prim_vf(xibeg+1)%sf(j, k + 3, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) else if (k == iye - 1) then ! dxiy / dy tensora(4) = (3d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & @@ -655,7 +655,7 @@ module m_xi_tensor_calc - 18d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + 6d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - q_prim_vf(xibeg+1)%sf(j, k - 3, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) else if (k == iye) then ! dxiy / dy tensora(4) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & @@ -663,23 +663,25 @@ module m_xi_tensor_calc + 36d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - 16d0*q_prim_vf(xibeg+1)%sf(j, k - 3, l) & + 3d0*q_prim_vf(xibeg+1)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(j) - y_cb(j-1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) else ! dxiy / dy tensora(4) = ( q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - q_prim_vf(xibeg+1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) end if end if + tensorb(4) = tensora(4) + tensorb(3) = tensora(3) ! 3D if (num_dims > 2) then ! using results from upper if statement to map form 2x2 to 3x3 tensor - tensora(5) = tensora(4) - tensora(4) = tensora(3) + tensora(5) = tensorb(4) + tensora(4) = tensorb(3) if(l == izb) then ! dxix / dz @@ -688,7 +690,7 @@ module m_xi_tensor_calc - 36d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & + 16d0*q_prim_vf(xibeg)%sf(j, k , l + 3) & - 3d0*q_prim_vf(xibeg)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(k+1) - z_cb(k))) + /(12d0*(z_cb(l + 1) - z_cb(l))) else if (l == izb + 1) then ! dxix / dz tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & @@ -696,7 +698,7 @@ module m_xi_tensor_calc + 18d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - 6d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & + q_prim_vf(xibeg)%sf(j, k , l + 3)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) else if (l == ize - 1) then ! dxix / dz tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & @@ -704,7 +706,7 @@ module m_xi_tensor_calc - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - q_prim_vf(xibeg)%sf(j, k , l - 3)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) else if (l == ize) then ! dxix / dz tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & @@ -712,14 +714,14 @@ module m_xi_tensor_calc + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(j) - z_cb(j-1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) else ! dxix / dz tensora(3) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - q_prim_vf(xibeg)%sf(j, k , l + 2)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) end if if(l == izb) then @@ -729,7 +731,7 @@ module m_xi_tensor_calc - 36d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & + 16d0*q_prim_vf(xibeg+1)%sf(j, k , l + 3) & - 3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(k+1) - z_cb(k))) + /(12d0*(z_cb(l + 1) - z_cb(l))) else if (l == izb + 1) then ! dxiy / dz tensora(6) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & @@ -737,7 +739,7 @@ module m_xi_tensor_calc + 18d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - 6d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & + q_prim_vf(xibeg+1)%sf(j, k , l + 3)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) else if (l == ize - 1) then ! dxiy / dz tensora(6) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & @@ -745,7 +747,7 @@ module m_xi_tensor_calc - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - q_prim_vf(xibeg+1)%sf(j, k , l - 3)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) else if (l == ize) then ! dxiy / dz tensora(6) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & @@ -753,14 +755,14 @@ module m_xi_tensor_calc + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & + 3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(j) - z_cb(j-1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) else ! dxiy / dz tensora(6) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) end if if(j == ixb) then @@ -811,7 +813,7 @@ module m_xi_tensor_calc - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k+1) - y_cb(k))) + /(12d0*(y_cb(k + 1) - y_cb(k))) else if (k == iyb + 1) then ! dxiz / dy tensora(8) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & @@ -819,7 +821,7 @@ module m_xi_tensor_calc + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + q_prim_vf(xiend)%sf(j, k + 3, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) else if (k == iye - 1) then ! dxiz / dy tensora(8) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & @@ -827,7 +829,7 @@ module m_xi_tensor_calc - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - q_prim_vf(xiend)%sf(j, k - 3, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) else if (k == iye) then ! dxiz / dy tensora(8) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & @@ -835,14 +837,14 @@ module m_xi_tensor_calc + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(j) - y_cb(j-1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) else ! dxiz / dy tensora(8) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) end if if(l == izb) then @@ -852,7 +854,7 @@ module m_xi_tensor_calc - 36d0*q_prim_vf(xiend)%sf(j, k , l + 2) & + 16d0*q_prim_vf(xiend)%sf(j, k , l + 3) & - 3d0*q_prim_vf(xiend)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(k+1) - z_cb(k))) + /(12d0*(z_cb(l + 1) - z_cb(l))) else if (l == izb + 1) then ! dxiz / dz tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k , l - 1) & @@ -860,7 +862,7 @@ module m_xi_tensor_calc + 18d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - 6d0*q_prim_vf(xiend)%sf(j, k , l + 2) & + q_prim_vf(xiend)%sf(j, k , l + 3)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) else if (l == ize - 1) then ! dxiz / dz tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & @@ -868,7 +870,7 @@ module m_xi_tensor_calc - 18d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - q_prim_vf(xiend)%sf(j, k , l - 3)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) else if (l == ize) then ! dxiz / dz tensora(9) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & @@ -876,14 +878,14 @@ module m_xi_tensor_calc + 36d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - 16d0*q_prim_vf(xiend)%sf(j, k , l - 3) & + 3d0*q_prim_vf(xiend)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(j) - z_cb(j-1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) else ! dxiz / dz tensora(9) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & - 8d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + 8d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - q_prim_vf(xiend)%sf(j, k , l + 2)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) end if end if @@ -909,11 +911,11 @@ module m_xi_tensor_calc ! STEP 2b: computing the determinant of the grad_xi tensor if (num_dims == 1) then - determinant = tensora(1) + tensorb(tensor_size) = tensora(1) elseif (num_dims == 2) then - determinant = tensora(1)*tensora(4) - tensora(2)*tensora(3) + tensorb(tensor_size) = tensora(1)*tensora(4) - tensora(2)*tensora(3) else - determinant = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) end if @@ -923,7 +925,7 @@ module m_xi_tensor_calc !$acc loop seq do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/determinant + tensora(i) = tensorb(i)/tensorb(tensor_size) end do ! STEP 3: computing F tranpose F @@ -945,7 +947,7 @@ module m_xi_tensor_calc tensorb(8) = tensorb(4) end if ! STEP 4: store the determinant of F in the last entry of the tensor - tensorb(tensor_size) = determinant + !tensorb(tensor_size) = determinant end subroutine s_compute_gradient_xi_acc diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index ff366aa0d8..475c3ec1c7 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -723,7 +723,8 @@ contains end do end if - print *, 'I got here 1 !' + !if(proc_rank == 0) print *, 'I got here 1 !' + call nvtxStartRange("RHS-CONVERT") call s_convert_conservative_to_primitive_variables( & q_cons_qp%vf, & @@ -733,20 +734,22 @@ contains q_btensor%vf) call nvtxEndRange - print *, 'I got here 2 !' + if(proc_rank == 0) print *, 'I got here 2 !' - call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") - if ( hyperelasticity ) then - call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) - end if - call nvtxEndRange + !call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") + ! if ( hyperelasticity ) then + ! !call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) + ! end if + !call nvtxEndRange - print *, 'I got here 3 !' + if(proc_rank == 0) print *, 'I got here 3.1 !' call nvtxStartRange("RHS-MPI") call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) call nvtxEndRange + if(proc_rank == 0) print *, 'I got here 3.2 !' + if (t_step == t_step_stop) return ! ================================================================== @@ -866,9 +869,10 @@ contains end if ix%end = m; iy%end = n; iz%end = p ! =============================================================== + if(proc_rank == 0) print *, 'I got here A4.0 !' ! Computing Riemann Solver Flux and Source Flux ================= - + call nvtxStartRange("RHS_riemann_solver") call s_riemann_solver(qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, & dqR_prim_dx_n(id)%vf, & dqR_prim_dy_n(id)%vf, & @@ -886,10 +890,9 @@ contains id, ix, iy, iz) call nvtxEndRange - ! =============================================================== + if(proc_rank == 0) print *, 'I got here A4.1 !' - ! call nvtxStartRange("RHS_Flux_Add") - ! call nvtxEndRange + ! =============================================================== ! Additional physics and source terms ============================== @@ -909,14 +912,7 @@ contains rhs_vf) call nvtxEndRange - ! RHS additions for hyperelasticity - call nvtxStartRange("RHS_Hyperelasticity") - ! use the calculated Btensor and compute the Cauchy stress tensor in common - !if (hyperelasticity) call s_compute_hyperelastic_rhs(id, & - ! q_prim_qp%vf, & - ! - ! rhs_vf) - call nvtxEndRange + if(proc_rank == 0) print *, 'I got here A4.3 !' ! RHS additions for viscosity call nvtxStartRange("RHS_viscous") @@ -952,6 +948,8 @@ contains end do + if(proc_rank == 0) print *, 'I got here A4.4 !' + if (ib) then !$acc parallel loop collapse(3) gang vector default(present) do l = 0, p @@ -1011,6 +1009,7 @@ contains end if ! ================================================================== + if(proc_rank == 0) print *, 'I got here A4.5 !' end subroutine s_compute_rhs ! ----------------------------------------- diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 3177997be2..6c16ee06ed 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -311,7 +311,7 @@ contains real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R real(kind(0d0)) :: G_L, G_R real(kind(0d0)), dimension(2) :: Re_L, Re_R - real(kind(0d0)), dimension(3) :: xi_field_L, xi_field_R + real(kind(0d0)), dimension(num_dims) :: xi_field_L, xi_field_R real(kind(0d0)) :: rho_avg real(kind(0d0)), dimension(num_dims) :: vel_avg @@ -356,7 +356,7 @@ contains if (norm_dir == ${NORM_DIR}$) then !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, & - !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S) + !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, xi_field_R, xi_field_L) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -505,38 +505,39 @@ contains end do end if - if (hyperelasticity) then - G_L = 0d0 - G_R = 0d0 - !$acc loop seq - do i = 1, num_fluids - G_L = G_L + alpha_L(i)*Gs(i) - G_R = G_R + alpha_R(i)*Gs(i) - end do - - !$acc loop seq - do i = 1, strxe - strxb + 1 - tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) - end do - - !$acc loop seq - do i = 1, xiend - xibeg + 1 - xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) - xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) - end do - - !$acc loop seq - do i = 1, strxe - strxb + 1 + !if (.not. hyperelasticity) then + ! G_L = 0d0 + ! G_R = 0d0 + ! + ! !$acc loop seq + ! do i = 1, num_fluids + ! G_L = G_L + alpha_L(i)*Gs(i) + ! G_R = G_R + alpha_R(i)*Gs(i) + ! end do + + ! !$acc loop seq + ! do i = 1, strxe - strxb + 1 + ! tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + ! tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + ! end do + + !!!!$acc loop seq + !do i = 1, num_dims + ! xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) + ! xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) + !end do + + ! !$acc loop seq + ! do i = 1, strxe - strxb + 1 ! Elastic contribution to energy if G large enough ! TODO MRJ ADD THE ELASTIC ENERGY - if ((G_L > 1d0) .and. (G_R > 1d0)) then - E_L = E_L !+ - E_R = E_R !+ - end if - end do + ! if ((G_L > 1d0) .and. (G_R > 1d0)) then + ! E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) + ! E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) + ! end if + ! end do - end if + !end if @:compute_average_state() @@ -560,7 +561,7 @@ contains end if if (wave_speeds == 1) then - if (hypoelasticity .or. hyperelasticity) then + if (hypoelasticity ) then ! .or. .not. hyperelasticity) then s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & (((4d0*G_L)/3d0) + & tau_e_L(dir_idx_tau(1)))/rho_L) & @@ -641,7 +642,7 @@ contains - rho_R*vel_R(dir_idx(i)))) & /(s_M - s_P) end do - else if (hypoelasticity .or. hyperelasticity) then + else if (hypoelasticity) then ! .or. .not. hyperelasticity) then !$acc loop seq do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & @@ -680,7 +681,7 @@ contains - s_P*vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) & + s_M*s_P*(E_L - E_R)) & /(s_M - s_P) - else if (hypoelasticity .or. hyperelasticity) then + else if (hypoelasticity) then ! .or. .not. hyperelasticity) then !TODO: simplify this so it's not split into 3 if (num_dims == 1) then flux_rs${XYZ}$_vf(j, k, l, E_idx) = & @@ -749,17 +750,17 @@ contains end do ! Xi field - if (hyperelasticity) then - !$acc loop seq - do i = 1, xiend - xibeg + 1 - flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & - (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & - - s_P*rho_L*vel_L(dir_idx(1))*xi_field_L(i) & - + s_M*s_P*(rho_L*xi_field_L(i) & - - rho_R*xi_field_R(i))) & - /(s_M - s_P) - end do - end if + !if (hyperelasticity) then + !!!!$acc loop seq + ! do i = 1, num_dims + !flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & + ! (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & + ! - s_P*rho_L*vel_L(dir_idx(1))*xi_field_L(i) & + ! + s_M*s_P*(rho_L*xi_field_L(i) & + ! - rho_R*xi_field_R(i))) & + ! /(s_M - s_P) + ! end do + !end if ! Div(U)? !$acc loop seq @@ -2532,7 +2533,7 @@ contains !$acc update device(is1, is2, is3) - if (hypoelasticity .or. hyperelasticity) then + if (hypoelasticity) then ! .or. .not. hyperelasticity) then if (norm_dir == 1) then dir_idx_tau = (/1, 2, 4/) else if (norm_dir == 2) then diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index c645d5efa4..1a3e852087 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -179,7 +179,7 @@ contains end if end if - if (hypoelasticity .or. hyperelasticity) then + if (hypoelasticity) then do i = stress_idx%beg, stress_idx%end @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & iy_t%beg:iy_t%end, & @@ -188,6 +188,21 @@ contains end do end if + if (hyperelasticity) then + do i = stress_idx%beg, stress_idx%end + @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & + iy_t%beg:iy_t%end, & + iz_t%beg:iz_t%end)) + @:ACC_SETUP_SFs(q_prim_vf(i)) + end do + do i = xibeg, xiend + @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & + iy_t%beg:iy_t%end, & + iz_t%beg:iz_t%end)) + @:ACC_SETUP_SFs(q_prim_vf(i)) + end do + end if + if (model_eqns == 3) then do i = internalEnergies_idx%beg, internalEnergies_idx%end @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & @@ -985,10 +1000,19 @@ contains @:DEALLOCATE(q_prim_vf(i)%sf) end do - if (hypoelasticity .or. hyperelasticity) then + if (hypoelasticity) then + do i = stress_idx%beg, stress_idx%end + @:DEALLOCATE(q_prim_vf(i)%sf) + end do + end if + + if (hyperelasticity) then do i = stress_idx%beg, stress_idx%end @:DEALLOCATE(q_prim_vf(i)%sf) end do + do i = xibeg, xiend + @:DEALLOCATE(q_prim_vf(i)%sf) + end do end if if (bubbles) then From 16797d90c49eca89ca09df7645a659ddd241e969 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 26 May 2024 17:05:27 -0500 Subject: [PATCH 122/380] bare code using scalar fields for tensora and tensorb for the grad xi calculation to avoid segfaults, compiles and appears to be working, further testing needed --- src/common/m_variables_conversion.fpp | 57 ++-- src/common/m_xi_tensor_calc.fpp | 418 +------------------------- 2 files changed, 43 insertions(+), 432 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index e3bc38e175..3ed2e58561 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -110,6 +110,9 @@ module m_variables_conversion real(kind(0d0)), allocatable, dimension(:, :, :), public :: pi_inf_sf !< Scalar liquid stiffness function real(kind(0d0)), allocatable, dimension(:, :, :), public :: qv_sf !< Scalar liquid energy reference function + type(scalar_field), allocatable, dimension(:) :: tensora, tensorb !< + !$acc declare create(tensora,tensorb) + procedure(s_convert_xxxxx_to_mixture_variables), & pointer :: s_convert_to_mixture_variables => null() !< !! Pointer referencing the subroutine s_convert_mixture_to_mixture_variables @@ -711,6 +714,20 @@ contains !$acc update device(bubrs) end if +#ifdef MFC_SIMULATION + if (hyperelasticity) then + @:ALLOCATE_GLOBAL(tensora(1:tensor_size)) + @:ALLOCATE_GLOBAL(tensorb(1:tensor_size)) + + do i = 1, tensor_size + @:ALLOCATE(tensora(i)%sf(ixb:ixe, iyb:iye, izb:ize)) + @:ALLOCATE(tensorb(i)%sf(ixb:ixe, iyb:iye, izb:ize)) + @:ACC_SETUP_SFs(tensora(i)) + @:ACC_SETUP_SFs(tensorb(i)) + end do + end if +#endif + #ifdef MFC_POST_PROCESS ! Allocating the density, the specific heat ratio function and the ! liquid stiffness function, respectively @@ -1467,40 +1484,28 @@ contains type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf type(scalar_field), dimension(b_size), intent(OUT) :: btensor - real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb integer :: j, k, l - !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) + !$acc parallel loop collapse(3) gang vector default(present) do l = izb, ize do k = iyb, iye do j = ixb, ixe call s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, & iye, izb, ize, j, k, l, tensora, tensorb) - -! if(j == ixb) then -! ! dxix/dx -! tensorb(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & -! + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & -! - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & -! + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & -! - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l) ) & -! /(12d0*(x_cb(j+1) - x_cb(j))) -! end if - - ! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensorb(1) + !! 1: 1D, 3: 2D, 6: 3D + btensor(1)%sf(j, k, l) = tensorb(1)%sf(j,k,l) if (num_dims > 1) then ! 2D - btensor(2)%sf(j,k,l) = tensorb(2) - btensor(3)%sf(j,k,l) = tensorb(4) + btensor(2)%sf(j,k,l) = tensorb(2)%sf(j,k,l) + btensor(3)%sf(j,k,l) = tensorb(4)%sf(j,k,l) end if if (num_dims > 2) then ! 3D - btensor(3)%sf(j,k,l) = tensorb(3) - btensor(4)%sf(j,k,l) = tensorb(5) - btensor(5)%sf(j,k,l) = tensorb(6) - btensor(6)%sf(j,k,l) = tensorb(9) + btensor(3)%sf(j,k,l) = tensorb(3)%sf(j,k,l) + btensor(4)%sf(j,k,l) = tensorb(5)%sf(j,k,l) + btensor(5)%sf(j,k,l) = tensorb(6)%sf(j,k,l) + btensor(6)%sf(j,k,l) = tensorb(9)%sf(j,k,l) end if - ! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) + !! store the determinant at the last entry of the btensor sf + btensor(b_size)%sf(j,k,l) = tensorb(tensor_size)%sf(j,k,l) end do end do end do @@ -1521,6 +1526,12 @@ contains if (bubbles) then @:DEALLOCATE_GLOBAL(bubrs) end if + + ! Deallocating the cell-average primitive variables + do i = 1, tensor_size + @:DEALLOCATE(tensora(i)%sf) + @:DEALLOCATE(tensorb(i)%sf) + end do #else @:DEALLOCATE(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, Gs) if (bubbles) then diff --git a/src/common/m_xi_tensor_calc.fpp b/src/common/m_xi_tensor_calc.fpp index a6048d7513..a1f9a7c39d 100644 --- a/src/common/m_xi_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.fpp @@ -493,14 +493,14 @@ module m_xi_tensor_calc !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- - izb, ize, j, k, l, tensora, tensorb) + izb, ize, j, k, l, tensora, tensorb ) !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora, tensorb + type(scalar_field), dimension(tensor_size), intent(INOUT) :: tensora, tensorb integer, intent(IN) :: ixb, ixe, iyb, iye, izb, ize integer, intent(IN) :: j, k, l - !real(kind(0d0)) :: determinant + real(kind(0d0)) :: test integer :: i ! STEP 1: computing the grad_xi tensor @@ -510,7 +510,7 @@ module m_xi_tensor_calc ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz if(j == ixb) then ! dxix/dx - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensorb(1)%sf(j,k,l) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & @@ -518,7 +518,7 @@ module m_xi_tensor_calc /(12d0*(x_cb(j+1) - x_cb(j))) else if (j == ixb + 1) then ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + tensorb(1)%sf(j,k,l) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & @@ -526,7 +526,7 @@ module m_xi_tensor_calc /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == ixe - 1) then ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + tensorb(1)%sf(j,k,l) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & @@ -534,7 +534,7 @@ module m_xi_tensor_calc /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == ixe) then ! dxix/dx - tensora(1) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensorb(1)%sf(j,k,l) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & @@ -542,414 +542,14 @@ module m_xi_tensor_calc /(12d0*(x_cb(j) - x_cb(j-1))) else ! dxix/dx - tensora(1) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & + tensorb(1)%sf(j,k,l) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - q_prim_vf(xibeg)%sf(j + 2, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) end if - if (num_dims > 1) then - if(j == ixb) then - ! dxiy / dx - tensora(2) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg+1)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg+1)%sf(j + 4, k, l) ) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == ixb + 1) then - ! dxiy / dx - tensora(2) = (-3d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & - + q_prim_vf(xibeg+1)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe - 1) then - ! dxiy / dx - tensora(2) = (3d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - - q_prim_vf(xibeg+1)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe) then - ! dxiy / dx - tensora(2) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg+1)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg+1)%sf(j - 4, k, l) ) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxiy / dx - tensora(2) = ( q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg+1)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - if(k == iyb) then - ! dxix / dy - tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - else if (k == iyb + 1) then - ! dxix / dy - tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + q_prim_vf(xibeg)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye - 1) then - ! dxix / dy - tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - q_prim_vf(xibeg)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye) then - ! dxix / dy - tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxix / dy - tensora(3) = ( q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - if(k == iyb) then - ! dxiy / dy - tensora(4) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg+1)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg+1)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - else if (k == iyb + 1) then - ! dxiy / dy - tensora(4) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & - + q_prim_vf(xibeg+1)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye - 1) then - ! dxiy / dy - tensora(4) = (3d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - - q_prim_vf(xibeg+1)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye) then - ! dxiy / dy - tensora(4) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg+1)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg+1)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxiy / dy - tensora(4) = ( q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg+1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - end if - - tensorb(4) = tensora(4) - tensorb(3) = tensora(3) - ! 3D - if (num_dims > 2) then - ! using results from upper if statement to map form 2x2 to 3x3 tensor - tensora(5) = tensorb(4) - tensora(4) = tensorb(3) - - if(l == izb) then - ! dxix / dz - tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - - 36d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & - + 16d0*q_prim_vf(xibeg)%sf(j, k , l + 3) & - - 3d0*q_prim_vf(xibeg)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == izb + 1) then - ! dxix / dz - tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - - 6d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & - + q_prim_vf(xibeg)%sf(j, k , l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize - 1) then - ! dxix / dz - tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - - q_prim_vf(xibeg)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize) then - ! dxix / dz - tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxix / dz - tensora(3) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - - q_prim_vf(xibeg)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - - if(l == izb) then - ! dxiy / dz - tensora(6) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - - 36d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & - + 16d0*q_prim_vf(xibeg+1)%sf(j, k , l + 3) & - - 3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == izb + 1) then - ! dxiy / dz - tensora(6) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - - 6d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & - + q_prim_vf(xibeg+1)%sf(j, k , l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize - 1) then - ! dxiy / dz - tensora(6) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - q_prim_vf(xibeg+1)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize) then - ! dxiy / dz - tensora(6) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxiy / dz - tensora(6) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - - if(j == ixb) then - ! dxiz / dx - tensora(7) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l) ) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == ixb + 1) then - ! dxiz / dx - tensora(7) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xiend)%sf(j,k,l) & - + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + q_prim_vf(xiend)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe - 1) then - ! dxiz / dx - tensora(7) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - q_prim_vf(xiend)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe) then - ! dxiz / dx - tensora(7) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l) ) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxiz / dx - tensora(7) = ( q_prim_vf(xiend)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - q_prim_vf(xiend)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - if(k == iyb) then - ! dxiz / dy - tensora(8) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - else if (k == iyb + 1) then - ! dxiz / dy - tensora(8) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xiend)%sf(j,k,l) & - + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + q_prim_vf(xiend)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye - 1) then - ! dxiz / dy - tensora(8) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - q_prim_vf(xiend)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye) then - ! dxiz / dy - tensora(8) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxiz / dy - tensora(8) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - if(l == izb) then - ! dxiz / dz - tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - - 36d0*q_prim_vf(xiend)%sf(j, k , l + 2) & - + 16d0*q_prim_vf(xiend)%sf(j, k , l + 3) & - - 3d0*q_prim_vf(xiend)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == izb + 1) then - ! dxiz / dz - tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - - 10d0*q_prim_vf(xiend)%sf(j,k,l) & - + 18d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - - 6d0*q_prim_vf(xiend)%sf(j, k , l + 2) & - + q_prim_vf(xiend)%sf(j, k , l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize - 1) then - ! dxiz / dz - tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - - 18d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - - q_prim_vf(xiend)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize) then - ! dxiz / dz - tensora(9) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xiend)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xiend)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxiz / dz - tensora(9) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - - q_prim_vf(xiend)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - end if - - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - if (num_dims == 1) then - tensorb(1) = 1 - elseif (num_dims == 2) then - tensorb(1) = tensora(4) - tensorb(2) = -tensora(3) - tensorb(3) = -tensora(2) - tensorb(4) = tensora(1) - elseif (num_dims == 3) then - tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) - tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) - tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) - tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) - tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) - tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) - tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) - tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) - tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) - end if - - ! STEP 2b: computing the determinant of the grad_xi tensor - if (num_dims == 1) then - tensorb(tensor_size) = tensora(1) - elseif (num_dims == 2) then - tensorb(tensor_size) = tensora(1)*tensora(4) - tensora(2)*tensora(3) - else - tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & - + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - end if - - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse - - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - - ! STEP 3: computing F tranpose F - tensorb(1) = tensora(1)**2 - if (num_dims == 2) then - tensorb(1) = tensorb(1) + tensora(3)**2 - tensorb(2) = tensora(1)*tensora(2) + tensora(3)*tensora(4) - tensorb(3) = tensorb(2) - tensorb(4) = tensora(2)**2 + tensora(4)**2 - elseif (num_dims == 3) then - tensorb(1) = tensorb(1) + tensora(4)**2 + tensora(7)**2 - tensorb(5) = tensora(2) + tensora(5)**2 + tensora(8)**2 - tensorb(9) = tensora(3) + tensora(6)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(2) + tensora(4)*tensora(5) + tensora(7)*tensora(8) - tensorb(3) = tensora(1)*tensora(3) + tensora(4)*tensora(6) + tensora(7)*tensora(9) - tensorb(6) = tensora(2)*tensora(3) + tensora(5)*tensora(6) + tensora(8)*tensora(9) - tensorb(4) = tensorb(2) - tensorb(7) = tensorb(3) - tensorb(8) = tensorb(4) - end if - ! STEP 4: store the determinant of F in the last entry of the tensor - !tensorb(tensor_size) = determinant - - end subroutine s_compute_gradient_xi_acc + end subroutine s_compute_gradient_xi_acc !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. From e27a99ab91b47c9a9f275a9387ee0aa604ea113d Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 26 May 2024 17:16:44 -0500 Subject: [PATCH 123/380] issue persists, checking again --- src/common/m_variables_conversion.fpp | 2 + src/common/m_xi_tensor_calc.fpp | 422 +++++++++++++++++++++++++- 2 files changed, 416 insertions(+), 8 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 3ed2e58561..e1d084739f 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1515,6 +1515,8 @@ contains subroutine s_finalize_variables_conversion_module() ! ------------------ + integer :: i !< Generic loop iterators + ! Deallocating the density, the specific heat ratio function and the ! liquid stiffness function #ifdef MFC_POST_PROCESS diff --git a/src/common/m_xi_tensor_calc.fpp b/src/common/m_xi_tensor_calc.fpp index a1f9a7c39d..30d34e00f4 100644 --- a/src/common/m_xi_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.fpp @@ -493,14 +493,13 @@ module m_xi_tensor_calc !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- - izb, ize, j, k, l, tensora, tensorb ) + izb, ize, j, k, l, tensora, tensorb) !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf type(scalar_field), dimension(tensor_size), intent(INOUT) :: tensora, tensorb integer, intent(IN) :: ixb, ixe, iyb, iye, izb, ize integer, intent(IN) :: j, k, l - real(kind(0d0)) :: test integer :: i ! STEP 1: computing the grad_xi tensor @@ -510,7 +509,7 @@ module m_xi_tensor_calc ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz if(j == ixb) then ! dxix/dx - tensorb(1)%sf(j,k,l) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensora(1)%sf(j,k,l) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & @@ -518,7 +517,7 @@ module m_xi_tensor_calc /(12d0*(x_cb(j+1) - x_cb(j))) else if (j == ixb + 1) then ! dxix/dx - tensorb(1)%sf(j,k,l) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + tensora(1)%sf(j,k,l) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & @@ -526,7 +525,7 @@ module m_xi_tensor_calc /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == ixe - 1) then ! dxix/dx - tensorb(1)%sf(j,k,l) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + tensora(1)%sf(j,k,l) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & @@ -534,7 +533,7 @@ module m_xi_tensor_calc /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == ixe) then ! dxix/dx - tensorb(1)%sf(j,k,l) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensora(1)%sf(j,k,l) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & @@ -542,14 +541,420 @@ module m_xi_tensor_calc /(12d0*(x_cb(j) - x_cb(j-1))) else ! dxix/dx - tensorb(1)%sf(j,k,l) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & + tensora(1)%sf(j,k,l) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - q_prim_vf(xibeg)%sf(j + 2, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) end if - end subroutine s_compute_gradient_xi_acc + if (num_dims > 1) then + if(j == ixb) then + ! dxiy / dx + tensora(2)%sf(j,k,l) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg+1)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg+1)%sf(j + 4, k, l) ) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + else if (j == ixb + 1) then + ! dxiy / dx + tensora(2)%sf(j,k,l) = (-3d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & + + q_prim_vf(xibeg+1)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe - 1) then + ! dxiy / dx + tensora(2)%sf(j,k,l) = (3d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + - q_prim_vf(xibeg+1)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe) then + ! dxiy / dx + tensora(2)%sf(j,k,l) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg+1)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg+1)%sf(j - 4, k, l) ) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxiy / dx + tensora(2)%sf(j,k,l) = ( q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg+1)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + if(k == iyb) then + ! dxix / dy + tensora(3)%sf(j,k,l) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l) ) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + else if (k == iyb + 1) then + ! dxix / dy + tensora(3)%sf(j,k,l) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + q_prim_vf(xibeg)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye - 1) then + ! dxix / dy + tensora(3)%sf(j,k,l) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - q_prim_vf(xibeg)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye) then + ! dxix / dy + tensora(3)%sf(j,k,l) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l) ) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxix / dy + tensora(3)%sf(j,k,l) = ( q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + if(k == iyb) then + ! dxiy / dy + tensora(4)%sf(j,k,l) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg+1)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg+1)%sf(j, k + 4, l) ) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + else if (k == iyb + 1) then + ! dxiy / dy + tensora(4)%sf(j,k,l) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & + + q_prim_vf(xibeg+1)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye - 1) then + ! dxiy / dy + tensora(4)%sf(j,k,l) = (3d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + - q_prim_vf(xibeg+1)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye) then + ! dxiy / dy + tensora(4)%sf(j,k,l) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg+1)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg+1)%sf(j, k - 4, l) ) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxiy / dy + tensora(4)%sf(j,k,l) = ( q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg+1)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + end if + + tensorb(4)%sf(j,k,l) = tensora(4)%sf(j,k,l) + tensorb(3)%sf(j,k,l) = tensora(3)%sf(j,k,l) + ! 3D + if (num_dims > 2) then + ! using results from upper if statement to map form 2x2 to 3x3 tensor + tensora(5)%sf(j,k,l) = tensorb(4)%sf(j,k,l) + tensora(4)%sf(j,k,l) = tensorb(3)%sf(j,k,l) + + if(l == izb) then + ! dxix / dz + tensora(3)%sf(j,k,l) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + - 36d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & + + 16d0*q_prim_vf(xibeg)%sf(j, k , l + 3) & + - 3d0*q_prim_vf(xibeg)%sf(j, k , l + 4) ) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == izb + 1) then + ! dxix / dz + tensora(3)%sf(j,k,l) = (-3d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + - 6d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & + + q_prim_vf(xibeg)%sf(j, k , l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ize - 1) then + ! dxix / dz + tensora(3)%sf(j,k,l) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & + - q_prim_vf(xibeg)%sf(j, k , l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ize) then + ! dxix / dz + tensora(3)%sf(j,k,l) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxix / dz + tensora(3)%sf(j,k,l) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + - q_prim_vf(xibeg)%sf(j, k , l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if + + if(l == izb) then + ! dxiy / dz + tensora(6)%sf(j,k,l) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + - 36d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & + + 16d0*q_prim_vf(xibeg+1)%sf(j, k , l + 3) & + - 3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 4) ) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == izb + 1) then + ! dxiy / dz + tensora(6)%sf(j,k,l) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + - 6d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & + + q_prim_vf(xibeg+1)%sf(j, k , l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ize - 1) then + ! dxiy / dz + tensora(6)%sf(j,k,l) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - q_prim_vf(xibeg+1)%sf(j, k , l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ize) then + ! dxiy / dz + tensora(6)%sf(j,k,l) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxiy / dz + tensora(6)%sf(j,k,l) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if + + if(j == ixb) then + ! dxiz / dx + tensora(7)%sf(j,k,l) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l) ) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + else if (j == ixb + 1) then + ! dxiz / dx + tensora(7)%sf(j,k,l) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + q_prim_vf(xiend)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe - 1) then + ! dxiz / dx + tensora(7)%sf(j,k,l) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xiend)%sf(j,k,l) & + - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - q_prim_vf(xiend)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe) then + ! dxiz / dx + tensora(7)%sf(j,k,l) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l) ) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxiz / dx + tensora(7)%sf(j,k,l) = ( q_prim_vf(xiend)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - q_prim_vf(xiend)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + if(k == iyb) then + ! dxiz / dy + tensora(8)%sf(j,k,l) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l) ) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + else if (k == iyb + 1) then + ! dxiz / dy + tensora(8)%sf(j,k,l) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + q_prim_vf(xiend)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye - 1) then + ! dxiz / dy + tensora(8)%sf(j,k,l) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xiend)%sf(j,k,l) & + - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - q_prim_vf(xiend)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye) then + ! dxiz / dy + tensora(8)%sf(j,k,l) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l) ) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxiz / dy + tensora(8)%sf(j,k,l) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - q_prim_vf(xiend)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + if(l == izb) then + ! dxiz / dz + tensora(9)%sf(j,k,l) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + - 36d0*q_prim_vf(xiend)%sf(j, k , l + 2) & + + 16d0*q_prim_vf(xiend)%sf(j, k , l + 3) & + - 3d0*q_prim_vf(xiend)%sf(j, k , l + 4) ) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == izb + 1) then + ! dxiz / dz + tensora(9)%sf(j,k,l) = (-3d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + + 18d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + - 6d0*q_prim_vf(xiend)%sf(j, k , l + 2) & + + q_prim_vf(xiend)%sf(j, k , l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ize - 1) then + ! dxiz / dz + tensora(9)%sf(j,k,l) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xiend)%sf(j,k,l) & + - 18d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & + - q_prim_vf(xiend)%sf(j, k , l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ize) then + ! dxiz / dz + tensora(9)%sf(j,k,l) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xiend)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xiend)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xiend)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxiz / dz + tensora(9)%sf(j,k,l) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + - q_prim_vf(xiend)%sf(j, k , l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if + end if + + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + if (num_dims == 1) then + tensorb(1)%sf(j,k,l) = 1d0 + elseif (num_dims == 2) then + tensorb(1)%sf(j,k,l) = tensora(4)%sf(j,k,l) + tensorb(2)%sf(j,k,l) = -tensora(3)%sf(j,k,l) + tensorb(3)%sf(j,k,l) = -tensora(2)%sf(j,k,l) + tensorb(4)%sf(j,k,l) = tensora(1)%sf(j,k,l) + elseif (num_dims == 3) then + tensorb(1)%sf(j,k,l) = tensora(5)%sf(j,k,l)*tensora(9)%sf(j,k,l) - tensora(6)%sf(j,k,l)*tensora(8)%sf(j,k,l) + tensorb(2)%sf(j,k,l) = -(tensora(2)%sf(j,k,l)*tensora(9)%sf(j,k,l) - tensora(3)%sf(j,k,l)*tensora(8)%sf(j,k,l)) + tensorb(3)%sf(j,k,l) = tensora(2)%sf(j,k,l)*tensora(6)%sf(j,k,l) - tensora(3)%sf(j,k,l)*tensora(5)%sf(j,k,l) + tensorb(4)%sf(j,k,l) = -(tensora(4)%sf(j,k,l)*tensora(9)%sf(j,k,l) - tensora(6)%sf(j,k,l)*tensora(7)%sf(j,k,l)) + tensorb(5)%sf(j,k,l) = tensora(1)%sf(j,k,l)*tensora(9)%sf(j,k,l) - tensora(3)%sf(j,k,l)*tensora(7)%sf(j,k,l) + tensorb(6)%sf(j,k,l) = -(tensora(1)%sf(j,k,l)*tensora(6)%sf(j,k,l) - tensora(4)%sf(j,k,l)*tensora(3)%sf(j,k,l)) + tensorb(7)%sf(j,k,l) = tensora(4)%sf(j,k,l)*tensora(8)%sf(j,k,l) - tensora(5)%sf(j,k,l)*tensora(7)%sf(j,k,l) + tensorb(8)%sf(j,k,l) = -(tensora(1)%sf(j,k,l)*tensora(8)%sf(j,k,l) - tensora(2)%sf(j,k,l)*tensora(7)%sf(j,k,l)) + tensorb(9)%sf(j,k,l) = tensora(1)%sf(j,k,l)*tensora(5)%sf(j,k,l) - tensora(2)%sf(j,k,l)*tensora(4)%sf(j,k,l) + end if + + ! STEP 2b: computing the determinant of the grad_xi tensor + if (num_dims == 1) then + tensorb(tensor_size)%sf(j,k,l) = tensora(1)%sf(j,k,l) + elseif (num_dims == 2) then + tensorb(tensor_size)%sf(j,k,l) = tensora(1)%sf(j,k,l)*tensora(4)%sf(j,k,l) - tensora(2)%sf(j,k,l)*tensora(3)%sf(j,k,l) + else + tensorb(tensor_size)%sf(j,k,l) = tensora(1)%sf(j,k,l)*(tensora(5)%sf(j,k,l)*tensora(9)%sf(j,k,l) & + - tensora(6)%sf(j,k,l)*tensora(8)%sf(j,k,l)) & + - tensora(2)%sf(j,k,l)*(tensora(4)%sf(j,k,l)*tensora(9)%sf(j,k,l) & + - tensora(6)%sf(j,k,l)*tensora(7)%sf(j,k,l)) & + + tensora(3)%sf(j,k,l)*(tensora(4)%sf(j,k,l)*tensora(8)%sf(j,k,l) & + - tensora(5)%sf(j,k,l)*tensora(7)%sf(j,k,l)) + end if + + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse + + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i)%sf(j,k,l) = tensorb(i)%sf(j,k,l)/tensorb(tensor_size)%sf(j,k,l) + end do + + ! STEP 3: computing F tranpose F + tensorb(1)%sf(j,k,l) = tensora(1)%sf(j,k,l)**2 + if (num_dims == 2) then + tensorb(1)%sf(j,k,l) = tensorb(1)%sf(j,k,l) + tensora(3)%sf(j,k,l)**2 + tensorb(2)%sf(j,k,l) = tensora(1)%sf(j,k,l)*tensora(2)%sf(j,k,l) + tensora(3)%sf(j,k,l)*tensora(4)%sf(j,k,l) + tensorb(3)%sf(j,k,l) = tensorb(2)%sf(j,k,l) + tensorb(4)%sf(j,k,l) = tensora(2)%sf(j,k,l)**2 + tensora(4)%sf(j,k,l)**2 + elseif (num_dims == 3) then + tensorb(1)%sf(j,k,l) = tensorb(1)%sf(j,k,l) + tensora(4)%sf(j,k,l)**2 + tensora(7)%sf(j,k,l)**2 + tensorb(5)%sf(j,k,l) = tensora(2)%sf(j,k,l) + tensora(5)%sf(j,k,l)**2 + tensora(8)%sf(j,k,l)**2 + tensorb(9)%sf(j,k,l) = tensora(3)%sf(j,k,l) + tensora(6)%sf(j,k,l)**2 + tensora(9)%sf(j,k,l)**2 + tensorb(2)%sf(j,k,l) = tensora(1)%sf(j,k,l)*tensora(2)%sf(j,k,l) + tensora(4)%sf(j,k,l)*tensora(5)%sf(j,k,l) & + + tensora(7)%sf(j,k,l)*tensora(8)%sf(j,k,l) + tensorb(3)%sf(j,k,l) = tensora(1)%sf(j,k,l)*tensora(3)%sf(j,k,l) + tensora(4)%sf(j,k,l)*tensora(6)%sf(j,k,l) & + + tensora(7)%sf(j,k,l)*tensora(9)%sf(j,k,l) + tensorb(6)%sf(j,k,l) = tensora(2)%sf(j,k,l)*tensora(3)%sf(j,k,l) + tensora(5)%sf(j,k,l)*tensora(6)%sf(j,k,l) & + + tensora(8)%sf(j,k,l)*tensora(9)%sf(j,k,l) + tensorb(4)%sf(j,k,l) = tensorb(2)%sf(j,k,l) + tensorb(7)%sf(j,k,l) = tensorb(3)%sf(j,k,l) + tensorb(8)%sf(j,k,l) = tensorb(4)%sf(j,k,l) + end if + ! STEP 4: store the determinant of F in the last entry of the tensor + !tensorb(tensor_size)%sf(j,k,l) = determinant + + end subroutine s_compute_gradient_xi_acc !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. @@ -582,3 +987,4 @@ module m_xi_tensor_calc end function f_elastic_energy end module m_xi_tensor_calc + From 449d643dfa7cda876086f59fcd03e7bf2eaffea7 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 26 May 2024 23:37:13 -0500 Subject: [PATCH 124/380] reorganized the code to use private variables as tensors instead of scalar ffields. The code compiles, but does not run. Working on if this is 3D problem --- src/common/m_variables_conversion.fpp | 99 +-- ...i_tensor_calc.fpp => m_xi_tensor_calc.f90} | 606 ++++++++++++------ 2 files changed, 471 insertions(+), 234 deletions(-) rename src/common/{m_xi_tensor_calc.fpp => m_xi_tensor_calc.f90} (68%) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index e1d084739f..4821586976 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -110,9 +110,6 @@ module m_variables_conversion real(kind(0d0)), allocatable, dimension(:, :, :), public :: pi_inf_sf !< Scalar liquid stiffness function real(kind(0d0)), allocatable, dimension(:, :, :), public :: qv_sf !< Scalar liquid energy reference function - type(scalar_field), allocatable, dimension(:) :: tensora, tensorb !< - !$acc declare create(tensora,tensorb) - procedure(s_convert_xxxxx_to_mixture_variables), & pointer :: s_convert_to_mixture_variables => null() !< !! Pointer referencing the subroutine s_convert_mixture_to_mixture_variables @@ -714,20 +711,6 @@ contains !$acc update device(bubrs) end if -#ifdef MFC_SIMULATION - if (hyperelasticity) then - @:ALLOCATE_GLOBAL(tensora(1:tensor_size)) - @:ALLOCATE_GLOBAL(tensorb(1:tensor_size)) - - do i = 1, tensor_size - @:ALLOCATE(tensora(i)%sf(ixb:ixe, iyb:iye, izb:ize)) - @:ALLOCATE(tensorb(i)%sf(ixb:ixe, iyb:iye, izb:ize)) - @:ACC_SETUP_SFs(tensora(i)) - @:ACC_SETUP_SFs(tensorb(i)) - end do - end if -#endif - #ifdef MFC_POST_PROCESS ! Allocating the density, the specific heat ratio function and the ! liquid stiffness function, respectively @@ -1484,32 +1467,62 @@ contains type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf type(scalar_field), dimension(b_size), intent(OUT) :: btensor + real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb integer :: j, k, l - !$acc parallel loop collapse(3) gang vector default(present) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe - call s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, & - iye, izb, ize, j, k, l, tensora, tensorb) - !! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensorb(1)%sf(j,k,l) - if (num_dims > 1) then ! 2D - btensor(2)%sf(j,k,l) = tensorb(2)%sf(j,k,l) - btensor(3)%sf(j,k,l) = tensorb(4)%sf(j,k,l) - end if - if (num_dims > 2) then ! 3D - btensor(3)%sf(j,k,l) = tensorb(3)%sf(j,k,l) - btensor(4)%sf(j,k,l) = tensorb(5)%sf(j,k,l) - btensor(5)%sf(j,k,l) = tensorb(6)%sf(j,k,l) - btensor(6)%sf(j,k,l) = tensorb(9)%sf(j,k,l) - end if - !! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j,k,l) = tensorb(tensor_size)%sf(j,k,l) + if (num_dims == 1) then + !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe + call s_compute_gradient_xi1d_acc(q_prim_vf, ixb, ixe, iyb, & + iye, izb, ize, j, k, l, tensora, tensorb) + !! 1: 1D, 3: 2D, 6: 3D + btensor(1)%sf(j, k, l) = tensorb(1) + !! store the determinant at the last entry of the btensor sf + btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) end do - end do - end do - !$acc end parallel loop + end do + end do + !$acc end parallel loop + else if (num_dims == 2) then ! 2D + !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe + call s_compute_gradient_xi2d_acc(q_prim_vf, ixb, ixe, iyb, & + iye, izb, ize, j, k, l, tensora, tensorb) + !! 1: 1D, 3: 2D, 6: 3D + btensor(1)%sf(j, k, l) = tensorb(1) + btensor(2)%sf(j,k,l) = tensorb(2) + btensor(3)%sf(j,k,l) = tensorb(4) + !! store the determinant at the last entry of the btensor sf + btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) + end do + end do + end do + !$acc end parallel loop + else ! 3D + !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe + call s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, & + iye, izb, ize, j, k, l, tensora, tensorb) + !! 1: 1D, 3: 2D, 6: 3D + !btensor(1)%sf(j, k, l) = tensorb(1) + !btensor(2)%sf(j,k,l) = tensorb(2) + !btensor(3)%sf(j,k,l) = tensorb(3) + !btensor(4)%sf(j,k,l) = tensorb(5) + !btensor(5)%sf(j,k,l) = tensorb(6) + !btensor(6)%sf(j,k,l) = tensorb(9) + !! store the determinant at the last entry of the btensor sf + !btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) + end do + end do + end do + !$acc end parallel loop + end if end subroutine s_calculate_btensor_acc @@ -1528,12 +1541,6 @@ contains if (bubbles) then @:DEALLOCATE_GLOBAL(bubrs) end if - - ! Deallocating the cell-average primitive variables - do i = 1, tensor_size - @:DEALLOCATE(tensora(i)%sf) - @:DEALLOCATE(tensorb(i)%sf) - end do #else @:DEALLOCATE(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, Gs) if (bubbles) then diff --git a/src/common/m_xi_tensor_calc.fpp b/src/common/m_xi_tensor_calc.f90 similarity index 68% rename from src/common/m_xi_tensor_calc.fpp rename to src/common/m_xi_tensor_calc.f90 index 30d34e00f4..757d7a1c39 100644 --- a/src/common/m_xi_tensor_calc.fpp +++ b/src/common/m_xi_tensor_calc.f90 @@ -15,7 +15,11 @@ module m_xi_tensor_calc implicit none - private; public :: s_compute_gradient_xi, s_compute_gradient_xi_acc, f_elastic_energy + private; public :: s_compute_gradient_xi, & +s_compute_gradient_xi1d_acc, & +s_compute_gradient_xi2d_acc, & +s_compute_gradient_xi3d_acc, & +f_elastic_energy contains @@ -484,6 +488,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) end subroutine s_compute_gradient_xi + !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. !! @param q_prim_vf Primitive variables @@ -492,14 +497,99 @@ end subroutine s_compute_gradient_xi !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- + subroutine s_compute_gradient_xi1d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- izb, ize, j, k, l, tensora, tensorb) !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - type(scalar_field), dimension(tensor_size), intent(INOUT) :: tensora, tensorb + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb integer, intent(IN) :: ixb, ixe, iyb, iye, izb, ize integer, intent(IN) :: j, k, l + integer :: i + + ! STEP 1: computing the grad_xi tensor + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz + if(j == ixb) then + ! dxix/dx + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l) ) & + /(12d0*(x_cb(j+1) - x_cb(j))) + else if (j == ixb + 1) then + ! dxix/dx + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + q_prim_vf(xibeg)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe - 1) then + ! dxix/dx + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - q_prim_vf(xibeg)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe) then + ! dxix/dx + tensora(1) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l) ) & + /(12d0*(x_cb(j) - x_cb(j-1))) + else + ! dxix/dx + tensora(1) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = 1 + + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1) + + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do + + ! STEP 3: computing F tranpose F + tensorb(1) = tensora(1)**2 + ! STEP 4: store the determinant of F in the last entry of the tensor + !tensorb(tensor_size) = determinant + + end subroutine s_compute_gradient_xi1d_acc + + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_compute_gradient_xi2d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- + izb, ize, j, k, l, tensora, tensorb) + !$acc routine seq + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb + integer, intent(IN) :: ixb, ixe, iyb, iye, izb, ize + integer, intent(IN) :: j, k, l integer :: i ! STEP 1: computing the grad_xi tensor @@ -509,7 +599,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz if(j == ixb) then ! dxix/dx - tensora(1)%sf(j,k,l) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & @@ -517,7 +607,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- /(12d0*(x_cb(j+1) - x_cb(j))) else if (j == ixb + 1) then ! dxix/dx - tensora(1)%sf(j,k,l) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & @@ -525,7 +615,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == ixe - 1) then ! dxix/dx - tensora(1)%sf(j,k,l) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & @@ -533,7 +623,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == ixe) then ! dxix/dx - tensora(1)%sf(j,k,l) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensora(1) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & @@ -541,17 +631,17 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- /(12d0*(x_cb(j) - x_cb(j-1))) else ! dxix/dx - tensora(1)%sf(j,k,l) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & + tensora(1) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - q_prim_vf(xibeg)%sf(j + 2, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) end if - if (num_dims > 1) then + ! 2D if(j == ixb) then ! dxiy / dx - tensora(2)%sf(j,k,l) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + tensora(2) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - 36d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & + 16d0*q_prim_vf(xibeg+1)%sf(j + 3, k, l) & @@ -559,7 +649,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- /(12d0*(x_cb(j + 1) - x_cb(j))) else if (j == ixb + 1) then ! dxiy / dx - tensora(2)%sf(j,k,l) = (-3d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + tensora(2) = (-3d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - 6d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & @@ -567,7 +657,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == ixe - 1) then ! dxiy / dx - tensora(2)%sf(j,k,l) = (3d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + tensora(2) = (3d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + 6d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & @@ -575,7 +665,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == ixe) then ! dxiy / dx - tensora(2)%sf(j,k,l) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + tensora(2) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + 36d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - 16d0*q_prim_vf(xibeg+1)%sf(j - 3, k, l) & @@ -583,7 +673,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- /(12d0*(x_cb(j) - x_cb(j - 1))) else ! dxiy / dx - tensora(2)%sf(j,k,l) = ( q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + tensora(2) = ( q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - 8d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + 8d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - q_prim_vf(xibeg+1)%sf(j + 2, k, l)) & @@ -592,7 +682,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- if(k == iyb) then ! dxix / dy - tensora(3)%sf(j,k,l) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & @@ -600,7 +690,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- /(12d0*(y_cb(k + 1) - y_cb(k))) else if (k == iyb + 1) then ! dxix / dy - tensora(3)%sf(j,k,l) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & @@ -608,7 +698,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- /(12d0*(y_cb(k) - y_cb(k - 1))) else if (k == iye - 1) then ! dxix / dy - tensora(3)%sf(j,k,l) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & @@ -616,7 +706,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- /(12d0*(y_cb(k) - y_cb(k - 1))) else if (k == iye) then ! dxix / dy - tensora(3)%sf(j,k,l) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & @@ -624,7 +714,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- /(12d0*(y_cb(k) - y_cb(k - 1))) else ! dxix / dy - tensora(3)%sf(j,k,l) = ( q_prim_vf(xibeg)%sf(j, k - 2, l) & + tensora(3) = ( q_prim_vf(xibeg)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - q_prim_vf(xibeg)%sf(j, k + 2, l)) & @@ -633,7 +723,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- if(k == iyb) then ! dxiy / dy - tensora(4)%sf(j,k,l) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + tensora(4) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - 36d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & + 16d0*q_prim_vf(xibeg+1)%sf(j, k + 3, l) & @@ -641,7 +731,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- /(12d0*(y_cb(k + 1) - y_cb(k))) else if (k == iyb + 1) then ! dxiy / dy - tensora(4)%sf(j,k,l) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + tensora(4) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - 6d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & @@ -649,7 +739,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- /(12d0*(y_cb(k) - y_cb(k - 1))) else if (k == iye - 1) then ! dxiy / dy - tensora(4)%sf(j,k,l) = (3d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + tensora(4) = (3d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + 6d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & @@ -657,7 +747,7 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- /(12d0*(y_cb(k) - y_cb(k - 1))) else if (k == iye) then ! dxiy / dy - tensora(4)%sf(j,k,l) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + tensora(4) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + 36d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - 16d0*q_prim_vf(xibeg+1)%sf(j, k - 3, l) & @@ -665,296 +755,436 @@ subroutine s_compute_gradient_xi_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- /(12d0*(y_cb(k) - y_cb(k - 1))) else ! dxiy / dy - tensora(4)%sf(j,k,l) = ( q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + tensora(4) = ( q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - q_prim_vf(xibeg+1)%sf(j, k + 2, l)) & /(12d0*(y_cb(k) - y_cb(k - 1))) end if - end if + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = tensora(4) + tensorb(2) = -tensora(3) + tensorb(3) = -tensora(2) + tensorb(4) = tensora(1) - tensorb(4)%sf(j,k,l) = tensora(4)%sf(j,k,l) - tensorb(3)%sf(j,k,l) = tensora(3)%sf(j,k,l) - ! 3D - if (num_dims > 2) then - ! using results from upper if statement to map form 2x2 to 3x3 tensor - tensora(5)%sf(j,k,l) = tensorb(4)%sf(j,k,l) - tensora(4)%sf(j,k,l) = tensorb(3)%sf(j,k,l) + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1)*tensora(4) - tensora(2)*tensora(3) - if(l == izb) then - ! dxix / dz - tensora(3)%sf(j,k,l) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - - 36d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & - + 16d0*q_prim_vf(xibeg)%sf(j, k , l + 3) & - - 3d0*q_prim_vf(xibeg)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == izb + 1) then - ! dxix / dz - tensora(3)%sf(j,k,l) = (-3d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - - 6d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & - + q_prim_vf(xibeg)%sf(j, k , l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize - 1) then - ! dxix / dz - tensora(3)%sf(j,k,l) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - - q_prim_vf(xibeg)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize) then - ! dxix / dz - tensora(3)%sf(j,k,l) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxix / dz - tensora(3)%sf(j,k,l) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - - q_prim_vf(xibeg)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do + ! STEP 3: computing F tranpose F + tensorb(1) = tensora(1)**2 + tensorb(1) = tensorb(1) + tensora(3)**2 + tensorb(2) = tensora(1)*tensora(2) + tensora(3)*tensora(4) + tensorb(3) = tensorb(2) + tensorb(4) = tensora(2)**2 + tensora(4)**2 - if(l == izb) then - ! dxiy / dz - tensora(6)%sf(j,k,l) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - - 36d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & - + 16d0*q_prim_vf(xibeg+1)%sf(j, k , l + 3) & - - 3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == izb + 1) then - ! dxiy / dz - tensora(6)%sf(j,k,l) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - - 6d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & - + q_prim_vf(xibeg+1)%sf(j, k , l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize - 1) then - ! dxiy / dz - tensora(6)%sf(j,k,l) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - q_prim_vf(xibeg+1)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize) then - ! dxiy / dz - tensora(6)%sf(j,k,l) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxiy / dz - tensora(6)%sf(j,k,l) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if + ! STEP 4: store the determinant of F in the last entry of the tensor - if(j == ixb) then + end subroutine s_compute_gradient_xi2d_acc + + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- + izb, ize, j, k, l, tensora, tensorb) + !$acc routine seq + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb + integer, intent(IN) :: ixb, ixe, iyb, iye, izb, ize + integer, intent(IN) :: j, k, l + + integer :: i + + ! STEP 1: computing the grad_xi tensor + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz + + ! 1D + if(j == ixb) then + ! dxix/dx + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l) ) & + /(12d0*(x_cb(j+1) - x_cb(j))) + ! dxiy / dx + tensora(2) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg+1)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg+1)%sf(j + 4, k, l) ) & + /(12d0*(x_cb(j + 1) - x_cb(j))) ! dxiz / dx - tensora(7)%sf(j,k,l) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(7) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l) ) & /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == ixb + 1) then + + else if (j == ixb + 1) then + ! dxix/dx + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + q_prim_vf(xibeg)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (-3d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & + + q_prim_vf(xibeg+1)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) ! dxiz / dx - tensora(7)%sf(j,k,l) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + tensora(7) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + q_prim_vf(xiend)%sf(j + 3, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe - 1) then + + else if (j == ixe - 1) then + ! dxix/dx + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - q_prim_vf(xibeg)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (3d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + - q_prim_vf(xibeg+1)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) ! dxiz / dx - tensora(7)%sf(j,k,l) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + tensora(7) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - q_prim_vf(xiend)%sf(j - 3, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe) then + else if (j == ixe) then + ! dxix/dx + tensora(1) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l) ) & + /(12d0*(x_cb(j) - x_cb(j-1))) + ! dxiy / dx + tensora(2) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg+1)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg+1)%sf(j - 4, k, l) ) & + /(12d0*(x_cb(j) - x_cb(j - 1))) ! dxiz / dx - tensora(7)%sf(j,k,l) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(7) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l) ) & /(12d0*(x_cb(j) - x_cb(j - 1))) - else + else + ! dxix/dx + tensora(1) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = ( q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg+1)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) ! dxiz / dx - tensora(7)%sf(j,k,l) = ( q_prim_vf(xiend)%sf(j - 2, k, l) & + tensora(7) = ( q_prim_vf(xiend)%sf(j - 2, k, l) & - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - q_prim_vf(xiend)%sf(j + 2, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) - end if + end if + + ! 2D if(k == iyb) then + ! dxix / dy + tensora(4) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l) ) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + ! dxiy / dy + tensora(5) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg+1)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg+1)%sf(j, k + 4, l) ) & + /(12d0*(y_cb(k + 1) - y_cb(k))) ! dxiz / dy - tensora(8)%sf(j,k,l) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(8) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l) ) & /(12d0*(y_cb(k + 1) - y_cb(k))) + else if (k == iyb + 1) then + ! dxix / dy + tensora(4) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + q_prim_vf(xibeg)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & + + q_prim_vf(xibeg+1)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) ! dxiz / dy - tensora(8)%sf(j,k,l) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + tensora(8) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + q_prim_vf(xiend)%sf(j, k + 3, l)) & /(12d0*(y_cb(k) - y_cb(k - 1))) else if (k == iye - 1) then + ! dxix / dy + tensora(4) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - q_prim_vf(xibeg)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (3d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + - q_prim_vf(xibeg+1)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) ! dxiz / dy - tensora(8)%sf(j,k,l) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + tensora(8) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - q_prim_vf(xiend)%sf(j, k - 3, l)) & /(12d0*(y_cb(k) - y_cb(k - 1))) else if (k == iye) then + ! dxix / dy + tensora(4) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l) ) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg+1)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg+1)%sf(j, k - 4, l) ) & + /(12d0*(y_cb(k) - y_cb(k - 1))) ! dxiz / dy - tensora(8)%sf(j,k,l) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(8) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l) ) & /(12d0*(y_cb(k) - y_cb(k - 1))) else + ! dxix / dy + tensora(4) = ( q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = ( q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg+1)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) ! dxiz / dy - tensora(8)%sf(j,k,l) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & + tensora(8) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - q_prim_vf(xiend)%sf(j, k + 2, l)) & /(12d0*(y_cb(k) - y_cb(k - 1))) end if + ! 3D if(l == izb) then + ! dxix / dz + tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + - 36d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & + + 16d0*q_prim_vf(xibeg)%sf(j, k , l + 3) & + - 3d0*q_prim_vf(xibeg)%sf(j, k , l + 4) ) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiy / dz + tensora(6) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + - 36d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & + + 16d0*q_prim_vf(xibeg+1)%sf(j, k , l + 3) & + - 3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 4) ) & + /(12d0*(z_cb(l + 1) - z_cb(l))) ! dxiz / dz - tensora(9)%sf(j,k,l) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + 48d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - 36d0*q_prim_vf(xiend)%sf(j, k , l + 2) & + 16d0*q_prim_vf(xiend)%sf(j, k , l + 3) & - 3d0*q_prim_vf(xiend)%sf(j, k , l + 4) ) & /(12d0*(z_cb(l + 1) - z_cb(l))) else if (l == izb + 1) then + ! dxix / dz + tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + - 6d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & + + q_prim_vf(xibeg)%sf(j, k , l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + - 6d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & + + q_prim_vf(xibeg+1)%sf(j, k , l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) ! dxiz / dz - tensora(9)%sf(j,k,l) = (-3d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + 18d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - 6d0*q_prim_vf(xiend)%sf(j, k , l + 2) & + q_prim_vf(xiend)%sf(j, k , l + 3)) & /(12d0*(z_cb(l) - z_cb(l - 1))) else if (l == ize - 1) then + ! dxix / dz + tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & + - q_prim_vf(xibeg)%sf(j, k , l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - q_prim_vf(xibeg+1)%sf(j, k , l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) ! dxiz / dz - tensora(9)%sf(j,k,l) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - 18d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - q_prim_vf(xiend)%sf(j, k , l - 3)) & /(12d0*(z_cb(l) - z_cb(l - 1))) else if (l == ize) then + ! dxix / dz + tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(l) - z_cb(l - 1))) ! dxiz / dz - tensora(9)%sf(j,k,l) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(9) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - 48d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + 36d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - 16d0*q_prim_vf(xiend)%sf(j, k , l - 3) & + 3d0*q_prim_vf(xiend)%sf(j, k , l - 4) ) & /(12d0*(z_cb(l) - z_cb(l - 1))) else + ! dxix / dz + tensora(3) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + - q_prim_vf(xibeg)%sf(j, k , l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) ! dxiz / dz - tensora(9)%sf(j,k,l) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & + tensora(9) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & - 8d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + 8d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - q_prim_vf(xiend)%sf(j, k , l + 2)) & /(12d0*(z_cb(l) - z_cb(l - 1))) end if - end if ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - if (num_dims == 1) then - tensorb(1)%sf(j,k,l) = 1d0 - elseif (num_dims == 2) then - tensorb(1)%sf(j,k,l) = tensora(4)%sf(j,k,l) - tensorb(2)%sf(j,k,l) = -tensora(3)%sf(j,k,l) - tensorb(3)%sf(j,k,l) = -tensora(2)%sf(j,k,l) - tensorb(4)%sf(j,k,l) = tensora(1)%sf(j,k,l) - elseif (num_dims == 3) then - tensorb(1)%sf(j,k,l) = tensora(5)%sf(j,k,l)*tensora(9)%sf(j,k,l) - tensora(6)%sf(j,k,l)*tensora(8)%sf(j,k,l) - tensorb(2)%sf(j,k,l) = -(tensora(2)%sf(j,k,l)*tensora(9)%sf(j,k,l) - tensora(3)%sf(j,k,l)*tensora(8)%sf(j,k,l)) - tensorb(3)%sf(j,k,l) = tensora(2)%sf(j,k,l)*tensora(6)%sf(j,k,l) - tensora(3)%sf(j,k,l)*tensora(5)%sf(j,k,l) - tensorb(4)%sf(j,k,l) = -(tensora(4)%sf(j,k,l)*tensora(9)%sf(j,k,l) - tensora(6)%sf(j,k,l)*tensora(7)%sf(j,k,l)) - tensorb(5)%sf(j,k,l) = tensora(1)%sf(j,k,l)*tensora(9)%sf(j,k,l) - tensora(3)%sf(j,k,l)*tensora(7)%sf(j,k,l) - tensorb(6)%sf(j,k,l) = -(tensora(1)%sf(j,k,l)*tensora(6)%sf(j,k,l) - tensora(4)%sf(j,k,l)*tensora(3)%sf(j,k,l)) - tensorb(7)%sf(j,k,l) = tensora(4)%sf(j,k,l)*tensora(8)%sf(j,k,l) - tensora(5)%sf(j,k,l)*tensora(7)%sf(j,k,l) - tensorb(8)%sf(j,k,l) = -(tensora(1)%sf(j,k,l)*tensora(8)%sf(j,k,l) - tensora(2)%sf(j,k,l)*tensora(7)%sf(j,k,l)) - tensorb(9)%sf(j,k,l) = tensora(1)%sf(j,k,l)*tensora(5)%sf(j,k,l) - tensora(2)%sf(j,k,l)*tensora(4)%sf(j,k,l) - end if + tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) + tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) + tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) + tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) + tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) + tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) + tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) + tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) + tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) ! STEP 2b: computing the determinant of the grad_xi tensor - if (num_dims == 1) then - tensorb(tensor_size)%sf(j,k,l) = tensora(1)%sf(j,k,l) - elseif (num_dims == 2) then - tensorb(tensor_size)%sf(j,k,l) = tensora(1)%sf(j,k,l)*tensora(4)%sf(j,k,l) - tensora(2)%sf(j,k,l)*tensora(3)%sf(j,k,l) - else - tensorb(tensor_size)%sf(j,k,l) = tensora(1)%sf(j,k,l)*(tensora(5)%sf(j,k,l)*tensora(9)%sf(j,k,l) & - - tensora(6)%sf(j,k,l)*tensora(8)%sf(j,k,l)) & - - tensora(2)%sf(j,k,l)*(tensora(4)%sf(j,k,l)*tensora(9)%sf(j,k,l) & - - tensora(6)%sf(j,k,l)*tensora(7)%sf(j,k,l)) & - + tensora(3)%sf(j,k,l)*(tensora(4)%sf(j,k,l)*tensora(8)%sf(j,k,l) & - - tensora(5)%sf(j,k,l)*tensora(7)%sf(j,k,l)) - end if + tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) ! STEP 2c: computing the inverse of grad_xi tensor = F ! tensorb is the adjoint, tensora becomes the inverse + ! STEP 4: store the determinant of F in the last entry of the tensor !$acc loop seq do i = 1, tensor_size - 1 - tensora(i)%sf(j,k,l) = tensorb(i)%sf(j,k,l)/tensorb(tensor_size)%sf(j,k,l) + tensora(i) = tensorb(i)/tensorb(tensor_size) end do ! STEP 3: computing F tranpose F - tensorb(1)%sf(j,k,l) = tensora(1)%sf(j,k,l)**2 - if (num_dims == 2) then - tensorb(1)%sf(j,k,l) = tensorb(1)%sf(j,k,l) + tensora(3)%sf(j,k,l)**2 - tensorb(2)%sf(j,k,l) = tensora(1)%sf(j,k,l)*tensora(2)%sf(j,k,l) + tensora(3)%sf(j,k,l)*tensora(4)%sf(j,k,l) - tensorb(3)%sf(j,k,l) = tensorb(2)%sf(j,k,l) - tensorb(4)%sf(j,k,l) = tensora(2)%sf(j,k,l)**2 + tensora(4)%sf(j,k,l)**2 - elseif (num_dims == 3) then - tensorb(1)%sf(j,k,l) = tensorb(1)%sf(j,k,l) + tensora(4)%sf(j,k,l)**2 + tensora(7)%sf(j,k,l)**2 - tensorb(5)%sf(j,k,l) = tensora(2)%sf(j,k,l) + tensora(5)%sf(j,k,l)**2 + tensora(8)%sf(j,k,l)**2 - tensorb(9)%sf(j,k,l) = tensora(3)%sf(j,k,l) + tensora(6)%sf(j,k,l)**2 + tensora(9)%sf(j,k,l)**2 - tensorb(2)%sf(j,k,l) = tensora(1)%sf(j,k,l)*tensora(2)%sf(j,k,l) + tensora(4)%sf(j,k,l)*tensora(5)%sf(j,k,l) & - + tensora(7)%sf(j,k,l)*tensora(8)%sf(j,k,l) - tensorb(3)%sf(j,k,l) = tensora(1)%sf(j,k,l)*tensora(3)%sf(j,k,l) + tensora(4)%sf(j,k,l)*tensora(6)%sf(j,k,l) & - + tensora(7)%sf(j,k,l)*tensora(9)%sf(j,k,l) - tensorb(6)%sf(j,k,l) = tensora(2)%sf(j,k,l)*tensora(3)%sf(j,k,l) + tensora(5)%sf(j,k,l)*tensora(6)%sf(j,k,l) & - + tensora(8)%sf(j,k,l)*tensora(9)%sf(j,k,l) - tensorb(4)%sf(j,k,l) = tensorb(2)%sf(j,k,l) - tensorb(7)%sf(j,k,l) = tensorb(3)%sf(j,k,l) - tensorb(8)%sf(j,k,l) = tensorb(4)%sf(j,k,l) - end if - ! STEP 4: store the determinant of F in the last entry of the tensor - !tensorb(tensor_size)%sf(j,k,l) = determinant + tensorb(1) = tensora(1)**2 + tensorb(1) = tensorb(1) + tensora(4)**2 + tensora(7)**2 + tensorb(5) = tensora(2) + tensora(5)**2 + tensora(8)**2 + tensorb(9) = tensora(3) + tensora(6)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(2) + tensora(4)*tensora(5) + tensora(7)*tensora(8) + tensorb(3) = tensora(1)*tensora(3) + tensora(4)*tensora(6) + tensora(7)*tensora(9) + tensorb(6) = tensora(2)*tensora(3) + tensora(5)*tensora(6) + tensora(8)*tensora(9) + tensorb(4) = tensorb(2) + tensorb(7) = tensorb(3) + tensorb(8) = tensorb(4) - end subroutine s_compute_gradient_xi_acc + end subroutine s_compute_gradient_xi3d_acc !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. From 2cd933573f17ba975b7f28c9433c271329f6051d Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 26 May 2024 23:57:18 -0500 Subject: [PATCH 125/380] testing a switch of the order of operations --- src/common/m_xi_tensor_calc.f90 | 219 ++++++++++++++++---------------- 1 file changed, 110 insertions(+), 109 deletions(-) diff --git a/src/common/m_xi_tensor_calc.f90 b/src/common/m_xi_tensor_calc.f90 index 757d7a1c39..5de30bd62f 100644 --- a/src/common/m_xi_tensor_calc.f90 +++ b/src/common/m_xi_tensor_calc.f90 @@ -926,6 +926,116 @@ subroutine s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !------- end if + ! 3D + if(l == izb) then + ! dxix / dz + tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 48d0*q_prim_vf(xibeg)%sf(j,k,l+1) & + - 36d0*q_prim_vf(xibeg)%sf(j,k,l+2) & + + 16d0*q_prim_vf(xibeg)%sf(j,k,l+3) & + - 3d0*q_prim_vf(xibeg)%sf(j,k,l+4) ) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiy / dz + tensora(6) = (-25d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j,k,l+1) & + - 36d0*q_prim_vf(xibeg+1)%sf(j,k,l+2) & + + 16d0*q_prim_vf(xibeg+1)%sf(j,k,l+3) & + - 3d0*q_prim_vf(xibeg+1)%sf(j,k,l+4) ) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiz / dz + tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j,k, l) & + + 48d0*q_prim_vf(xiend)%sf(j,k,l + 1) & + - 36d0*q_prim_vf(xiend)%sf(j,k,l + 2) & + + 16d0*q_prim_vf(xiend)%sf(j,k,l + 3) & + - 3d0*q_prim_vf(xiend)%sf(j,k,l + 4) ) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == izb + 1) then + ! dxix / dz + tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j,k,l - 1) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j,k,l + 1) & + - 6d0*q_prim_vf(xibeg)%sf(j,k,l + 2) & + + q_prim_vf(xibeg)%sf(j,k,l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = (-3d0*q_prim_vf(xibeg+1)%sf(j,k,l - 1) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j,k,l + 1) & + - 6d0*q_prim_vf(xibeg+1)%sf(j,k,l + 2) & + + q_prim_vf(xibeg+1)%sf(j,k,l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j,k,l - 1) & + - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + + 18d0*q_prim_vf(xiend)%sf(j,k,l + 1) & + - 6d0*q_prim_vf(xiend)%sf(j,k,l + 2) & + + q_prim_vf(xiend)%sf(j,k,l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ize - 1) then + ! dxix / dz + tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & + - q_prim_vf(xibeg)%sf(j, k , l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - q_prim_vf(xibeg+1)%sf(j, k , l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xiend)%sf(j,k,l) & + - 18d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & + - q_prim_vf(xiend)%sf(j, k , l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ize) then + ! dxix / dz + tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xiend)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xiend)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xiend)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxix / dz + tensora(3) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + - q_prim_vf(xibeg)%sf(j, k , l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + - q_prim_vf(xiend)%sf(j, k , l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if + ! 2D if(k == iyb) then ! dxix / dy @@ -1037,115 +1147,6 @@ subroutine s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !------- /(12d0*(y_cb(k) - y_cb(k - 1))) end if - ! 3D - if(l == izb) then - ! dxix / dz - tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - - 36d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & - + 16d0*q_prim_vf(xibeg)%sf(j, k , l + 3) & - - 3d0*q_prim_vf(xibeg)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiy / dz - tensora(6) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - - 36d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & - + 16d0*q_prim_vf(xibeg+1)%sf(j, k , l + 3) & - - 3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiz / dz - tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - - 36d0*q_prim_vf(xiend)%sf(j, k , l + 2) & - + 16d0*q_prim_vf(xiend)%sf(j, k , l + 3) & - - 3d0*q_prim_vf(xiend)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == izb + 1) then - ! dxix / dz - tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - - 6d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & - + q_prim_vf(xibeg)%sf(j, k , l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - - 6d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & - + q_prim_vf(xibeg+1)%sf(j, k , l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - - 10d0*q_prim_vf(xiend)%sf(j,k,l) & - + 18d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - - 6d0*q_prim_vf(xiend)%sf(j, k , l + 2) & - + q_prim_vf(xiend)%sf(j, k , l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize - 1) then - ! dxix / dz - tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - - q_prim_vf(xibeg)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - q_prim_vf(xibeg+1)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - - 18d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - - q_prim_vf(xiend)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize) then - ! dxix / dz - tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xiend)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xiend)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxix / dz - tensora(3) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - - q_prim_vf(xibeg)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - - q_prim_vf(xiend)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) From 6780bc5b8974321f57ed100b7ab74f556e23685d Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 27 May 2024 00:38:07 -0500 Subject: [PATCH 126/380] returned to the previous version, checking if the issue is with tensora(3) only --- src/common/m_xi_tensor_calc.f90 | 221 ++++++++++++++++---------------- 1 file changed, 111 insertions(+), 110 deletions(-) diff --git a/src/common/m_xi_tensor_calc.f90 b/src/common/m_xi_tensor_calc.f90 index 5de30bd62f..33396e58fd 100644 --- a/src/common/m_xi_tensor_calc.f90 +++ b/src/common/m_xi_tensor_calc.f90 @@ -926,116 +926,6 @@ subroutine s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !------- end if - ! 3D - if(l == izb) then - ! dxix / dz - tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 48d0*q_prim_vf(xibeg)%sf(j,k,l+1) & - - 36d0*q_prim_vf(xibeg)%sf(j,k,l+2) & - + 16d0*q_prim_vf(xibeg)%sf(j,k,l+3) & - - 3d0*q_prim_vf(xibeg)%sf(j,k,l+4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiy / dz - tensora(6) = (-25d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j,k,l+1) & - - 36d0*q_prim_vf(xibeg+1)%sf(j,k,l+2) & - + 16d0*q_prim_vf(xibeg+1)%sf(j,k,l+3) & - - 3d0*q_prim_vf(xibeg+1)%sf(j,k,l+4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiz / dz - tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j,k, l) & - + 48d0*q_prim_vf(xiend)%sf(j,k,l + 1) & - - 36d0*q_prim_vf(xiend)%sf(j,k,l + 2) & - + 16d0*q_prim_vf(xiend)%sf(j,k,l + 3) & - - 3d0*q_prim_vf(xiend)%sf(j,k,l + 4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == izb + 1) then - ! dxix / dz - tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j,k,l - 1) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j,k,l + 1) & - - 6d0*q_prim_vf(xibeg)%sf(j,k,l + 2) & - + q_prim_vf(xibeg)%sf(j,k,l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = (-3d0*q_prim_vf(xibeg+1)%sf(j,k,l - 1) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j,k,l + 1) & - - 6d0*q_prim_vf(xibeg+1)%sf(j,k,l + 2) & - + q_prim_vf(xibeg+1)%sf(j,k,l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j,k,l - 1) & - - 10d0*q_prim_vf(xiend)%sf(j,k,l) & - + 18d0*q_prim_vf(xiend)%sf(j,k,l + 1) & - - 6d0*q_prim_vf(xiend)%sf(j,k,l + 2) & - + q_prim_vf(xiend)%sf(j,k,l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize - 1) then - ! dxix / dz - tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - - q_prim_vf(xibeg)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - q_prim_vf(xibeg+1)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - - 18d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - - q_prim_vf(xiend)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize) then - ! dxix / dz - tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xiend)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xiend)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxix / dz - tensora(3) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - - q_prim_vf(xibeg)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - - q_prim_vf(xiend)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - ! 2D if(k == iyb) then ! dxix / dy @@ -1147,6 +1037,117 @@ subroutine s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !------- /(12d0*(y_cb(k) - y_cb(k - 1))) end if + ! 3D + if(l == izb) then + ! dxix / dz + tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 48d0*q_prim_vf(xibeg)%sf(j,k,l+1) & + - 36d0*q_prim_vf(xibeg)%sf(j,k,l+2) & + + 16d0*q_prim_vf(xibeg)%sf(j,k,l+3) & + - 3d0*q_prim_vf(xibeg)%sf(j,k,l+4) ) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiy / dz + tensora(6) = (-25d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j,k,l+1) & + - 36d0*q_prim_vf(xibeg+1)%sf(j,k,l+2) & + + 16d0*q_prim_vf(xibeg+1)%sf(j,k,l+3) & + - 3d0*q_prim_vf(xibeg+1)%sf(j,k,l+4) ) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiz / dz + tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j,k, l) & + + 48d0*q_prim_vf(xiend)%sf(j,k,l + 1) & + - 36d0*q_prim_vf(xiend)%sf(j,k,l + 2) & + + 16d0*q_prim_vf(xiend)%sf(j,k,l + 3) & + - 3d0*q_prim_vf(xiend)%sf(j,k,l + 4) ) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == izb + 1) then + ! dxix / dz + tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j,k,l - 1) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j,k,l + 1) & + - 6d0*q_prim_vf(xibeg)%sf(j,k,l + 2) & + + q_prim_vf(xibeg)%sf(j,k,l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = (-3d0*q_prim_vf(xibeg+1)%sf(j,k,l - 1) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j,k,l + 1) & + - 6d0*q_prim_vf(xibeg+1)%sf(j,k,l + 2) & + + q_prim_vf(xibeg+1)%sf(j,k,l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j,k,l - 1) & + - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + + 18d0*q_prim_vf(xiend)%sf(j,k,l + 1) & + - 6d0*q_prim_vf(xiend)%sf(j,k,l + 2) & + + q_prim_vf(xiend)%sf(j,k,l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ize - 1) then + ! dxix / dz + tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & + - q_prim_vf(xibeg)%sf(j, k , l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - q_prim_vf(xibeg+1)%sf(j, k , l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xiend)%sf(j,k,l) & + - 18d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & + - q_prim_vf(xiend)%sf(j, k , l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ize) then + ! dxix / dz + tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xiend)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xiend)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xiend)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxix / dz + tensora(3) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + - q_prim_vf(xibeg)%sf(j, k , l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + - q_prim_vf(xiend)%sf(j, k , l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if + + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) From 290e2dd5b8b0779d2f6a1ce6d7eca39109085b2a Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 27 May 2024 06:59:19 -0500 Subject: [PATCH 127/380] trying to debugging the segfault issue --- src/common/m_xi_tensor_calc.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/common/m_xi_tensor_calc.f90 b/src/common/m_xi_tensor_calc.f90 index 33396e58fd..da3738cc34 100644 --- a/src/common/m_xi_tensor_calc.f90 +++ b/src/common/m_xi_tensor_calc.f90 @@ -802,7 +802,9 @@ subroutine s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !------- type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb - integer, intent(IN) :: ixb, ixe, iyb, iye, izb, ize + integer, intent(IN) :: ixb, ixe + integer, intent(IN) :: iyb, iye + integer, intent(IN) :: izb, ize integer, intent(IN) :: j, k, l integer :: i From cab36b691f6a97c2989d2e9879e14b3f45091391 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 27 May 2024 07:27:10 -0500 Subject: [PATCH 128/380] hard fix, code compiles and runs, had to copy the code over to the m_variables conversion directly, the implicit variables does not work well for functions. It might be possible to move the btensor calculation out of m_variables_conversion, test this after CAV --- src/common/m_variables_conversion.fpp | 401 +++++++++++++++++++++++++- 1 file changed, 391 insertions(+), 10 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 4821586976..e30b8c038e 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1468,7 +1468,7 @@ contains type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf type(scalar_field), dimension(b_size), intent(OUT) :: btensor real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb - integer :: j, k, l + integer :: j, k, l, i if (num_dims == 1) then !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) @@ -1507,17 +1507,398 @@ contains do l = izb, ize do k = iyb, iye do j = ixb, ixe - call s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, & - iye, izb, ize, j, k, l, tensora, tensorb) + + ! STEP 1: computing the grad_xi tensor + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz + + ! 1D + if(j == ixb) then + ! dxix/dx + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l) ) & + /(12d0*(x_cb(j+1) - x_cb(j))) + ! dxiy / dx + tensora(2) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg+1)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg+1)%sf(j + 4, k, l) ) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + ! dxiz / dx + tensora(7) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l) ) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + + else if (j == ixb + 1) then + ! dxix/dx + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + q_prim_vf(xibeg)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (-3d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & + + q_prim_vf(xibeg+1)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(7) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + q_prim_vf(xiend)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + + else if (j == ixe - 1) then + ! dxix/dx + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - q_prim_vf(xibeg)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (3d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + - q_prim_vf(xibeg+1)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(7) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xiend)%sf(j,k,l) & + - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - q_prim_vf(xiend)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe) then + ! dxix/dx + tensora(1) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l) ) & + /(12d0*(x_cb(j) - x_cb(j-1))) + ! dxiy / dx + tensora(2) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg+1)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg+1)%sf(j - 4, k, l) ) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(7) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l) ) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxix/dx + tensora(1) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = ( q_prim_vf(xibeg+1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg+1)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(7) = ( q_prim_vf(xiend)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - q_prim_vf(xiend)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + + end if + + ! 2D + if(k == iyb) then + ! dxix / dy + tensora(4) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l) ) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + ! dxiy / dy + tensora(5) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg+1)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg+1)%sf(j, k + 4, l) ) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + ! dxiz / dy + tensora(8) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l) ) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + + else if (k == iyb + 1) then + ! dxix / dy + tensora(4) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + q_prim_vf(xibeg)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & + + q_prim_vf(xibeg+1)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(8) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + q_prim_vf(xiend)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye - 1) then + ! dxix / dy + tensora(4) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - q_prim_vf(xibeg)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (3d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + - q_prim_vf(xibeg+1)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(8) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xiend)%sf(j,k,l) & + - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - q_prim_vf(xiend)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye) then + ! dxix / dy + tensora(4) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l) ) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg+1)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg+1)%sf(j, k - 4, l) ) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(8) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l) ) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxix / dy + tensora(4) = ( q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = ( q_prim_vf(xibeg+1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg+1)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(8) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - q_prim_vf(xiend)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + ! 3D + if(l == izb) then + ! dxix / dz + tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 48d0*q_prim_vf(xibeg)%sf(j,k,l+1) & + - 36d0*q_prim_vf(xibeg)%sf(j,k,l+2) & + + 16d0*q_prim_vf(xibeg)%sf(j,k,l+3) & + - 3d0*q_prim_vf(xibeg)%sf(j,k,l+4) ) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiy / dz + tensora(6) = (-25d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 48d0*q_prim_vf(xibeg+1)%sf(j,k,l+1) & + - 36d0*q_prim_vf(xibeg+1)%sf(j,k,l+2) & + + 16d0*q_prim_vf(xibeg+1)%sf(j,k,l+3) & + - 3d0*q_prim_vf(xibeg+1)%sf(j,k,l+4) ) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiz / dz + tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j,k, l) & + + 48d0*q_prim_vf(xiend)%sf(j,k,l + 1) & + - 36d0*q_prim_vf(xiend)%sf(j,k,l + 2) & + + 16d0*q_prim_vf(xiend)%sf(j,k,l + 3) & + - 3d0*q_prim_vf(xiend)%sf(j,k,l + 4) ) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == izb + 1) then + ! dxix / dz + tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j,k,l - 1) & + - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg)%sf(j,k,l + 1) & + - 6d0*q_prim_vf(xibeg)%sf(j,k,l + 2) & + + q_prim_vf(xibeg)%sf(j,k,l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = (-3d0*q_prim_vf(xibeg+1)%sf(j,k,l - 1) & + - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + + 18d0*q_prim_vf(xibeg+1)%sf(j,k,l + 1) & + - 6d0*q_prim_vf(xibeg+1)%sf(j,k,l + 2) & + + q_prim_vf(xibeg+1)%sf(j,k,l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j,k,l - 1) & + - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + + 18d0*q_prim_vf(xiend)%sf(j,k,l + 1) & + - 6d0*q_prim_vf(xiend)%sf(j,k,l + 2) & + + q_prim_vf(xiend)%sf(j,k,l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ize - 1) then + ! dxix / dz + tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & + - q_prim_vf(xibeg)%sf(j, k , l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - q_prim_vf(xibeg+1)%sf(j, k , l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + + 10d0*q_prim_vf(xiend)%sf(j,k,l) & + - 18d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & + - q_prim_vf(xiend)%sf(j, k , l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ize) then + ! dxix / dz + tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 36d0*q_prim_vf(xiend)%sf(j, k , l - 2) & + - 16d0*q_prim_vf(xiend)%sf(j, k , l - 3) & + + 3d0*q_prim_vf(xiend)%sf(j, k , l - 4) ) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxix / dz + tensora(3) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + - q_prim_vf(xibeg)%sf(j, k , l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & + - 8d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + + 8d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + - q_prim_vf(xiend)%sf(j, k , l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if + + + + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) + tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) + tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) + tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) + tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) + tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) + tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) + tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) + tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) + + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse + ! STEP 4: store the determinant of F in the last entry of the tensor + + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do + + ! STEP 3: computing F tranpose F + tensorb(1) = tensora(1)**2 + tensorb(1) = tensorb(1) + tensora(4)**2 + tensora(7)**2 + tensorb(5) = tensora(2) + tensora(5)**2 + tensora(8)**2 + tensorb(9) = tensora(3) + tensora(6)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(2) + tensora(4)*tensora(5) + tensora(7)*tensora(8) + tensorb(3) = tensora(1)*tensora(3) + tensora(4)*tensora(6) + tensora(7)*tensora(9) + tensorb(6) = tensora(2)*tensora(3) + tensora(5)*tensora(6) + tensora(8)*tensora(9) + tensorb(4) = tensorb(2) + tensorb(7) = tensorb(3) + tensorb(8) = tensorb(4) + + + !call s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, & + !iye, izb, ize, j, k, l, tensora, tensorb) !! 1: 1D, 3: 2D, 6: 3D - !btensor(1)%sf(j, k, l) = tensorb(1) - !btensor(2)%sf(j,k,l) = tensorb(2) - !btensor(3)%sf(j,k,l) = tensorb(3) - !btensor(4)%sf(j,k,l) = tensorb(5) - !btensor(5)%sf(j,k,l) = tensorb(6) - !btensor(6)%sf(j,k,l) = tensorb(9) + btensor(1)%sf(j, k, l) = tensorb(1) + btensor(2)%sf(j,k,l) = tensorb(2) + btensor(3)%sf(j,k,l) = tensorb(3) + btensor(4)%sf(j,k,l) = tensorb(5) + btensor(5)%sf(j,k,l) = tensorb(6) + btensor(6)%sf(j,k,l) = tensorb(9) !! store the determinant at the last entry of the btensor sf - !btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) + btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) end do end do end do From 048e1a3983a33f19c9f06ca0a571e2781ae786d4 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 27 May 2024 20:16:20 -0500 Subject: [PATCH 129/380] updated the q_prim_vf across the files to also contain the elastic energy for the Riemann solver, checking compilation and runs --- src/common/m_variables_conversion.fpp | 38 ++++++++--------- src/post_process/m_global_parameters.fpp | 3 +- src/post_process/m_start_up.f90 | 15 ++++++- src/pre_process/m_global_parameters.fpp | 3 +- src/simulation/m_global_parameters.fpp | 5 ++- src/simulation/m_hyperelastic.f90 | 52 +++++++++++++----------- src/simulation/m_rhs.fpp | 12 +++--- src/simulation/m_time_steppers.fpp | 4 +- 8 files changed, 74 insertions(+), 58 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index e30b8c038e..e950ddb9ee 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1055,28 +1055,27 @@ contains ! s_calculate_btensor has its own triple nested for loop with openacc #ifdef MFC_SIMULATION if (hyperelasticity) then - print *, 'I got here A1' - call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf) - !!!$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) - !do l = izb, ize - ! do k = iyb, iye - ! do j = ixb, ixe - ! !$acc loop seq - ! do i = 1, num_fluids - ! alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) - ! alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) - ! end do + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe + !$acc loop seq + do i = 1, num_fluids + alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) + alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) + end do ! If in simulation, use acc mixture subroutines - !call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & - ! alpha_rho_K, Re_K, j, k, l, G_K, Gs) - !qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - ! G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K - ! end do - ! end do - !end do - !!!$acc end parallel loop + call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & + alpha_rho_K, Re_K, j, k, l, G_K, Gs) + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K + end do + end do + end do + !$acc end parallel loop + end if #else if (hyperelasticity) then @@ -1098,7 +1097,6 @@ contains end do end if #endif - print *, 'I got here A2' end subroutine s_convert_conservative_to_primitive_variables ! --------- diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 22a63c647c..8eac201623 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -492,7 +492,8 @@ contains ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - sys_size = stress_idx%end + num_dims + ! adding three more equations for the \xi field and the elastic energy + sys_size = stress_idx%end + num_dims + 1 ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 tensor_size = num_dims**2 + 1 diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 6753d35e24..39b70f3ff5 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -322,9 +322,20 @@ subroutine s_save_data(t_step, varname, pres, c, H) -offset_x%beg:m + offset_x%end, & -offset_y%beg:n + offset_y%end, & -offset_z%beg:p + offset_z%end) - if (hypoelasticity) then write (varname, '(A,I0)') 'tau', i - else + end if + call s_write_variable_to_formatted_database_file(varname, t_step) + end if + varname(:) = ' ' + end do + end if + if (hyperelasticity) then + do i = 1, xiend - xibeg + 1 + if (prim_vars_wrt) then + q_sf = q_prim_vf(i - 1 + xibeg)%sf( & + -offset_x%beg:m + offset_x%end, & + -offset_y%beg:n + offset_y%end, & + -offset_z%beg:p + offset_z%end) write (varname, '(A,I0)') 'xi', i end if call s_write_variable_to_formatted_database_file(varname, t_step) diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 15ba45a4ec..461853d65d 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -599,7 +599,8 @@ contains ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - sys_size = stress_idx%end + num_dims + ! adding three more equations for the \xi field and the elastic energy + sys_size = stress_idx%end + num_dims + 1 ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 tensor_size = num_dims**2 + 1 diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 0780989e38..9291a13bc9 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -792,10 +792,11 @@ contains ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - ! adding three more equations for the \xi field - sys_size = stress_idx%end + num_dims + ! adding three more equations for the \xi field and the elastic energy + sys_size = stress_idx%end + num_dims + 1 ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 + ! storing the jacobian in the last entry tensor_size = num_dims**2 + 1 end if diff --git a/src/simulation/m_hyperelastic.f90 b/src/simulation/m_hyperelastic.f90 index 45c3b16bd7..d7b23fab3f 100644 --- a/src/simulation/m_hyperelastic.f90 +++ b/src/simulation/m_hyperelastic.f90 @@ -32,42 +32,48 @@ subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, ix, iy, iz) type(int_bounds_info), intent(IN) :: ix, iy, iz real(kind(0d0)), dimension(b_size-1) :: tensor - real(kind(0d0)) :: trace + real(kind(0d0)) :: trace, invariant integer :: i, j, k, l !< Generic loop iterators - !$acc parallel loop collapse(3) gang vector default(present) private(trace, tensor) + !$acc parallel loop collapse(3) gang vector default(present) private(trace, tensor,invariant) do l = iz%beg, iz%end do k = iy%beg, iy%end do j = ix%beg, ix%end - ! tensor is the symmetric tensor - - !$acc loop seq - do i = 1, b_size - 1 - tensor(i) = btensor(i)%sf(j, k, l) - end do - ! calculate the trace of the tensor - trace = tensor(1) - if (num_dims == 2) then - trace = trace + tensor(3) - else - trace = trace + tensor(4) + tensor(6) - end if + ! tensor is the symmetric tensor & calculate the trace of the tensor + trace = btensor(1)%sf(j,k,l) + !if (num_dims == 2) then + ! trace = trace + btensor(3)%sf(j,k,l) + !else + trace = trace + btensor(4)%sf(j,k,l) + btensor(6)%sf(j,k,l) + !end if ! calculate the deviatoric of the tensor - tensor(1) = tensor(1) - (1d0/3d0)*trace - if (num_dims == 2) then - tensor(3) = tensor(3) - (1d0/3d0)*trace - else - tensor(4) = tensor(4) - (1d0/3d0)*trace - tensor(6) = tensor(6) - (1d0/3d0)*trace - end if + btensor(1)%sf(j,k,l) = btensor(1)%sf(j,k,l) - (1d0/3d0)*trace + !if (num_dims == 2) then + ! btensor(3)%sf(j,k,l) = btensor(3)%sf(j,k,l) - (1d0/3d0)*trace + !else + btensor(4)%sf(j,k,l) = btensor(4)%sf(j,k,l) - (1d0/3d0)*trace + btensor(6)%sf(j,k,l) = btensor(6)%sf(j,k,l) - (1d0/3d0)*trace + !end if ! dividing by the jacobian for neo-Hookean model ! setting the tensor to the stresses for riemann solver !$acc loop seq do i = 1, b_size - 1 - q_prim_vf(strxb+i)%sf(j, k, l) = tensor(i)/btensor(b_size)%sf(j, k, l) + q_prim_vf(strxb+i)%sf(j, k, l) = btensor(i)%sf(j,k,l)/btensor(b_size)%sf(j, k, l) end do + ! invariant calculation, saving it in the q_prim_vf field + + invariant1 = btensor(1)%sf(j, k, l) + !if (num_dims == 2) then + ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) + !elseif (num_dims == 3) then + invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + !end if + + ! compute the invariant without the elastic modulus + q_prim_vf(xiend+1)%sf(j,k,l) = 0.5d0*(invariant1 - 3.0d0)/btensor(b_size)%sf(j, k, l) + end do end do end do diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 475c3ec1c7..33131a2cf5 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -723,8 +723,6 @@ contains end do end if - !if(proc_rank == 0) print *, 'I got here 1 !' - call nvtxStartRange("RHS-CONVERT") call s_convert_conservative_to_primitive_variables( & q_cons_qp%vf, & @@ -736,11 +734,11 @@ contains if(proc_rank == 0) print *, 'I got here 2 !' - !call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") - ! if ( hyperelasticity ) then - ! !call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) - ! end if - !call nvtxEndRange + call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") + if ( hyperelasticity ) then + call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) + end if + call nvtxEndRange if(proc_rank == 0) print *, 'I got here 3.1 !' diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 1a3e852087..d98fdb5b56 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -195,7 +195,7 @@ contains iz_t%beg:iz_t%end)) @:ACC_SETUP_SFs(q_prim_vf(i)) end do - do i = xibeg, xiend + do i = xibeg, xiend + 1 @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & iy_t%beg:iy_t%end, & iz_t%beg:iz_t%end)) @@ -1010,7 +1010,7 @@ contains do i = stress_idx%beg, stress_idx%end @:DEALLOCATE(q_prim_vf(i)%sf) end do - do i = xibeg, xiend + do i = xibeg, xiend + 1 @:DEALLOCATE(q_prim_vf(i)%sf) end do end if From 43db37810277e1fb9aae9dfb6c3c1bc3058c3ae0 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 27 May 2024 23:29:27 -0500 Subject: [PATCH 130/380] full code compiles, not yet tested for riemann solver --- src/post_process/m_start_up.f90 | 2 - src/simulation/m_global_parameters.fpp | 4 +- src/simulation/m_hyperelastic.f90 | 5 +- src/simulation/m_riemann_solvers.fpp | 96 +++++++++++++------------- 4 files changed, 51 insertions(+), 56 deletions(-) diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 39b70f3ff5..480f25cc94 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -323,7 +323,6 @@ subroutine s_save_data(t_step, varname, pres, c, H) -offset_y%beg:n + offset_y%end, & -offset_z%beg:p + offset_z%end) write (varname, '(A,I0)') 'tau', i - end if call s_write_variable_to_formatted_database_file(varname, t_step) end if varname(:) = ' ' @@ -337,7 +336,6 @@ subroutine s_save_data(t_step, varname, pres, c, H) -offset_y%beg:n + offset_y%end, & -offset_z%beg:p + offset_z%end) write (varname, '(A,I0)') 'xi', i - end if call s_write_variable_to_formatted_database_file(varname, t_step) end if varname(:) = ' ' diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 9291a13bc9..170c6db61e 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -792,12 +792,12 @@ contains ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - ! adding three more equations for the \xi field and the elastic energy - sys_size = stress_idx%end + num_dims + 1 ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 ! storing the jacobian in the last entry tensor_size = num_dims**2 + 1 + ! adding three more equations for the \xi field and the elastic energy + sys_size = stress_idx%end + num_dims + 1 end if else if (model_eqns == 3) then diff --git a/src/simulation/m_hyperelastic.f90 b/src/simulation/m_hyperelastic.f90 index d7b23fab3f..d6a83ac27f 100644 --- a/src/simulation/m_hyperelastic.f90 +++ b/src/simulation/m_hyperelastic.f90 @@ -32,10 +32,10 @@ subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, ix, iy, iz) type(int_bounds_info), intent(IN) :: ix, iy, iz real(kind(0d0)), dimension(b_size-1) :: tensor - real(kind(0d0)) :: trace, invariant + real(kind(0d0)) :: trace, invariant1 integer :: i, j, k, l !< Generic loop iterators - !$acc parallel loop collapse(3) gang vector default(present) private(trace, tensor,invariant) + !$acc parallel loop collapse(3) gang vector default(present) private(trace,invariant1) do l = iz%beg, iz%end do k = iy%beg, iy%end do j = ix%beg, ix%end @@ -63,7 +63,6 @@ subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, ix, iy, iz) end do ! invariant calculation, saving it in the q_prim_vf field - invariant1 = btensor(1)%sf(j, k, l) !if (num_dims == 2) then ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 6c16ee06ed..3c5304b0cb 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -311,7 +311,7 @@ contains real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R real(kind(0d0)) :: G_L, G_R real(kind(0d0)), dimension(2) :: Re_L, Re_R - real(kind(0d0)), dimension(num_dims) :: xi_field_L, xi_field_R + real(kind(0d0)), dimension(3) :: xi_field_L, xi_field_R real(kind(0d0)) :: rho_avg real(kind(0d0)), dimension(num_dims) :: vel_avg @@ -356,7 +356,7 @@ contains if (norm_dir == ${NORM_DIR}$) then !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, & - !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, xi_field_R, xi_field_L) + !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, xi_field_L, xi_field_R) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -505,39 +505,38 @@ contains end do end if - !if (.not. hyperelasticity) then - ! G_L = 0d0 - ! G_R = 0d0 - ! - ! !$acc loop seq - ! do i = 1, num_fluids - ! G_L = G_L + alpha_L(i)*Gs(i) - ! G_R = G_R + alpha_R(i)*Gs(i) - ! end do - - ! !$acc loop seq - ! do i = 1, strxe - strxb + 1 - ! tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - ! tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) - ! end do - - !!!!$acc loop seq - !do i = 1, num_dims - ! xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) - ! xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) - !end do - - ! !$acc loop seq - ! do i = 1, strxe - strxb + 1 - ! Elastic contribution to energy if G large enough - ! TODO MRJ ADD THE ELASTIC ENERGY - ! if ((G_L > 1d0) .and. (G_R > 1d0)) then - ! E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) - ! E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) - ! end if - ! end do + if (hyperelasticity) then + G_L = 0d0 + G_R = 0d0 + + !$acc loop seq + do i = 1, num_fluids + G_L = G_L + alpha_L(i)*Gs(i) + G_R = G_R + alpha_R(i)*Gs(i) + end do + + !$acc loop seq + do i = 1, strxe - strxb + 1 + tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + end do + + !$acc loop seq + do i = 1, num_dims + xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) + xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) + end do + + do i = 1, strxe - strxb + 1 + ! Elastic contribution to energy if G large enough + ! TODO MRJ ADD THE ELASTIC ENERGY + if ((G_L > 1d0) .and. (G_R > 1d0)) then + E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) + E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) + end if + end do - !end if + end if @:compute_average_state() @@ -561,7 +560,7 @@ contains end if if (wave_speeds == 1) then - if (hypoelasticity ) then ! .or. .not. hyperelasticity) then + if (hypoelasticity .or. hyperelasticity) then s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & (((4d0*G_L)/3d0) + & tau_e_L(dir_idx_tau(1)))/rho_L) & @@ -642,7 +641,7 @@ contains - rho_R*vel_R(dir_idx(i)))) & /(s_M - s_P) end do - else if (hypoelasticity) then ! .or. .not. hyperelasticity) then + else if (hypoelasticity .or. hyperelasticity) then !$acc loop seq do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & @@ -681,7 +680,7 @@ contains - s_P*vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) & + s_M*s_P*(E_L - E_R)) & /(s_M - s_P) - else if (hypoelasticity) then ! .or. .not. hyperelasticity) then + else if (hypoelasticity .or. hyperelasticity) then !TODO: simplify this so it's not split into 3 if (num_dims == 1) then flux_rs${XYZ}$_vf(j, k, l, E_idx) = & @@ -750,17 +749,16 @@ contains end do ! Xi field - !if (hyperelasticity) then - !!!!$acc loop seq - ! do i = 1, num_dims - !flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & - ! (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & - ! - s_P*rho_L*vel_L(dir_idx(1))*xi_field_L(i) & - ! + s_M*s_P*(rho_L*xi_field_L(i) & - ! - rho_R*xi_field_R(i))) & - ! /(s_M - s_P) - ! end do - !end if + if (hyperelasticity) then + do i = 1, num_dims + flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & + (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & + - s_P*rho_L*vel_L(dir_idx(1))*xi_field_L(i) & + + s_M*s_P*(rho_L*xi_field_L(i) & + - rho_R*xi_field_R(i))) & + /(s_M - s_P) + end do + end if ! Div(U)? !$acc loop seq @@ -2533,7 +2531,7 @@ contains !$acc update device(is1, is2, is3) - if (hypoelasticity) then ! .or. .not. hyperelasticity) then + if (hypoelasticity .or. hyperelasticity) then if (norm_dir == 1) then dir_idx_tau = (/1, 2, 4/) else if (norm_dir == 2) then From 56f6b181f71df03d10a8df7cc4b52ba9bd7b39a3 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 28 May 2024 00:17:56 -0500 Subject: [PATCH 131/380] still debugging Riemann solvers, almost done! --- src/simulation/m_riemann_solvers.fpp | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 3c5304b0cb..29cde3dfa8 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -641,7 +641,7 @@ contains - rho_R*vel_R(dir_idx(i)))) & /(s_M - s_P) end do - else if (hypoelasticity .or. hyperelasticity) then + else if (hypoelasticity) then !$acc loop seq do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & @@ -657,6 +657,22 @@ contains - rho_R*vel_R(dir_idx(i)))) & /(s_M - s_P) end do + else if (hyperelasticity) then + !!!$acc loop seq + do i = 1, num_dims + flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & + (s_M*(rho_R*vel_R(dir_idx(1)) & + *vel_R(dir_idx(i)) & + + dir_flg(dir_idx(i))*pres_R & + - tau_e_R(dir_idx_tau(i))) & + - s_P*(rho_L*vel_L(dir_idx(1)) & + *vel_L(dir_idx(i)) & + + dir_flg(dir_idx(i))*pres_L & + - tau_e_L(dir_idx_tau(i))) & + + s_M*s_P*(rho_L*vel_L(dir_idx(i)) & + - rho_R*vel_R(dir_idx(i)))) & + /(s_M - s_P) + end do else !$acc loop seq do i = 1, num_dims @@ -680,7 +696,7 @@ contains - s_P*vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) & + s_M*s_P*(E_L - E_R)) & /(s_M - s_P) - else if (hypoelasticity .or. hyperelasticity) then + else if (hypoelasticity) then! .or. hyperelasticity) then !TODO: simplify this so it's not split into 3 if (num_dims == 1) then flux_rs${XYZ}$_vf(j, k, l, E_idx) = & From 6a176e2bc5436546ce1c8300e457459986874a9e Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Tue, 28 May 2024 10:06:06 -0500 Subject: [PATCH 132/380] CAV_2024 Remillard, post_processing is outputting correct energy and interface data and if running at a reasonable speed --- src/post_process/m_data_output.fpp | 103 ++++++++++++++--------------- src/post_process/m_start_up.f90 | 25 ++++--- 2 files changed, 64 insertions(+), 64 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 4c9926e54a..68e5d9d659 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -979,26 +979,25 @@ contains end subroutine s_write_variable_to_formatted_database_file ! ----------- - subroutine s_write_intf_data_file(q_prim_vf, t_step) + subroutine s_write_intf_data_file(q_prim_vf) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - integer, intent(IN) :: t_step integer :: i, j, k, l, w, cent !< Generic loop iterators integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations real(kind(0d0)), dimension(num_fluids) :: alpha, vol_fluid, xcom, ycom, zcom real(kind=8), parameter :: pi = 4.d0*datan(1.d0) real(kind(0d0)), allocatable :: x_td(:), y_td(:), x_d1(:), y_d1(:), y_d(:), x_d(:) - real(kind(0d0)) :: axp, axm, ayp, aym, azm, azp, tgp, euc_d, maxalph_loc, maxalph_glb, thres + real(kind(0d0)) :: axp, axm, ayp, aym, azm, azp, tgp, euc_d, thres, maxalph_loc, maxalph_glb allocate (x_d1(m*n)) allocate (y_d1(m*n)) counter = 0 - maxalph_loc = 0d0 + maxalph_loc = 0d0 do k = 0, p do j = 0, n - do i = 0, m - if (q_prim_vf(E_idx + 2)%sf(i, j, k) > maxalph_loc) then - maxalph_loc = q_prim_vf(E_idx + 2)%sf(i, j, k) + do i = 0, m + if (q_prim_vf(E_idx + 2)%sf(i, j, k) > maxalph_loc) then + maxalph_loc = q_prim_vf(E_idx + 2)%sf(i, j, k) end if end do end do @@ -1006,42 +1005,42 @@ contains call s_mpi_allreduce_max(maxalph_loc, maxalph_glb) do l = 0, p - if (z_cc(l) < dz(l) .and. z_cc(l) >= 0) then + if (z_cc(l) .lt. dz(l) .and. z_cc(l) .gt. 0) then cent = l end if end do - thres = 0.6d0*maxalph_glb + thres = 0.9d0 do k = 0, n OLoop: do j = 0, m axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) - axm = q_prim_vf(E_idx + 2)%sf(j - 1, k, cent) + axm = q_prim_vf(E_idx + 2)%sf(j, k, cent) ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, cent) - aym = q_prim_vf(E_idx + 2)%sf(j, k - 1, cent) - - if ((axp > thres .and. axm < thres) .or. (axp < thres .and. axm > thres) & - .or. (ayp > thres .and. aym < thres) .or. (ayp < thres .and. aym > thres)) then + aym = q_prim_vf(E_idx + 2)%sf(j, k, cent) + if ((axp .gt. thres .and. axm .lt. thres) .or. (axp .lt. thres .and. axm .gt. thres) & + .or. (ayp .gt. thres .and. aym .lt. thres) .or. (ayp .lt. thres .and. aym .gt. thres)) then if (counter == 0) then counter = counter + 1 x_d1(counter) = x_cc(j) y_d1(counter) = y_cc(k) - euc_d = sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2) - tgp = sqrt(dx(j)**2 + dy(k)**2) else + euc_d = dsqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2) + tgp = dsqrt(dx(j)**2 + dy(k)**2) do i = 1, counter - if (euc_d <= tgp .or. x_cc(j) == x_d1(i) .or. y_cc(k) == y_d1(i)) then + if (euc_d .lt. tgp) then cycle OLoop - elseif (euc_d > tgp .and. i == counter .and. x_cc(j) < 1.5 .and. y_cc(k) < 1.5) then - !artificial bounding on the interface for bubble at a centroid. - !need to remove eventually. + elseif (euc_d .gt. tgp .and. i == counter) then counter = counter + 1 x_d1(counter) = x_cc(j) y_d1(counter) = y_cc(k) + end if end do end if end if end do OLoop end do + + allocate (y_d(counter)) allocate (x_d(counter)) do i = 1, counter @@ -1049,7 +1048,7 @@ contains x_d(i) = x_d1(i) end do root = 0 - ! if (num_procs > 1) then + call s_mpi_gather_data(x_d, counter, x_td, root) call s_mpi_gather_data(y_d, counter, y_td, root) if (proc_rank == 0) then @@ -1062,29 +1061,34 @@ contains x_td(i), y_td(i), 0d0 end if end do - end if + end if + + end subroutine s_write_intf_data_file ! ----------------------------------- - subroutine s_write_energy_data_file(q_prim_vf, t_step) - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - integer, intent(IN) :: t_step - real(kind(0d0)) :: Elk, Egk, Elint, Egint, Vb, Vl, pres_av - real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, MaxMa, MaxMa_glb, maxvel, c, Ma, H + subroutine s_write_energy_data_file(q_prim_vf, q_cons_vf) + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf, q_cons_vf + real(kind(0d0)) :: Elk, Egk, Elp, Egint, Vb, Vl, pres_av, Et + real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, MaxMa, MaxMa_glb, maxvel, c, Ma, H real(kind(0d0)), dimension(num_dims) :: vel real(kind(0d0)), dimension(num_fluids) :: gammas, pi_infs, adv integer :: i, j, k, l, s !looping indicies integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations Egk = 0d0 - Elint = 0d0 + Elp = 0d0 Egint = 0d0 Vb = 0d0 maxvel = 0d0 MaxMa = 0d0 Vl = 0d0 Elk = 0d0 - if (p > 0) then + Et = 0d0 + Vb = 0d0 + dV = 0d0 + pres_av = 0d0 + pres = 0d0 do k = 0, p do j = 0, n do i = 0, m @@ -1094,18 +1098,18 @@ contains gamma = 0d0 pi_inf = 0d0 pres = q_prim_vf(E_idx)%sf(i, j, k) - Egint = Egint + q_prim_vf(E_idx+2)%sf(i, j, k)*(fluid_pp(2)%gamma*pres)*dV + Egint = Egint + q_prim_vf(E_idx + 2)%sf(i, j, k)*(fluid_pp(2)%gamma*pres)*dV do s = 1, num_dims vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) Egk = Egk + 0.5d0*q_prim_vf(E_idx + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV Elk = Elk + 0.5d0*q_prim_vf(E_idx + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV - if (dabs(vel(s)) .gt. maxvel) then + if (dabs(vel(s)) > maxvel) then maxvel = dabs(vel(s)) - endif + end if end do do l = 1, adv_idx%end - E_idx adv(l) = q_prim_vf(E_idx + l)%sf(i, j, k) - gamma = gamma+ adv(l)*fluid_pp(l)%gamma + gamma = gamma + adv(l)*fluid_pp(l)%gamma pi_inf = pi_inf + adv(l)*fluid_pp(l)%pi_inf rho = rho + adv(l)*q_prim_vf(l)%sf(i, j, k) end do @@ -1117,16 +1121,17 @@ contains H, adv, 0d0, c) Ma = maxvel/c - if (Ma > MaxMa .and. adv(1) > 1.0d0-1.0d-6) then - MaxMa = Ma - endif + if (Ma > MaxMa .and. adv(1) > 1.0d0 - 1.0d-10) then + MaxMa = Ma + end if Vl = Vl + adv(1)*dV Vb = Vb + adv(2)*dV pres_av = pres_av + adv(1)*pres*dV + Et = Et + q_cons_vf(E_idx)%sf(i, j, k)*dV end do end do end do - end if + tmp = pres_av call s_mpi_allreduce_sum(tmp, pres_av) tmp = Vl @@ -1141,15 +1146,17 @@ contains call s_mpi_allreduce_sum(tmp, Egk) tmp = Vb call s_mpi_allreduce_sum(tmp, Vb) + tmp = Et + call s_mpi_allreduce_sum(tmp, Et) - Elint = pres_av/Vl*Vb - + Elp = pres_av/Vl*Vb if (proc_rank == 0) then - write (251, '(6X, 7F24.12)') & - Elint, & + write (251, '(10X, 8F24.8)') & + Elp, & Egint, & Elk, & Egk, & + Et, & Vb, & Vl, & MaxMa_glb @@ -1186,26 +1193,12 @@ contains subroutine s_close_intf_data_file() ! ----------------------- - ! Writing the footer of and closing the run-time information file - write (211, '(A)') '----------------------------------------'// & - '----------------------------------------' - write (211, '(A)') '' - write (211, '(A)') '' - write (211, '(A)') '========================================'// & - '========================================' close (211) end subroutine s_close_intf_data_file !--------------------- subroutine s_close_energy_data_file() ! ----------------------- - ! Writing the footer of and closing the run-time information file - write (251, '(A)') '----------------------------------------'// & - '----------------------------------------' - write (251, '(A)') '' - write (251, '(A)') '' - write (251, '(A)') '========================================'// & - '========================================' close (251) end subroutine s_close_energy_data_file !--------------------- diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index a801fa50f3..e7b7813aa9 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -179,8 +179,8 @@ subroutine s_save_data(t_step, varname, pres, c, H) end if if (sim_data) then - call s_write_intf_data_file(q_prim_vf, t_step) - call s_write_energy_data_file(q_prim_vf, t_step) + call s_write_intf_data_file(q_prim_vf) + call s_write_energy_data_file(q_prim_vf, q_cons_vf) end if ! Adding the grid to the formatted database file @@ -600,10 +600,17 @@ subroutine s_save_data(t_step, varname, pres, c, H) end if end if - if (proc_rank == 0 .and. sim_data) then - close (211) - close (251) +! if (proc_rank == 0 .and. sim_data) then +! close (211) +! close (251) +! end if + + if (sim_data .and. proc_rank == 0) then + call s_close_intf_data_file() + call s_close_energy_data_file() end if + + ! Closing the formatted database file call s_close_formatted_database_file() @@ -662,10 +669,10 @@ subroutine s_finalize_modules() ! Disassociate pointers for serial and parallel I/O s_read_data_files => null() - if (sim_data .and. proc_rank == 0) then - call s_close_intf_data_file() - call s_close_energy_data_file() - end if +! if (sim_data .and. proc_rank == 0) then +! call s_close_intf_data_file() +! call s_close_energy_data_file() +! end if ! Deallocation procedures for the modules call s_finalize_data_output_module() From 450dcf5467d696a5f6383f74e472b52589869def Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 28 May 2024 20:37:13 -0500 Subject: [PATCH 133/380] riemann solvers almost fully debugged --- src/simulation/m_global_parameters.fpp | 4 ++++ src/simulation/m_riemann_solvers.fpp | 26 +++++--------------------- 2 files changed, 9 insertions(+), 21 deletions(-) diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 170c6db61e..26409d64ba 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -138,6 +138,7 @@ module m_global_parameters logical :: mixture_err !< Mixture properties correction logical :: hypoelasticity !< hypoelasticity modeling logical :: hyperelasticity !< hyperelasticity modeling + logical :: elasticity !< elasticity modeling logical :: cu_tensor integer :: cpu_start, cpu_end, cpu_rate @@ -494,6 +495,7 @@ contains ptgalpha_eps = dflt_real hypoelasticity = .false. hyperelasticity = .false. + elasticity = .false. weno_flat = .true. riemann_flat = .true. cu_mpi = .false. @@ -782,6 +784,7 @@ contains end if if ( hypoelasticity ) then + elasticity = .true. stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D @@ -789,6 +792,7 @@ contains end if if ( hyperelasticity ) then + elasticity = .true. ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 29cde3dfa8..3e7ea29859 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -560,7 +560,7 @@ contains end if if (wave_speeds == 1) then - if (hypoelasticity .or. hyperelasticity) then + if ( elasticity ) then s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & (((4d0*G_L)/3d0) + & tau_e_L(dir_idx_tau(1)))/rho_L) & @@ -641,7 +641,7 @@ contains - rho_R*vel_R(dir_idx(i)))) & /(s_M - s_P) end do - else if (hypoelasticity) then + else if ( elasticity ) then !$acc loop seq do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & @@ -657,22 +657,6 @@ contains - rho_R*vel_R(dir_idx(i)))) & /(s_M - s_P) end do - else if (hyperelasticity) then - !!!$acc loop seq - do i = 1, num_dims - flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & - (s_M*(rho_R*vel_R(dir_idx(1)) & - *vel_R(dir_idx(i)) & - + dir_flg(dir_idx(i))*pres_R & - - tau_e_R(dir_idx_tau(i))) & - - s_P*(rho_L*vel_L(dir_idx(1)) & - *vel_L(dir_idx(i)) & - + dir_flg(dir_idx(i))*pres_L & - - tau_e_L(dir_idx_tau(i))) & - + s_M*s_P*(rho_L*vel_L(dir_idx(i)) & - - rho_R*vel_R(dir_idx(i)))) & - /(s_M - s_P) - end do else !$acc loop seq do i = 1, num_dims @@ -696,7 +680,7 @@ contains - s_P*vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) & + s_M*s_P*(E_L - E_R)) & /(s_M - s_P) - else if (hypoelasticity) then! .or. hyperelasticity) then + else if ( elasticity ) then ! .or. hyperelasticity) then !TODO: simplify this so it's not split into 3 if (num_dims == 1) then flux_rs${XYZ}$_vf(j, k, l, E_idx) = & @@ -738,7 +722,7 @@ contains end if ! Elastic Stresses - if (hypoelasticity) then + if ( hypoelasticity ) then do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & (s_M*(rho_R*vel_R(dir_idx(1)) & @@ -765,7 +749,7 @@ contains end do ! Xi field - if (hyperelasticity) then + if ( hyperelasticity ) then do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & From 61dd23db3f53f74f6cf1e62633909416369b0eb8 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 28 May 2024 21:41:19 -0500 Subject: [PATCH 134/380] preliminary hyperelastic works, removing got here statements --- src/simulation/m_riemann_solvers.fpp | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 3e7ea29859..fd90fdf9c5 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -474,6 +474,7 @@ contains H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R + ! elastic energy update if (hypoelasticity) then !$acc loop seq do i = 1, strxe - strxb + 1 @@ -505,6 +506,7 @@ contains end do end if + ! elastic energy update if (hyperelasticity) then G_L = 0d0 G_R = 0d0 @@ -527,14 +529,11 @@ contains xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) end do - do i = 1, strxe - strxb + 1 - ! Elastic contribution to energy if G large enough - ! TODO MRJ ADD THE ELASTIC ENERGY - if ((G_L > 1d0) .and. (G_R > 1d0)) then - E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) - E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) - end if - end do + ! Elastic contribution to energy if G large enough + if ((G_L > 1d0) .and. (G_R > 1d0)) then + E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) + E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) + end if end if @@ -680,7 +679,7 @@ contains - s_P*vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) & + s_M*s_P*(E_L - E_R)) & /(s_M - s_P) - else if ( elasticity ) then ! .or. hyperelasticity) then + else if ( elasticity ) then !TODO: simplify this so it's not split into 3 if (num_dims == 1) then flux_rs${XYZ}$_vf(j, k, l, E_idx) = & From 899d9e929a5399aa8830c57f73ab7606155ea562 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 28 May 2024 21:45:49 -0500 Subject: [PATCH 135/380] hyperelastic clean up of print flags, rechecking full code segments --- src/post_process/m_start_up.f90 | 5 +---- src/simulation/m_rhs.fpp | 14 -------------- 2 files changed, 1 insertion(+), 18 deletions(-) diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 480f25cc94..9f967b114a 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -157,10 +157,8 @@ subroutine s_perform_time_step(t_step) if (buff_size > 0) then call s_populate_conservative_variables_buffer_regions() end if - !if (proc_rank == 0) print *, "I got here 1" ! Converting the conservative variables to the primitive ones call s_convert_conservative_to_primitive_variables(q_cons_vf, q_prim_vf) - !if (proc_rank == 0) print *, "I got here 2" end subroutine s_perform_time_step @@ -313,7 +311,6 @@ subroutine s_save_data(t_step, varname, pres, c, H) end if ! ---------------------------------------------------------------------- - !if (proc_rank == 0) print *, "I got here 3" ! Adding the elastic shear stresses to the formatted database file ----- if (hypoelasticity .or. hyperelasticity) then do i = 1, stress_idx%end - stress_idx%beg + 1 @@ -341,7 +338,7 @@ subroutine s_save_data(t_step, varname, pres, c, H) varname(:) = ' ' end do end if - !if (proc_rank == 0) print *, "I got here 4" + ! ---------------------------------------------------------------------- ! Adding the pressure to the formatted database file ------------------- diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 33131a2cf5..7fb58adc8c 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -732,22 +732,16 @@ contains q_btensor%vf) call nvtxEndRange - if(proc_rank == 0) print *, 'I got here 2 !' - call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") if ( hyperelasticity ) then call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) end if call nvtxEndRange - if(proc_rank == 0) print *, 'I got here 3.1 !' - call nvtxStartRange("RHS-MPI") call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) call nvtxEndRange - if(proc_rank == 0) print *, 'I got here 3.2 !' - if (t_step == t_step_stop) return ! ================================================================== @@ -867,7 +861,6 @@ contains end if ix%end = m; iy%end = n; iz%end = p ! =============================================================== - if(proc_rank == 0) print *, 'I got here A4.0 !' ! Computing Riemann Solver Flux and Source Flux ================= call nvtxStartRange("RHS_riemann_solver") @@ -888,8 +881,6 @@ contains id, ix, iy, iz) call nvtxEndRange - if(proc_rank == 0) print *, 'I got here A4.1 !' - ! =============================================================== ! Additional physics and source terms ============================== @@ -910,8 +901,6 @@ contains rhs_vf) call nvtxEndRange - if(proc_rank == 0) print *, 'I got here A4.3 !' - ! RHS additions for viscosity call nvtxStartRange("RHS_viscous") if (any(Re_size > 0d0)) call s_compute_viscous_rhs(id, & @@ -946,8 +935,6 @@ contains end do - if(proc_rank == 0) print *, 'I got here A4.4 !' - if (ib) then !$acc parallel loop collapse(3) gang vector default(present) do l = 0, p @@ -1007,7 +994,6 @@ contains end if ! ================================================================== - if(proc_rank == 0) print *, 'I got here A4.5 !' end subroutine s_compute_rhs ! ----------------------------------------- From 57b03381839732ded4927624d054eee085564f33 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 29 May 2024 23:38:13 -0500 Subject: [PATCH 136/380] full code compiles but errors arise with simulation --- src/common/m_variables_conversion.fpp | 44 +++++--- src/common/m_xi_tensor_calc.f90 | 133 ++++++++++++----------- src/post_process/m_global_parameters.fpp | 1 + src/post_process/m_start_up.f90 | 31 +++--- src/post_process/p_main.fpp | 1 + src/simulation/m_riemann_solvers.fpp | 3 +- 6 files changed, 116 insertions(+), 97 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index e950ddb9ee..75eb80a6c6 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -895,6 +895,10 @@ contains real(kind(0.d0)) :: ntmp +#ifdef MFC_POST_PROCESS + type(scalar_field), dimension(b_size) :: q_btensor +#endif + #:if MFC_CASE_OPTIMIZATION #ifndef MFC_SIMULATION if (bubbles) then @@ -1034,12 +1038,12 @@ contains end do end if - !if ( hyperelasticity ) then - ! !$acc loop seq - ! do i = xibeg, xiend - ! qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) / rho_K - ! end do - !end if + if ( hyperelasticity ) then + !$acc loop seq + do i = xibeg, xiend + qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) / rho_K + end do + end if !$acc loop seq do i = advxb, advxe @@ -1077,9 +1081,15 @@ contains !$acc end parallel loop end if -#else +#endif + +#ifdef MFC_POST_PROCESS + do l = 1, b_size + allocate(q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) + end do + if (hyperelasticity) then - call s_calculate_btensor(qK_prim_vf, qK_btensor_vf) + call s_calculate_btensor(qK_prim_vf, q_btensor,0,m,0,n,0,p) do l = izb, ize do k = iyb, iye do j = ixb, ixe @@ -1091,7 +1101,7 @@ contains call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K + G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K end do end do end do @@ -1144,7 +1154,7 @@ contains ! going through hyperelasticity again due to the btensor calculation ! s_calculate_btensor has its own triple nested for loop, with openacc if (hyperelasticity ) then - call s_calculate_btensor(q_prim_vf, q_btensor) + call s_calculate_btensor(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) end if ! Converting the primitive variables to the conservative variables @@ -1423,17 +1433,19 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_calculate_btensor(q_prim_vf, btensor) + subroutine s_calculate_btensor(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf type(scalar_field), dimension(b_size), intent(INOUT) :: btensor + integer, intent(IN) :: xb, xe, yb, ye, zb, ze real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb - integer :: j, k, l - do l = 0, p - do k = 0, n - do j = 0, m - call s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) + + do l = zb, ze + do k = yb, ye + do j = xb, xe + call s_compute_gradient_xi(q_prim_vf, xb, xe, yb, & + ye, zb, ze, j, k, l, tensora, tensorb) ! 1: 1D, 3: 2D, 6: 3D btensor(1)%sf(j, k, l) = tensorb(1) if (num_dims > 1) then ! 2D diff --git a/src/common/m_xi_tensor_calc.f90 b/src/common/m_xi_tensor_calc.f90 index da3738cc34..5ff6d4f69b 100644 --- a/src/common/m_xi_tensor_calc.f90 +++ b/src/common/m_xi_tensor_calc.f90 @@ -31,9 +31,12 @@ module m_xi_tensor_calc !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) + subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- + zb, ze, j, k, l, tensora, tensorb) + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora, tensorb + integer, intent(IN) :: xb, xe, yb, ye, zb, ze integer, intent(IN) :: j, k, l real(kind(0d0)) :: determinant @@ -43,7 +46,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - if(j == 0) then + if(j == xb) then ! dxix/dx tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & @@ -51,7 +54,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l) ) & /(12d0*(x_cb(j+1) - x_cb(j))) - else if (j == 1) then + else if (j == xb + 1) then ! dxix/dx tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & @@ -59,7 +62,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + q_prim_vf(xibeg)%sf(j + 3, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == m - 1) then + else if (j == xe - 1) then ! dxix/dx tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & @@ -67,7 +70,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - q_prim_vf(xibeg)%sf(j - 3, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == m) then + else if (j == xe) then ! dxix/dx tensora(1) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & @@ -85,7 +88,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) end if if (num_dims > 1) then - if(j == 0) then + if(j == xb) then ! dxiy / dx tensora(2) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & @@ -93,7 +96,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) + 16d0*q_prim_vf(xibeg+1)%sf(j + 3, k, l) & - 3d0*q_prim_vf(xibeg+1)%sf(j + 4, k, l) ) & /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == 1) then + else if (j == xb + 1) then ! dxiy / dx tensora(2) = (-3d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & @@ -101,7 +104,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) - 6d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & + q_prim_vf(xibeg+1)%sf(j + 3, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == m - 1) then + else if (j == xe - 1) then ! dxiy / dx tensora(2) = (3d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & @@ -109,7 +112,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) + 6d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - q_prim_vf(xibeg+1)%sf(j - 3, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == m) then + else if (j == xe) then ! dxiy / dx tensora(2) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & @@ -126,48 +129,48 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) /(12d0*(x_cb(j) - x_cb(j - 1))) end if - if(k == 0) then + if(k == yb) then ! dxix / dy tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k+1) - y_cb(k))) - else if (k == 1) then + /(12d0*(y_cb(k + 1) - y_cb(k))) + else if (k == yb + 1) then ! dxix / dy tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + q_prim_vf(xibeg)%sf(j, k + 3, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) - else if (k == n - 1) then + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye - 1) then ! dxix / dy tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - q_prim_vf(xibeg)%sf(j, k - 3, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) - else if (k == n) then + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye) then ! dxix / dy tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(j) - y_cb(j-1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) else ! dxix / dy tensora(3) = ( q_prim_vf(xibeg)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) end if - if(k == 0) then + if(k == yb) then ! dxiy / dy tensora(4) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & @@ -175,37 +178,37 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) + 16d0*q_prim_vf(xibeg+1)%sf(j, k + 3, l) & - 3d0*q_prim_vf(xibeg+1)%sf(j, k + 4, l) ) & /(12d0*(y_cb(k+1) - y_cb(k))) - else if (k == 1) then + else if (k == yb + 1) then ! dxiy / dy tensora(4) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - 6d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & + q_prim_vf(xibeg+1)%sf(j, k + 3, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) - else if (k == n - 1) then + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye - 1) then ! dxiy / dy tensora(4) = (3d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + 6d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - q_prim_vf(xibeg+1)%sf(j, k - 3, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) - else if (k == n) then + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye) then ! dxiy / dy tensora(4) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + 36d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - 16d0*q_prim_vf(xibeg+1)%sf(j, k - 3, l) & + 3d0*q_prim_vf(xibeg+1)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(j) - y_cb(j-1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) else ! dxiy / dy tensora(4) = ( q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - q_prim_vf(xibeg+1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) end if end if @@ -216,89 +219,89 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) tensora(5) = tensora(4) tensora(4) = tensora(3) - if(l == 0) then + if(l == zb) then ! dxix / dz tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - 36d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & + 16d0*q_prim_vf(xibeg)%sf(j, k , l + 3) & - 3d0*q_prim_vf(xibeg)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(k+1) - z_cb(k))) - else if (l == 1) then + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == zb + 1) then ! dxix / dz tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - 6d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & + q_prim_vf(xibeg)%sf(j, k , l + 3)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) - else if (l == p - 1) then + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze - 1) then ! dxix / dz tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - q_prim_vf(xibeg)%sf(j, k , l - 3)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) - else if (l == p) then + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze) then ! dxix / dz tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(j) - z_cb(j-1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) else ! dxix / dz tensora(3) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - q_prim_vf(xibeg)%sf(j, k , l + 2)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) end if - if(l == 0) then + if(l == zb) then ! dxiy / dz tensora(6) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - 36d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & + 16d0*q_prim_vf(xibeg+1)%sf(j, k , l + 3) & - 3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(k+1) - z_cb(k))) - else if (l == 1) then + /(12d0*(z_cb(l+1) - z_cb(l))) + else if (l == zb + 1) then ! dxiy / dz tensora(6) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - 6d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & + q_prim_vf(xibeg+1)%sf(j, k , l + 3)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) - else if (l == p - 1) then + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze - 1) then ! dxiy / dz tensora(6) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - q_prim_vf(xibeg+1)%sf(j, k , l - 3)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) - else if (l == p) then + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze) then ! dxiy / dz tensora(6) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & + 3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(j) - z_cb(j-1))) + /(12d0*(z_cb(l) - z_cb(l-1))) else ! dxiy / dz tensora(6) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) end if - if(j == 0) then + if(j == xb) then ! dxiz / dx tensora(7) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & @@ -306,7 +309,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l) ) & /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == 1) then + else if (j == xb + 1) then ! dxiz / dx tensora(7) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - 10d0*q_prim_vf(xiend)%sf(j,k,l) & @@ -314,7 +317,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + q_prim_vf(xiend)%sf(j + 3, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == m - 1) then + else if (j == xe - 1) then ! dxiz / dx tensora(7) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + 10d0*q_prim_vf(xiend)%sf(j,k,l) & @@ -322,7 +325,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - q_prim_vf(xiend)%sf(j - 3, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == m) then + else if (j == xe) then ! dxiz / dx tensora(7) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & @@ -339,7 +342,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) /(12d0*(x_cb(j) - x_cb(j - 1))) end if - if(k == 0) then + if(k == yb) then ! dxiz / dy tensora(8) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & @@ -347,78 +350,78 @@ subroutine s_compute_gradient_xi(q_prim_vf, j, k, l, tensora, tensorb) + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l) ) & /(12d0*(y_cb(k+1) - y_cb(k))) - else if (k == 1) then + else if (k == yb + 1) then ! dxiz / dy tensora(8) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + q_prim_vf(xiend)%sf(j, k + 3, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) - else if (k == n - 1) then + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye - 1) then ! dxiz / dy tensora(8) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - q_prim_vf(xiend)%sf(j, k - 3, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) - else if (k == n) then + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye) then ! dxiz / dy tensora(8) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(j) - y_cb(j-1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) else ! dxiz / dy tensora(8) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*(y_cb(j) - y_cb(j - 1))) + /(12d0*(y_cb(k) - y_cb(k - 1))) end if - if(l == 0) then + if(l == zb) then ! dxiz / dz tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + 48d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - 36d0*q_prim_vf(xiend)%sf(j, k , l + 2) & + 16d0*q_prim_vf(xiend)%sf(j, k , l + 3) & - 3d0*q_prim_vf(xiend)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(k+1) - z_cb(k))) - else if (l == 1) then + /(12d0*(z_cb(l+1) - z_cb(l))) + else if (l == zb + 1) then ! dxiz / dz tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + 18d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - 6d0*q_prim_vf(xiend)%sf(j, k , l + 2) & + q_prim_vf(xiend)%sf(j, k , l + 3)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) - else if (l == p - 1) then + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze - 1) then ! dxiz / dz tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - 18d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - q_prim_vf(xiend)%sf(j, k , l - 3)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) - else if (l == p) then + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze) then ! dxiz / dz tensora(9) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - 48d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + 36d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - 16d0*q_prim_vf(xiend)%sf(j, k , l - 3) & + 3d0*q_prim_vf(xiend)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(j) - z_cb(j-1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) else ! dxiz / dz tensora(9) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & - 8d0*q_prim_vf(xiend)%sf(j, k , l - 1) & + 8d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - q_prim_vf(xiend)%sf(j, k , l + 2)) & - /(12d0*(z_cb(j) - z_cb(j - 1))) + /(12d0*(z_cb(l) - z_cb(l - 1))) end if end if diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 8eac201623..1018674c6a 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -483,6 +483,7 @@ contains end if if (hypoelasticity) then + ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 sys_size = stress_idx%end diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 9f967b114a..40cd3c1e88 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -145,9 +145,9 @@ subroutine s_perform_time_step(t_step) (t_step_stop - t_step_start)/t_step_save + 1, & t_step end if - ! Populating the grid and conservative variables call s_read_data_files(t_step) + ! Populating the buffer regions of the grid variables if (buff_size > 0) then call s_populate_grid_variables_buffer_regions() @@ -157,6 +157,7 @@ subroutine s_perform_time_step(t_step) if (buff_size > 0) then call s_populate_conservative_variables_buffer_regions() end if + ! Converting the conservative variables to the primitive ones call s_convert_conservative_to_primitive_variables(q_cons_vf, q_prim_vf) @@ -312,7 +313,7 @@ subroutine s_save_data(t_step, varname, pres, c, H) end if ! ---------------------------------------------------------------------- ! Adding the elastic shear stresses to the formatted database file ----- - if (hypoelasticity .or. hyperelasticity) then + if (hypoelasticity) then ! .or. hyperelasticity) then do i = 1, stress_idx%end - stress_idx%beg + 1 if (prim_vars_wrt) then q_sf = q_prim_vf(i - 1 + stress_idx%beg)%sf( & @@ -325,19 +326,19 @@ subroutine s_save_data(t_step, varname, pres, c, H) varname(:) = ' ' end do end if - if (hyperelasticity) then - do i = 1, xiend - xibeg + 1 - if (prim_vars_wrt) then - q_sf = q_prim_vf(i - 1 + xibeg)%sf( & - -offset_x%beg:m + offset_x%end, & - -offset_y%beg:n + offset_y%end, & - -offset_z%beg:p + offset_z%end) - write (varname, '(A,I0)') 'xi', i - call s_write_variable_to_formatted_database_file(varname, t_step) - end if - varname(:) = ' ' - end do - end if + !if (hyperelasticity) then + ! do i = 1, xiend - xibeg + 1 + ! if (prim_vars_wrt) then + ! q_sf = q_prim_vf(i - 1 + xibeg)%sf( & + ! -offset_x%beg:m + offset_x%end, & + ! -offset_y%beg:n + offset_y%end, & + ! -offset_z%beg:p + offset_z%end) + ! write (varname, '(A,I0)') 'xi', i + ! call s_write_variable_to_formatted_database_file(varname, t_step) + ! end if + ! varname(:) = ' ' + ! end do + !end if ! ---------------------------------------------------------------------- diff --git a/src/post_process/p_main.fpp b/src/post_process/p_main.fpp index c780ce9ac7..ede32ed737 100644 --- a/src/post_process/p_main.fpp +++ b/src/post_process/p_main.fpp @@ -39,6 +39,7 @@ program p_main ! Time-Marching Loop ======================================================= do + call s_perform_time_step(t_step) call s_save_data(t_step, varname, pres, c, H) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index fd90fdf9c5..274457de25 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -471,6 +471,7 @@ contains E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R + ! moving this down to account for the elasticity H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -536,7 +537,7 @@ contains end if end if - + @:compute_average_state() call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & From df89bb2374a8978c217b25db6054b8c7710193d5 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 29 May 2024 23:52:21 -0500 Subject: [PATCH 137/380] added the writing for the post_process --- src/common/m_variables_conversion.fpp | 22 ++++++++++----------- src/post_process/m_start_up.f90 | 28 +++++++++++++-------------- 2 files changed, 24 insertions(+), 26 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 75eb80a6c6..8f0e58a55c 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1038,7 +1038,7 @@ contains end do end if - if ( hyperelasticity ) then + if (hyperelasticity) then !$acc loop seq do i = xibeg, xiend qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) / rho_K @@ -1059,12 +1059,11 @@ contains ! s_calculate_btensor has its own triple nested for loop with openacc #ifdef MFC_SIMULATION if (hyperelasticity) then - call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf) - - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe + call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf) + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe !$acc loop seq do i = 1, num_fluids alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) @@ -1075,11 +1074,10 @@ contains alpha_rho_K, Re_K, j, k, l, G_K, Gs) qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K - end do + end do + end do end do - end do - !$acc end parallel loop - + !$acc end parallel loop end if #endif @@ -1089,7 +1087,7 @@ contains end do if (hyperelasticity) then - call s_calculate_btensor(qK_prim_vf, q_btensor,0,m,0,n,0,p) + call s_calculate_btensor(qK_prim_vf, q_btensor, ixb, ixe, iyb, iye, izb, ize) do l = izb, ize do k = iyb, iye do j = ixb, ixe diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 40cd3c1e88..a4d7fdd24a 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -313,7 +313,7 @@ subroutine s_save_data(t_step, varname, pres, c, H) end if ! ---------------------------------------------------------------------- ! Adding the elastic shear stresses to the formatted database file ----- - if (hypoelasticity) then ! .or. hyperelasticity) then + if (hypoelasticity .or. hyperelasticity) then do i = 1, stress_idx%end - stress_idx%beg + 1 if (prim_vars_wrt) then q_sf = q_prim_vf(i - 1 + stress_idx%beg)%sf( & @@ -326,19 +326,19 @@ subroutine s_save_data(t_step, varname, pres, c, H) varname(:) = ' ' end do end if - !if (hyperelasticity) then - ! do i = 1, xiend - xibeg + 1 - ! if (prim_vars_wrt) then - ! q_sf = q_prim_vf(i - 1 + xibeg)%sf( & - ! -offset_x%beg:m + offset_x%end, & - ! -offset_y%beg:n + offset_y%end, & - ! -offset_z%beg:p + offset_z%end) - ! write (varname, '(A,I0)') 'xi', i - ! call s_write_variable_to_formatted_database_file(varname, t_step) - ! end if - ! varname(:) = ' ' - ! end do - !end if + if (hyperelasticity) then + do i = 1, xiend - xibeg + 1 + if (prim_vars_wrt) then + q_sf = q_prim_vf(i - 1 + xibeg)%sf( & + -offset_x%beg:m + offset_x%end, & + -offset_y%beg:n + offset_y%end, & + -offset_z%beg:p + offset_z%end) + write (varname, '(A,I0)') 'xi', i + call s_write_variable_to_formatted_database_file(varname, t_step) + end if + varname(:) = ' ' + end do + end if ! ---------------------------------------------------------------------- From 8e2328967f5c5e72f8fe25e6efc2e49a3bd6cd4d Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 30 May 2024 07:42:38 -0500 Subject: [PATCH 138/380] added stress to the pressure calculation in m_variables_converstion, full code compiles, testing remains --- src/common/m_variables_conversion.fpp | 4 ++-- src/simulation/m_data_output.fpp | 12 ++++++------ 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 8f0e58a55c..a7cba098f1 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -156,7 +156,7 @@ contains )**(1/gamma + 1) - pi_inf end if - if (hypoelasticity .and. present(G)) then + if ( (hypoelasticity .or. hyperelasticity) .and. present(G)) then ! calculate elastic contribution to Energy E_e = 0d0 do s = stress_idx%beg, stress_idx%end @@ -189,7 +189,7 @@ contains ! end if ! end if ! end do - + ! ! pres = ( & ! energy - & ! 0.5d0*(mom**2.d0)/rho - & diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index b7061342f8..74f3452378 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -1211,7 +1211,7 @@ contains l = 0 ! Computing/Sharing necessary state variables - if (hypoelasticity) then + if (hypoelasticity .or. hyperelasticity) then call s_convert_to_mixture_variables(q_cons_vf, j - 2, k, l, & rho, gamma, pi_inf, qv, & Re, G, fluid_pp(:)%G) @@ -1223,7 +1223,7 @@ contains vel(s) = q_cons_vf(cont_idx%end + s)%sf(j - 2, k, l)/rho end do - if (hypoelasticity) then + if (hypoelasticity .or. hyperelasticity) then call s_compute_pressure( & q_cons_vf(1)%sf(j - 2, k, l), & q_cons_vf(alf_idx)%sf(j - 2, k, l), & @@ -1243,7 +1243,7 @@ contains if (model_eqns == 4) then lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 - else if (hypoelasticity) then + else if (hypoelasticity .or. hyperelasticity) then tau_e(1) = q_cons_vf(stress_idx%end)%sf(j - 2, k, l)/rho end if @@ -1336,7 +1336,7 @@ contains if (model_eqns == 4) then lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 - else if (hypoelasticity) then + else if (hypoelasticity .or. hyperelasticity) then do s = 1, 3 tau_e(s) = q_cons_vf(s)%sf(j - 2, k - 2, l)/rho end do @@ -1437,7 +1437,7 @@ contains end if end if - if (hypoelasticity) then + if (hypoelasticity .or. hyperelasticity) then do s = 1, (num_dims*(num_dims + 1))/2 tmp = tau_e(s) call s_mpi_allreduce_sum(tmp, tau_e(s)) @@ -1530,7 +1530,7 @@ contains nRdot(1), & R(1), & Rdot(1) - else if (hypoelasticity) then + else if (hypoelasticity .or. hyperelasticity) then write (i + 30, '(6X,F12.12,F24.8,F24.8,F24.8,F24.8,'// & 'F24.8,F24.8,F24.8)') & nondim_time, & From c5fa4103f16ebc262faba627cd1020b1c224a87d Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 3 Jun 2024 10:31:28 -0500 Subject: [PATCH 139/380] resolved issues with the FFtranpose calculation and xi tensor in the variables conversion --- src/common/m_variables_conversion.fpp | 279 +++++++++++++++---------- src/common/m_xi_tensor_calc.f90 | 76 +++---- src/pre_process/m_assign_variables.f90 | 3 +- src/pre_process/m_data_output.fpp | 1 + src/simulation/m_data_output.fpp | 8 +- src/simulation/m_hyperelastic.f90 | 36 ++-- src/simulation/m_rhs.fpp | 6 +- src/simulation/m_riemann_solvers.fpp | 31 ++- src/simulation/m_start_up.fpp | 5 +- 9 files changed, 265 insertions(+), 180 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index a7cba098f1..648bc48a9e 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -157,10 +157,11 @@ contains end if if ( (hypoelasticity .or. hyperelasticity) .and. present(G)) then + !if ( hypoelasticity .and. present(G)) then ! calculate elastic contribution to Energy E_e = 0d0 do s = stress_idx%beg, stress_idx%end - if (G > 0) then + if (G > 1d-3) then E_e = E_e + ((stress/rho)**2d0)/(4d0*G) ! Additional terms in 2D and 3D if ((s == stress_idx%beg + 1) .or. & @@ -1018,7 +1019,7 @@ contains end if end if - if ( hypoelasticity .and. .not. bubbles ) then + if ( hypoelasticity ) then !$acc loop seq do i = strxb, strxe qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & @@ -1038,13 +1039,14 @@ contains end do end if - if (hyperelasticity) then - !$acc loop seq - do i = xibeg, xiend - qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) / rho_K - end do + if ( hyperelasticity ) then + !$acc loop seq + do i = xibeg, xiend + qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & + / rho_K + !print *, 'i ::',i,',j,k,l ::',j,k,l,', qprim ::',qK_prim_vf(i)%sf(j,k,l) + end do end if - !$acc loop seq do i = advxb, advxe qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) @@ -1059,11 +1061,13 @@ contains ! s_calculate_btensor has its own triple nested for loop with openacc #ifdef MFC_SIMULATION if (hyperelasticity) then - call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf) + ! MAURO HERE + call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf, 0, m, 0, n, 0, p) + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe + do l = 0, p + do k = 0, n + do j = 0, m !$acc loop seq do i = 1, num_fluids alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) @@ -1072,8 +1076,11 @@ contains ! If in simulation, use acc mixture subroutines call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & alpha_rho_K, Re_K, j, k, l, G_K, Gs) - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + if (G_K > 1d-3) then + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K + !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) + end if end do end do end do @@ -1087,10 +1094,10 @@ contains end do if (hyperelasticity) then - call s_calculate_btensor(qK_prim_vf, q_btensor, ixb, ixe, iyb, iye, izb, ize) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe + call s_calculate_btensor(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) + do l = 0, p + do k = 0, n + do j = 0, m do i = 1, num_fluids alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) @@ -1098,8 +1105,10 @@ contains ! If pre-processing, use non acc mixture subroutines call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + if ( G_K > 1d-3 ) then + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K + end if end do end do end do @@ -1264,13 +1273,15 @@ contains end if ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 - if ( hyperelasticity .and. .not. bubbles ) then + if ( hyperelasticity ) then ! adding the elastic contribution do i = xibeg, xiend q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) end do - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & + if (G > 1d-3) then + q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & G*f_elastic_energy(q_btensor, j, k, l) + end if end if end do @@ -1442,22 +1453,22 @@ contains do l = zb, ze do k = yb, ye do j = xb, xe - call s_compute_gradient_xi(q_prim_vf, xb, xe, yb, & - ye, zb, ze, j, k, l, tensora, tensorb) + call s_compute_gradient_xi(q_prim_vf, xb, xe, yb, & + ye, zb, ze, j, k, l, tensora, tensorb) ! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensorb(1) - if (num_dims > 1) then ! 2D + btensor(1)%sf(j,k,l) = tensorb(1) + !if (num_dims > 1) then ! 2D btensor(2)%sf(j,k,l) = tensorb(2) - btensor(3)%sf(j,k,l) = tensorb(4) - end if - if (num_dims > 2) then ! 3D + ! btensor(3)%sf(j,k,l) = tensorb(4) + !end if + !if (num_dims > 2) then ! 3D btensor(3)%sf(j,k,l) = tensorb(3) btensor(4)%sf(j,k,l) = tensorb(5) btensor(5)%sf(j,k,l) = tensorb(6) btensor(6)%sf(j,k,l) = tensorb(9) - end if + !end if ! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) + btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) end do end do end do @@ -1471,50 +1482,53 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_calculate_btensor_acc(q_prim_vf, btensor) + subroutine s_calculate_btensor_acc(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf type(scalar_field), dimension(b_size), intent(OUT) :: btensor + integer, intent(IN) :: xb, xe, yb, ye, zb, ze real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb integer :: j, k, l, i - if (num_dims == 1) then - !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe - call s_compute_gradient_xi1d_acc(q_prim_vf, ixb, ixe, iyb, & - iye, izb, ize, j, k, l, tensora, tensorb) - !! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensorb(1) - !! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) - end do - end do - end do - !$acc end parallel loop - else if (num_dims == 2) then ! 2D - !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe - call s_compute_gradient_xi2d_acc(q_prim_vf, ixb, ixe, iyb, & - iye, izb, ize, j, k, l, tensora, tensorb) - !! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensorb(1) - btensor(2)%sf(j,k,l) = tensorb(2) - btensor(3)%sf(j,k,l) = tensorb(4) - !! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) - end do - end do - end do - !$acc end parallel loop - else ! 3D +! if (num_dims == 1) then +!! !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) +! do l = izb, ize +! do k = iyb, iye +! do j = ixb, ixe +! call s_compute_gradient_xi1d_acc(q_prim_vf, ixb, ixe, iyb, & +! iye, izb, ize, j, k, l, tensora, tensorb) +! !! 1: 1D, 3: 2D, 6: 3D +! btensor(1)%sf(j, k, l) = tensorb(1) +! !! store the determinant at the last entry of the btensor sf +! btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) +! end do +! end do +! end do +! !$acc end parallel loop +! else if (num_dims == 2) then ! 2D +! !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) +! do l = izb, ize +! do k = iyb, iye +! do j = ixb, ixe +! call s_compute_gradient_xi2d_acc(q_prim_vf, ixb, ixe, iyb, & +! iye, izb, ize, j, k, l, tensora, tensorb) +! !! 1: 1D, 3: 2D, 6: 3D +! btensor(1)%sf(j, k, l) = tensorb(1) +! btensor(2)%sf(j,k,l) = tensorb(2) +! btensor(3)%sf(j,k,l) = tensorb(4) +! !! store the determinant at the last entry of the btensor sf +! btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) +! end do +! end do +! end do +! !$acc end parallel loop +! else ! 3D + !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe + do l = zb, ze + do k = yb, ye + do j = xb, xe ! STEP 1: computing the grad_xi tensor ! grad_xi definition / organization @@ -1523,14 +1537,15 @@ contains ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz ! 1D - if(j == ixb) then + if(j == xb) then ! dxix/dx - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + !print *, ' grid check xb :: ',q_prim_vf(xibeg)%sf(j, k, l) + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l) ) & - /(12d0*(x_cb(j+1) - x_cb(j))) + /(12d0*(x_cb(j + 1) - x_cb(j))) ! dxiy / dx tensora(2) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & @@ -1539,14 +1554,17 @@ contains - 3d0*q_prim_vf(xibeg+1)%sf(j + 4, k, l) ) & /(12d0*(x_cb(j + 1) - x_cb(j))) ! dxiz / dx - tensora(7) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(3) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l) ) & /(12d0*(x_cb(j + 1) - x_cb(j))) + !print *, ' grid check xb :: ',tensora(1),tensora(2),tensora(7) + + else if (j == xb + 1) then + !print *, ' grid check xb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - else if (j == ixb + 1) then ! dxix/dx tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & @@ -1562,14 +1580,17 @@ contains + q_prim_vf(xibeg+1)%sf(j + 3, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) ! dxiz / dx - tensora(7) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + tensora(3) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + q_prim_vf(xiend)%sf(j + 3, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) + !print *, ' grid check xb1 :: ',tensora(1),tensora(2),tensora(7) + + else if (j == xe - 1) then + !print *, ' grid check xe1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - else if (j == ixe - 1) then ! dxix/dx tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & @@ -1585,13 +1606,17 @@ contains - q_prim_vf(xibeg+1)%sf(j - 3, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) ! dxiz / dx - tensora(7) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + tensora(3) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - q_prim_vf(xiend)%sf(j - 3, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe) then + !print *, ' grid check xe1 :: ',tensora(1),tensora(2),tensora(7) + + else if (j == xe) then + !print *, ' grid check xe :: ',q_prim_vf(xibeg)%sf(j, k, l) + ! dxix/dx tensora(1) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & @@ -1607,12 +1632,14 @@ contains + 3d0*q_prim_vf(xibeg+1)%sf(j - 4, k, l) ) & /(12d0*(x_cb(j) - x_cb(j - 1))) ! dxiz / dx - tensora(7) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(3) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l) ) & /(12d0*(x_cb(j) - x_cb(j - 1))) + !print *, ' grid check xe :: ',tensora(1),tensora(2),tensora(7) + else ! dxix/dx tensora(1) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & @@ -1627,7 +1654,7 @@ contains - q_prim_vf(xibeg+1)%sf(j + 2, k, l)) & /(12d0*(x_cb(j) - x_cb(j - 1))) ! dxiz / dx - tensora(7) = ( q_prim_vf(xiend)%sf(j - 2, k, l) & + tensora(3) = ( q_prim_vf(xiend)%sf(j - 2, k, l) & - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - q_prim_vf(xiend)%sf(j + 2, k, l)) & @@ -1636,7 +1663,9 @@ contains end if ! 2D - if(k == iyb) then + if(k == yb) then + !print *, ' grid check yb :: ',q_prim_vf(xibeg)%sf(j, k, l) + ! dxix / dy tensora(4) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & @@ -1652,14 +1681,17 @@ contains - 3d0*q_prim_vf(xibeg+1)%sf(j, k + 4, l) ) & /(12d0*(y_cb(k + 1) - y_cb(k))) ! dxiz / dy - tensora(8) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(6) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l) ) & /(12d0*(y_cb(k + 1) - y_cb(k))) + !print *, ' grid check yb :: ',tensora(4),tensora(5),tensora(8) + + else if (k == yb + 1) then + !print *, ' grid check yb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - else if (k == iyb + 1) then ! dxix / dy tensora(4) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & @@ -1675,13 +1707,17 @@ contains + q_prim_vf(xibeg+1)%sf(j, k + 3, l)) & /(12d0*(y_cb(k) - y_cb(k - 1))) ! dxiz / dy - tensora(8) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + tensora(6) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + q_prim_vf(xiend)%sf(j, k + 3, l)) & /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye - 1) then + !print *, ' grid check yb1 :: ',tensora(4),tensora(5),tensora(8) + + else if (k == ye - 1) then + !print *, ' grid check ye1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + ! dxix / dy tensora(4) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & @@ -1697,13 +1733,17 @@ contains - q_prim_vf(xibeg+1)%sf(j, k - 3, l)) & /(12d0*(y_cb(k) - y_cb(k - 1))) ! dxiz / dy - tensora(8) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + tensora(6) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - q_prim_vf(xiend)%sf(j, k - 3, l)) & /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye) then + !print *, ' grid check yb1 :: ',tensora(4),tensora(5),tensora(8) + + else if (k == ye) then + !print *, ' grid check ye :: ',q_prim_vf(xibeg+1)%sf(j, k, l) + ! dxix / dy tensora(4) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & @@ -1719,7 +1759,7 @@ contains + 3d0*q_prim_vf(xibeg+1)%sf(j, k - 4, l) ) & /(12d0*(y_cb(k) - y_cb(k - 1))) ! dxiz / dy - tensora(8) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(6) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & @@ -1739,7 +1779,7 @@ contains - q_prim_vf(xibeg+1)%sf(j, k + 2, l)) & /(12d0*(y_cb(k) - y_cb(k - 1))) ! dxiz / dy - tensora(8) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & + tensora(6) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - q_prim_vf(xiend)%sf(j, k + 2, l)) & @@ -1747,16 +1787,18 @@ contains end if ! 3D - if(l == izb) then + if(l == zb) then + !print *, ' grid check zb :: ',q_prim_vf(xibeg)%sf(j, k, l) + ! dxix / dz - tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j,k,l) & + tensora(7) = (-25d0*q_prim_vf(xibeg)%sf(j,k,l) & + 48d0*q_prim_vf(xibeg)%sf(j,k,l+1) & - 36d0*q_prim_vf(xibeg)%sf(j,k,l+2) & + 16d0*q_prim_vf(xibeg)%sf(j,k,l+3) & - 3d0*q_prim_vf(xibeg)%sf(j,k,l+4) ) & /(12d0*(z_cb(l + 1) - z_cb(l))) ! dxiy / dz - tensora(6) = (-25d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + tensora(8) = (-25d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + 48d0*q_prim_vf(xibeg+1)%sf(j,k,l+1) & - 36d0*q_prim_vf(xibeg+1)%sf(j,k,l+2) & + 16d0*q_prim_vf(xibeg+1)%sf(j,k,l+3) & @@ -1769,16 +1811,18 @@ contains + 16d0*q_prim_vf(xiend)%sf(j,k,l + 3) & - 3d0*q_prim_vf(xiend)%sf(j,k,l + 4) ) & /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == izb + 1) then + else if (l == zb + 1) then + !print *, ' grid check zb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + ! dxix / dz - tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j,k,l - 1) & + tensora(7) = (-3d0*q_prim_vf(xibeg)%sf(j,k,l - 1) & - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg)%sf(j,k,l + 1) & - 6d0*q_prim_vf(xibeg)%sf(j,k,l + 2) & + q_prim_vf(xibeg)%sf(j,k,l + 3)) & /(12d0*(z_cb(l) - z_cb(l - 1))) ! dxiy / dz - tensora(6) = (-3d0*q_prim_vf(xibeg+1)%sf(j,k,l - 1) & + tensora(8) = (-3d0*q_prim_vf(xibeg+1)%sf(j,k,l - 1) & - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg+1)%sf(j,k,l + 1) & - 6d0*q_prim_vf(xibeg+1)%sf(j,k,l + 2) & @@ -1791,16 +1835,18 @@ contains - 6d0*q_prim_vf(xiend)%sf(j,k,l + 2) & + q_prim_vf(xiend)%sf(j,k,l + 3)) & /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize - 1) then + else if (l == ze - 1) then + !print *, ' grid check ze1 :: ',q_prim_vf(xiend)%sf(j, k, l) + ! dxix / dz - tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + tensora(7) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - q_prim_vf(xibeg)%sf(j, k , l - 3)) & /(12d0*(z_cb(l) - z_cb(l - 1))) ! dxiy / dz - tensora(6) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + tensora(8) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & @@ -1813,16 +1859,18 @@ contains + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - q_prim_vf(xiend)%sf(j, k , l - 3)) & /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize) then + else if (l == ze) then + !print *, ' grid check ze :: ',q_prim_vf(xiend)%sf(j, k, l) + ! dxix / dz - tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensora(7) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & /(12d0*(z_cb(l) - z_cb(l - 1))) ! dxiy / dz - tensora(6) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + tensora(8) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & @@ -1837,13 +1885,13 @@ contains /(12d0*(z_cb(l) - z_cb(l - 1))) else ! dxix / dz - tensora(3) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & + tensora(7) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - q_prim_vf(xibeg)%sf(j, k , l + 2)) & /(12d0*(z_cb(l) - z_cb(l - 1))) ! dxiy / dz - tensora(6) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + tensora(8) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & @@ -1857,7 +1905,6 @@ contains end if - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) @@ -1873,6 +1920,13 @@ contains tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + ! error checking + if (tensorb(tensor_size) .lt. 0d0 .or. tensorb(tensor_size) .gt. 3d0) then + tensorb(tensor_size) = 1d0 + end if + ! print *, 'i, j, k :: ', j,' ', k,' ',l,',det ::',tensorb(tensor_size) + ! stop + !end if ! STEP 2c: computing the inverse of grad_xi tensor = F ! tensorb is the adjoint, tensora becomes the inverse @@ -1884,22 +1938,22 @@ contains end do ! STEP 3: computing F tranpose F - tensorb(1) = tensora(1)**2 - tensorb(1) = tensorb(1) + tensora(4)**2 + tensora(7)**2 - tensorb(5) = tensora(2) + tensora(5)**2 + tensora(8)**2 - tensorb(9) = tensora(3) + tensora(6)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(2) + tensora(4)*tensora(5) + tensora(7)*tensora(8) - tensorb(3) = tensora(1)*tensora(3) + tensora(4)*tensora(6) + tensora(7)*tensora(9) - tensorb(6) = tensora(2)*tensora(3) + tensora(5)*tensora(6) + tensora(8)*tensora(9) + !tensorb(1) = tensora(1)**2 + tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 + tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 + tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) + tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) + tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) tensorb(4) = tensorb(2) tensorb(7) = tensorb(3) - tensorb(8) = tensorb(4) + tensorb(8) = tensorb(6) !call s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, & !iye, izb, ize, j, k, l, tensora, tensorb) !! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensorb(1) + btensor(1)%sf(j,k,l) = tensorb(1) btensor(2)%sf(j,k,l) = tensorb(2) btensor(3)%sf(j,k,l) = tensorb(3) btensor(4)%sf(j,k,l) = tensorb(5) @@ -1911,7 +1965,10 @@ contains end do end do !$acc end parallel loop - end if + +! end if + + stop end subroutine s_calculate_btensor_acc diff --git a/src/common/m_xi_tensor_calc.f90 b/src/common/m_xi_tensor_calc.f90 index 5ff6d4f69b..97ed245863 100644 --- a/src/common/m_xi_tensor_calc.f90 +++ b/src/common/m_xi_tensor_calc.f90 @@ -48,6 +48,8 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz if(j == xb) then ! dxix/dx + print *, ' grid check :: ',q_prim_vf(xibeg)%sf(j, k, l) + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & @@ -221,7 +223,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- if(l == zb) then ! dxix / dz - tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensora(7) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - 36d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & + 16d0*q_prim_vf(xibeg)%sf(j, k , l + 3) & @@ -229,7 +231,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- /(12d0*(z_cb(l + 1) - z_cb(l))) else if (l == zb + 1) then ! dxix / dz - tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + tensora(7) = (-3d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - 6d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & @@ -237,7 +239,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- /(12d0*(z_cb(l) - z_cb(l - 1))) else if (l == ze - 1) then ! dxix / dz - tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + tensora(7) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & @@ -245,7 +247,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- /(12d0*(z_cb(l) - z_cb(l - 1))) else if (l == ze) then ! dxix / dz - tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & + tensora(7) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & @@ -253,7 +255,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- /(12d0*(z_cb(l) - z_cb(l - 1))) else ! dxix / dz - tensora(3) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & + tensora(7) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - q_prim_vf(xibeg)%sf(j, k , l + 2)) & @@ -262,7 +264,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- if(l == zb) then ! dxiy / dz - tensora(6) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + tensora(8) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - 36d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & + 16d0*q_prim_vf(xibeg+1)%sf(j, k , l + 3) & @@ -270,7 +272,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- /(12d0*(z_cb(l+1) - z_cb(l))) else if (l == zb + 1) then ! dxiy / dz - tensora(6) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + tensora(8) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & + 18d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - 6d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & @@ -278,7 +280,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- /(12d0*(z_cb(l) - z_cb(l - 1))) else if (l == ze - 1) then ! dxiy / dz - tensora(6) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + tensora(8) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & @@ -286,7 +288,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- /(12d0*(z_cb(l) - z_cb(l - 1))) else if (l == ze) then ! dxiy / dz - tensora(6) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & + tensora(8) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & @@ -294,7 +296,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- /(12d0*(z_cb(l) - z_cb(l-1))) else ! dxiy / dz - tensora(6) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & + tensora(8) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & @@ -303,7 +305,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- if(j == xb) then ! dxiz / dx - tensora(7) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(3) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & @@ -311,7 +313,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- /(12d0*(x_cb(j + 1) - x_cb(j))) else if (j == xb + 1) then ! dxiz / dx - tensora(7) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + tensora(3) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & @@ -319,7 +321,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == xe - 1) then ! dxiz / dx - tensora(7) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + tensora(3) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & @@ -327,7 +329,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == xe) then ! dxiz / dx - tensora(7) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(3) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & @@ -335,7 +337,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- /(12d0*(x_cb(j) - x_cb(j - 1))) else ! dxiz / dx - tensora(7) = ( q_prim_vf(xiend)%sf(j - 2, k, l) & + tensora(3) = ( q_prim_vf(xiend)%sf(j - 2, k, l) & - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - q_prim_vf(xiend)%sf(j + 2, k, l)) & @@ -344,7 +346,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- if(k == yb) then ! dxiz / dy - tensora(8) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(6) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & @@ -352,7 +354,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- /(12d0*(y_cb(k+1) - y_cb(k))) else if (k == yb + 1) then ! dxiz / dy - tensora(8) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + tensora(6) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - 10d0*q_prim_vf(xiend)%sf(j,k,l) & + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & @@ -360,7 +362,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- /(12d0*(y_cb(k) - y_cb(k - 1))) else if (k == ye - 1) then ! dxiz / dy - tensora(8) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + tensora(6) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & @@ -368,7 +370,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- /(12d0*(y_cb(k) - y_cb(k - 1))) else if (k == ye) then ! dxiz / dy - tensora(8) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & + tensora(6) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & @@ -376,7 +378,7 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- /(12d0*(y_cb(k) - y_cb(k - 1))) else ! dxiz / dy - tensora(8) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & + tensora(6) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - q_prim_vf(xiend)%sf(j, k + 2, l)) & @@ -456,10 +458,14 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) end if ! error checking - if (determinant == 0) then - print *, 'determinant :: ', determinant - print *, 'ERROR: Determinant was zero' - stop + !if (determinant == 0) then + ! print *, 'determinant :: ', determinant + ! print *, 'ERROR: Determinant was zero' + ! stop + !end if + if (determinant .lt. 0d0 .or. determinant .gt. 2d0) then + print *, 'i, j, k :: ', j,' ', k,' ',l,',det ::',tensorb(tensor_size) + ! stop end if ! STEP 2c: computing the inverse of grad_xi tensor = F @@ -476,15 +482,15 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- tensorb(3) = tensorb(2) tensorb(4) = tensora(2)**2 + tensora(4)**2 elseif (num_dims == 3) then - tensorb(1) = tensorb(1) + tensora(4)**2 + tensora(7)**2 - tensorb(5) = tensora(2) + tensora(5)**2 + tensora(8)**2 - tensorb(9) = tensora(3) + tensora(6)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(2) + tensora(4)*tensora(5) + tensora(7)*tensora(8) - tensorb(3) = tensora(1)*tensora(3) + tensora(4)*tensora(6) + tensora(7)*tensora(9) - tensorb(6) = tensora(2)*tensora(3) + tensora(5)*tensora(6) + tensora(8)*tensora(9) + tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 + tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 + tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) + tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) + tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) tensorb(4) = tensorb(2) tensorb(7) = tensorb(3) - tensorb(8) = tensorb(4) + tensorb(8) = tensorb(6) end if ! STEP 4: store the determinant of F in the last entry of the tensor tensorb(tensor_size) = determinant @@ -1212,11 +1218,11 @@ function f_elastic_energy(btensor, j, k, l) f_elastic_energy = 0d0 invariant1 = btensor(1)%sf(j, k, l) - if (num_dims == 2) then - invariant1 = invariant1 + btensor(3)%sf(j, k, l) - elseif (num_dims == 3) then + !if (num_dims == 2) then + ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) + !elseif (num_dims == 3) then invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) - end if + !end if ! compute the invariant without the elastic modulus f_elastic_energy = 0.5d0*(invariant1 - 3.0d0)/btensor(b_size)%sf(j, k, l) diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 index 1c05aa5bf5..940af4ad6b 100644 --- a/src/pre_process/m_assign_variables.f90 +++ b/src/pre_process/m_assign_variables.f90 @@ -458,8 +458,9 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & xi_cart(2) = y_cc(k) xi_cart(3) = z_cc(l) end if + do i = 1, num_dims - q_prim_vf(i+stress_idx%end)%sf(j,k,l) = xi_cart(i) + q_prim_vf(i+xibeg-1)%sf(j,k,l) = xi_cart(i) end do !(eta*xi_cart(i) + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1)) !if (proc_rank == 0) then diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp index 6cbc328f1f..0867fde784 100644 --- a/src/pre_process/m_data_output.fpp +++ b/src/pre_process/m_data_output.fpp @@ -634,6 +634,7 @@ contains call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & MPI_DOUBLE_PRECISION, status, ierr) end do + end if call MPI_FILE_CLOSE(ifile, ierr) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 74f3452378..8ed46d1a19 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -332,10 +332,10 @@ contains ! Compute mixture sound speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c) - if (c < 10d-12) then - print *, 'code has crashed at processor: ', proc_rank, ' at j :: ', j, ', k :: ', k, ' l :: ', l, 'with alph1a ::', alpha(1), 'and alpha2 ::', alpha(2) - print *, 'ICFL ERROR, I TOLD YOU AGAIN!' - ! call s_mpi_abort() + if (c < 1d-12) then + print *, 'crashed at processor: ', proc_rank,' at j :: ',j,', k :: ',k,' l :: ',l + print *, 'with alpha1 ::', alpha(1),'and alpha2 ::',alpha(2), ' alpha3 :: ',alpha(3) + !stop end if if (grid_geometry == 3) then diff --git a/src/simulation/m_hyperelastic.f90 b/src/simulation/m_hyperelastic.f90 index d6a83ac27f..6e6bf4994d 100644 --- a/src/simulation/m_hyperelastic.f90 +++ b/src/simulation/m_hyperelastic.f90 @@ -32,20 +32,28 @@ subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, ix, iy, iz) type(int_bounds_info), intent(IN) :: ix, iy, iz real(kind(0d0)), dimension(b_size-1) :: tensor - real(kind(0d0)) :: trace, invariant1 + real(kind(0d0)) :: trace integer :: i, j, k, l !< Generic loop iterators - !$acc parallel loop collapse(3) gang vector default(present) private(trace,invariant1) - do l = iz%beg, iz%end - do k = iy%beg, iy%end - do j = ix%beg, ix%end + !$acc parallel loop collapse(3) gang vector default(present) private(trace) + do l = 0, p + do k = 0, n + do j = 0, m ! tensor is the symmetric tensor & calculate the trace of the tensor - trace = btensor(1)%sf(j,k,l) + !trace = btensor(1)%sf(j,k,l) !if (num_dims == 2) then ! trace = trace + btensor(3)%sf(j,k,l) !else - trace = trace + btensor(4)%sf(j,k,l) + btensor(6)%sf(j,k,l) + trace = btensor(1)%sf(j,k,l) + btensor(4)%sf(j,k,l) + btensor(6)%sf(j,k,l) !end if + ! invariant calculation, saving it in the q_prim_vf field + !invariant1 = btensor(1)%sf(j, k, l) + !if (num_dims == 2) then + ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) + !elseif (num_dims == 3) then + ! invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + !end if + ! calculate the deviatoric of the tensor btensor(1)%sf(j,k,l) = btensor(1)%sf(j,k,l) - (1d0/3d0)*trace !if (num_dims == 2) then @@ -62,17 +70,13 @@ subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, ix, iy, iz) q_prim_vf(strxb+i)%sf(j, k, l) = btensor(i)%sf(j,k,l)/btensor(b_size)%sf(j, k, l) end do - ! invariant calculation, saving it in the q_prim_vf field - invariant1 = btensor(1)%sf(j, k, l) - !if (num_dims == 2) then - ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) - !elseif (num_dims == 3) then - invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) - !end if ! compute the invariant without the elastic modulus - q_prim_vf(xiend+1)%sf(j,k,l) = 0.5d0*(invariant1 - 3.0d0)/btensor(b_size)%sf(j, k, l) - + !if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then + q_prim_vf(xiend+1)%sf(j,k,l) = 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) + ! else + ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 + ! end if end do end do end do diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 7fb58adc8c..b929c38dab 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -722,7 +722,7 @@ contains end do end do end if - + print *, "I got here A" call nvtxStartRange("RHS-CONVERT") call s_convert_conservative_to_primitive_variables( & q_cons_qp%vf, & @@ -731,6 +731,7 @@ contains ix, iy, iz, & q_btensor%vf) call nvtxEndRange + print *, "I got here B" call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") if ( hyperelasticity ) then @@ -741,6 +742,7 @@ contains call nvtxStartRange("RHS-MPI") call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) call nvtxEndRange + print *, "I got here c" if (t_step == t_step_stop) return ! ================================================================== @@ -861,6 +863,7 @@ contains end if ix%end = m; iy%end = n; iz%end = p ! =============================================================== + print *, "I got here d" ! Computing Riemann Solver Flux and Source Flux ================= call nvtxStartRange("RHS_riemann_solver") @@ -880,6 +883,7 @@ contains flux_gsrc_n(id)%vf, & id, ix, iy, iz) call nvtxEndRange + print *, "I got here e" ! =============================================================== diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 274457de25..c75709cf6a 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -508,7 +508,7 @@ contains end if ! elastic energy update - if (hyperelasticity) then + if ( hyperelasticity ) then G_L = 0d0 G_R = 0d0 @@ -517,27 +517,38 @@ contains G_L = G_L + alpha_L(i)*Gs(i) G_R = G_R + alpha_R(i)*Gs(i) end do - - !$acc loop seq - do i = 1, strxe - strxb + 1 + ! Elastic contribution to energy if G large enough + if ((G_L > 1d-3) .and. (G_R > 1d-3)) then + E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) + E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) + !$acc loop seq + do i = 1, b_size-1 tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do - !$acc loop seq do i = 1, num_dims xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) end do - ! Elastic contribution to energy if G large enough - if ((G_L > 1d0) .and. (G_R > 1d0)) then - E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) - E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) + else + + !$acc loop seq + do i = 1, b_size-1 + tau_e_L(i) = 0d0 + tau_e_R(i) = 0d0 + end do + !$acc loop seq + do i = 1, num_dims + xi_field_L(i) = 0d0 + xi_field_R(i) = 0d0 + end do end if end if - + + @:compute_average_state() call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 81c48cff4e..3910747211 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -662,9 +662,9 @@ contains NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) ! Read the data for each variable - if ( bubbles .or. hypoelasticity .or. hyperelasticity ) then + if ( bubbles .or. elasticity ) then - do i = 1, sys_size!adv_idx%end + do i = 1, sys_size !adv_idx%end var_MOK = int(i, MPI_OFFSET_KIND) ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) @@ -1366,6 +1366,7 @@ contains do i = 1, sys_size !$acc update device(q_cons_ts(1)%vf(i)%sf) end do + if (qbmm .and. .not. polytropic) then !$acc update device(pb_ts(1)%sf, mv_ts(1)%sf) end if From cb9d7ba3f5079c73b6127803511a5c074c2d802f Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 6 Jun 2024 11:20:16 -0500 Subject: [PATCH 140/380] compiles, goes past the first time step, need to continue debugging --- src/common/m_variables_conversion.fpp | 34 +++++++++++++++++---------- src/simulation/m_data_output.fpp | 4 ++-- src/simulation/m_riemann_solvers.fpp | 17 +------------- 3 files changed, 25 insertions(+), 30 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 648bc48a9e..dd1f79a68c 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1916,22 +1916,36 @@ contains tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) + ! STEP 2b: computing the determinant of the grad_xi tensor tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - ! error checking - if (tensorb(tensor_size) .lt. 0d0 .or. tensorb(tensor_size) .gt. 3d0) then - tensorb(tensor_size) = 1d0 - end if - ! print *, 'i, j, k :: ', j,' ', k,' ',l,',det ::',tensorb(tensor_size) - ! stop - !end if + + !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 3d0 ) then + ! print *, 'j, k, l :: ', j, k, l + ! do i = 1, 9 + ! print *,'i :: ',i,', ten :: ',tensorb(i) + ! end do + ! print *, 'det : ',tensorb(tensor_size) + ! tensorb(tensor_size) = 1d0 + !end if ! STEP 2c: computing the inverse of grad_xi tensor = F ! tensorb is the adjoint, tensora becomes the inverse ! STEP 4: store the determinant of F in the last entry of the tensor + !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 2d0 ) then + tensorb(tensor_size) = 1d0 + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = 0d0 + end do + tensorb(1) = 1d0 + tensorb(5) = 1d0 + tensorb(9) = 1d0 + !end if + !$acc loop seq do i = 1, tensor_size - 1 tensora(i) = tensorb(i)/tensorb(tensor_size) @@ -1949,7 +1963,6 @@ contains tensorb(7) = tensorb(3) tensorb(8) = tensorb(6) - !call s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, & !iye, izb, ize, j, k, l, tensora, tensorb) !! 1: 1D, 3: 2D, 6: 3D @@ -1965,11 +1978,8 @@ contains end do end do !$acc end parallel loop - + ! end if - - stop - end subroutine s_calculate_btensor_acc subroutine s_finalize_variables_conversion_module() ! ------------------ diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 8ed46d1a19..eaaa928352 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -333,8 +333,8 @@ contains call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c) if (c < 1d-12) then - print *, 'crashed at processor: ', proc_rank,' at j :: ',j,', k :: ',k,' l :: ',l - print *, 'with alpha1 ::', alpha(1),'and alpha2 ::',alpha(2), ' alpha3 :: ',alpha(3) + !print *, 'crashed at processor: ', proc_rank,' at j :: ',j,', k :: ',k,' l :: ',l + !print *, 'with alpha1 ::', alpha(1),'and alpha2 ::',alpha(2), ' alpha3 :: ',alpha(3) !stop end if diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index c75709cf6a..4c34e96834 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -531,24 +531,9 @@ contains xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) end do - - else - - !$acc loop seq - do i = 1, b_size-1 - tau_e_L(i) = 0d0 - tau_e_R(i) = 0d0 - end do - !$acc loop seq - do i = 1, num_dims - xi_field_L(i) = 0d0 - xi_field_R(i) = 0d0 - end do end if - end if - - + @:compute_average_state() call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & From 0434d3792369113f8dad828e184274146a7b2966 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 7 Jun 2024 13:59:41 -0500 Subject: [PATCH 141/380] debugging past the second time step, compiles, but does not run --- src/common/m_xi_tensor_calc.f90 | 2 -- src/simulation/m_global_parameters.fpp | 2 ++ src/simulation/m_hyperelastic.f90 | 5 ++--- src/simulation/m_riemann_solvers.fpp | 20 +++++++++++++------- 4 files changed, 17 insertions(+), 12 deletions(-) diff --git a/src/common/m_xi_tensor_calc.f90 b/src/common/m_xi_tensor_calc.f90 index 97ed245863..9a910a2b06 100644 --- a/src/common/m_xi_tensor_calc.f90 +++ b/src/common/m_xi_tensor_calc.f90 @@ -48,8 +48,6 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz if(j == xb) then ! dxix/dx - print *, ' grid check :: ',q_prim_vf(xibeg)%sf(j, k, l) - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 26409d64ba..9b3d8086cf 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -785,6 +785,7 @@ contains if ( hypoelasticity ) then elasticity = .true. + hyperelasticity = .false. stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D @@ -793,6 +794,7 @@ contains if ( hyperelasticity ) then elasticity = .true. + hypoelasticity = .false. ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 diff --git a/src/simulation/m_hyperelastic.f90 b/src/simulation/m_hyperelastic.f90 index 6e6bf4994d..ef2302b70d 100644 --- a/src/simulation/m_hyperelastic.f90 +++ b/src/simulation/m_hyperelastic.f90 @@ -70,10 +70,9 @@ subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, ix, iy, iz) q_prim_vf(strxb+i)%sf(j, k, l) = btensor(i)%sf(j,k,l)/btensor(b_size)%sf(j, k, l) end do - ! compute the invariant without the elastic modulus - !if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then - q_prim_vf(xiend+1)%sf(j,k,l) = 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) + ! if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then + q_prim_vf(xiend+1)%sf(j,k,l) = 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) ! else ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 ! end if diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 4c34e96834..eec39870bc 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -471,10 +471,6 @@ contains E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R - ! moving this down to account for the elasticity - H_L = (E_L + pres_L)/rho_L - H_R = (E_R + pres_R)/rho_R - ! elastic energy update if (hypoelasticity) then !$acc loop seq @@ -508,7 +504,7 @@ contains end if ! elastic energy update - if ( hyperelasticity ) then + if ( hypoelasticity ) then G_L = 0d0 G_R = 0d0 @@ -534,6 +530,10 @@ contains end if end if + ! moving this down to account for the elasticity + H_L = (E_L + pres_L)/rho_L + H_R = (E_R + pres_R)/rho_R + @:compute_average_state() call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & @@ -556,7 +556,7 @@ contains end if if (wave_speeds == 1) then - if ( elasticity ) then + if ( hypoelasticity ) then s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & (((4d0*G_L)/3d0) + & tau_e_L(dir_idx_tau(1)))/rho_L) & @@ -569,6 +569,12 @@ contains , vel_L(dir_idx(1)) + sqrt(c_L*c_L + & (((4d0*G_L)/3d0) + & tau_e_L(dir_idx_tau(1)))/rho_L)) + elseif ( hyperelasticity ) then + s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L ) & + , vel_R(dir_idx(1)) - sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R )) + s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R ) & + , vel_L(dir_idx(1)) + sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L )) + else s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) @@ -2527,7 +2533,7 @@ contains !$acc update device(is1, is2, is3) - if (hypoelasticity .or. hyperelasticity) then + if ( elasticity ) then if (norm_dir == 1) then dir_idx_tau = (/1, 2, 4/) else if (norm_dir == 2) then From c90b2c8b2fa94dab0df0f4cc60fd4794978265f6 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 8 Jun 2024 19:28:40 -0400 Subject: [PATCH 142/380] added the Brown Oscar mako and modules --- toolchain/bootstrap/modules.sh | 3 +- toolchain/modules | 7 ++++- toolchain/templates/oscar.mako | 56 ++++++++++++++++++++++++++++++++++ toolchain/util.sh | 4 +-- 4 files changed, 66 insertions(+), 4 deletions(-) create mode 100644 toolchain/templates/oscar.mako diff --git a/toolchain/bootstrap/modules.sh b/toolchain/bootstrap/modules.sh index f9aa296930..31528f40b0 100644 --- a/toolchain/bootstrap/modules.sh +++ b/toolchain/bootstrap/modules.sh @@ -23,7 +23,8 @@ if [ -v $u_c ]; then log "$C""ACCESS$W: Bridges2 (b) | Expanse (e) | Delta (d)" log "$Y""Gatech$W: Phoenix (p)" log "$R""Caltech$W: Richardson (r)" - log_n "($G""a$W/$G""f$W/$G""s$W/$G""w$W/$C""b$W/$C""e$CR/$C""d$CR/$Y""p$CR/$R""r$CR): " + log "$B""Brown$W: Oscar (o)" + log_n "($G""a$W/$G""f$W/$G""s$W/$G""w$W/$C""b$W/$C""e$CR/$C""d$CR/$Y""p$CR/$R""r$CR/$B""o$CR): " read u_c log fi diff --git a/toolchain/modules b/toolchain/modules index e1e51bfc97..1265315d31 100644 --- a/toolchain/modules +++ b/toolchain/modules @@ -54,9 +54,14 @@ f-all cray-fftw cray-hdf5 cray-mpich cce/16.0.1 f-all rocm/5.5.1 cray-python omniperf f-cpu - d NCSA Delta d-all python/3.11.6 d-cpu gcc/11.4.0 openmpi d-gpu nvhpc/22.11 openmpi+cuda/4.1.5+cuda cmake d-gpu CC=nvc CXX=nvc++ FC=nvfortran + +o Brown Oscar +o-all python +o-cpu hpcx-mpi +o-gpu nvhpc cuda/12.3.0 cmake/3.26.3 +o-gpu CC=nvc CXX=nvc++ FC=nvfortran diff --git a/toolchain/templates/oscar.mako b/toolchain/templates/oscar.mako new file mode 100644 index 0000000000..158a217cc1 --- /dev/null +++ b/toolchain/templates/oscar.mako @@ -0,0 +1,56 @@ +#!/usr/bin/env bash + +<%namespace name="helpers" file="helpers.mako"/> + +% if engine == 'batch': +#SBATCH --nodes=${nodes} +#SBATCH --ntasks-per-node=${tasks_per_node} +#SBATCH --cpus-per-task=1 +#SBATCH --job-name="${name}" +#SBATCH --time=${walltime} +% if partition: +#SBATCH --partition=${partition} +% endif +% if account: +#SBATCH --account="${account}" +% endif +% if gpu: +#SBATCH --gpus-per-node=${tasks_per_node} +#SBATCH --mem=64G +#SBATCH --gpu-bind=closest +% endif +#SBATCH --output="${name}.out" +#SBATCH --error="${name}.err" +#SBATCH --export=ALL +% if email: +#SBATCH --mail-user=${email} +#SBATCH --mail-type="BEGIN, END, FAIL" +% endif +% endif + +${helpers.template_prologue()} + +ok ":) Loading modules:\n" +cd "${MFC_ROOTDIR}" +. ./mfc.sh load -c o -m ${'g' if gpu else 'c'} +cd - > /dev/null +echo + +% for target in targets: + ${helpers.run_prologue(target)} + + % if not mpi: + (set -x; ${profiler} "${target.get_install_binpath(case)}") + % else: + (set -x; ${profiler} \ + mpirun -np ${nodes*tasks_per_node} \ + ${' '.join([f"'{x}'" for x in ARG('--') ])} \ + "${target.get_install_binpath(case)}") + % endif + + ${helpers.run_epilogue(target)} + + echo +% endfor + +${helpers.template_epilogue()} diff --git a/toolchain/util.sh b/toolchain/util.sh index 5e32eee2f9..9116b1158e 100644 --- a/toolchain/util.sh +++ b/toolchain/util.sh @@ -1,10 +1,10 @@ #!/bin/bash if [ -t 1 ]; then - RED="\x1B[31m"; CYAN="\x1B[36m"; GREEN="\x1B[32m" + RED="\x1B[31m"; CYAN="\x1B[36m"; GREEN="\x1B[32m"; BROWN="\x1B[38;5;58m" YELLOW="\x1B[33m"; MAGENTA="\x1B[35m"; COLOR_RESET="\033[m" - R=$RED; C=$CYAN; G=$GREEN + R=$RED; C=$CYAN; G=$GREEN; B=$BROWN Y=$YELLOW; M=$MAGENTA; CR=$COLOR_RESET; W=$CR fi From a476068dd26bbbdba87380c480a99219f2355db1 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 8 Jun 2024 20:46:24 -0400 Subject: [PATCH 143/380] merged with source, test fails --- submit.sh | 1 - toolchain/mfc/run/case_dicts.py | 16 ++-------------- 2 files changed, 2 insertions(+), 15 deletions(-) delete mode 120000 submit.sh diff --git a/submit.sh b/submit.sh deleted file mode 120000 index d3511b96f8..0000000000 --- a/submit.sh +++ /dev/null @@ -1 +0,0 @@ -../submit_gpu.sh \ No newline at end of file diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index fe3898bc4a..52d66a0f29 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -261,18 +261,6 @@ class ParamType(Enum): SIMULATION[f"integral({int_id})%{cmp}min"] = ParamType.REAL SIMULATION[f"integral({int_id})%{cmp}max"] = ParamType.REAL - -<<<<<<< HEAD -POST_PROCESS = COMMON + [ - 't_step_start', 't_step_stop', 't_step_save', 'alt_soundspeed', - 'mixture_err', 'format', 'schlieren_wrt', 'schlieren_alpha', 'fd_order', - 'fourier_modes%beg', 'fourier_modes%end', 'alpha_rho_wrt', 'rho_wrt', - 'mom_wrt', 'vel_wrt', 'flux_lim', 'flux_wrt', 'E_wrt', 'pres_wrt', - 'alpha_wrt', 'kappa_wrt', 'gamma_wrt', 'heat_ratio_wrt', 'pi_inf_wrt', - 'pres_inf_wrt', 'cons_vars_wrt', 'prim_vars_wrt', 'c_wrt', 'omega_wrt','qbmm', - 'qm_wrt', 'sim_data', 'chem_wrt' -] -======= # Removed: 'fourier_modes%beg', 'fourier_modes%end', 'chem_wrt' # Feel free to return them if they are needed once more. POST_PROCESS = COMMON.copy() @@ -306,9 +294,9 @@ class ParamType(Enum): 'omega_wrt': ParamType.LOG, 'qbmm': ParamType.LOG, 'qm_wrt': ParamType.LOG, - 'cf_wrt': ParamType.LOG + 'cf_wrt': ParamType.LOG, + 'sim_data': ParamType.LOG }) ->>>>>>> source for cmp_id in range(1,3+1): cmp = ["x", "y", "z"][cmp_id-1] From 2a07b89bd583f166bc340d495e26376383ffe8ff Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 8 Jun 2024 20:20:28 -0500 Subject: [PATCH 144/380] merged source case dictionary --- toolchain/mfc/run/case_dicts.py | 16 ++-------------- 1 file changed, 2 insertions(+), 14 deletions(-) diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index fe3898bc4a..52d66a0f29 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -261,18 +261,6 @@ class ParamType(Enum): SIMULATION[f"integral({int_id})%{cmp}min"] = ParamType.REAL SIMULATION[f"integral({int_id})%{cmp}max"] = ParamType.REAL - -<<<<<<< HEAD -POST_PROCESS = COMMON + [ - 't_step_start', 't_step_stop', 't_step_save', 'alt_soundspeed', - 'mixture_err', 'format', 'schlieren_wrt', 'schlieren_alpha', 'fd_order', - 'fourier_modes%beg', 'fourier_modes%end', 'alpha_rho_wrt', 'rho_wrt', - 'mom_wrt', 'vel_wrt', 'flux_lim', 'flux_wrt', 'E_wrt', 'pres_wrt', - 'alpha_wrt', 'kappa_wrt', 'gamma_wrt', 'heat_ratio_wrt', 'pi_inf_wrt', - 'pres_inf_wrt', 'cons_vars_wrt', 'prim_vars_wrt', 'c_wrt', 'omega_wrt','qbmm', - 'qm_wrt', 'sim_data', 'chem_wrt' -] -======= # Removed: 'fourier_modes%beg', 'fourier_modes%end', 'chem_wrt' # Feel free to return them if they are needed once more. POST_PROCESS = COMMON.copy() @@ -306,9 +294,9 @@ class ParamType(Enum): 'omega_wrt': ParamType.LOG, 'qbmm': ParamType.LOG, 'qm_wrt': ParamType.LOG, - 'cf_wrt': ParamType.LOG + 'cf_wrt': ParamType.LOG, + 'sim_data': ParamType.LOG }) ->>>>>>> source for cmp_id in range(1,3+1): cmp = ["x", "y", "z"][cmp_id-1] From 7d1777152b45d5a084c1b205cb88cd3fe2c173e5 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 9 Jun 2024 22:03:17 -0500 Subject: [PATCH 145/380] attempted to fix master, test suite does not work --- src/common/m_constants.fpp | 20 ++++++++++---------- src/simulation/m_data_output.fpp | 18 +++++++++--------- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp index 5d90f6afe1..ada34ab5ea 100644 --- a/src/common/m_constants.fpp +++ b/src/common/m_constants.fpp @@ -7,18 +7,18 @@ module m_constants character, parameter :: dflt_char = ' ' !< Default string value real(kind(0d0)), parameter :: dflt_real = -1d6 !< Default real value - real(kind(0d0)), parameter :: sgm_eps = 1d-12 !< Segmentation tolerance - real(kind(0d0)), parameter :: small_alf = 1d-11 !< Small alf tolerance - real(kind(0d0)), parameter :: pi = 3.141592653589793d0 !< Pi + real(kind(0d0)), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance + real(kind(0d0)), parameter :: small_alf = 1d-11 !< Small alf tolerance + real(kind(0d0)), parameter :: pi = 3.141592653589793d0 !< Pi real(kind(0d0)), parameter :: verysmall = 1.d-12 !< Very small number - integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils - integer, parameter :: path_len = 400 !< Maximum path length - integer, parameter :: name_len = 50 !< Maximum name length - integer, parameter :: dflt_int = -100 !< Default integer value - integer, parameter :: fourier_rings = 5 !< Fourier filter ring limit - integer, parameter :: num_fluids_max = 10 !< Maximum number of fluids in the simulation - integer, parameter :: num_probes_max = 10 !< Maximum number of flow probes in the simulation + integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils + integer, parameter :: path_len = 400 !< Maximum path length + integer, parameter :: name_len = 50 !< Maximum name length + integer, parameter :: dflt_int = -100 !< Default integer value + integer, parameter :: fourier_rings = 5 !< Fourier filter ring limit + integer, parameter :: num_fluids_max = 10 !< Maximum number of fluids in the simulation + integer, parameter :: num_probes_max = 10 !< Maximum number of flow probes in the simulation integer, parameter :: num_patches_max = 10 integer, parameter :: pathlen_max = 400 integer, parameter :: nnode = 4 !< Number of QBMM nodes diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index b315626460..87525dfc60 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -1465,7 +1465,7 @@ contains if (n == 0) then if (bubbles .and. (num_fluids <= 2)) then if (qbmm) then - write (i + 30, '(6x,f12.12,14f28.16)') & + write (i + 30, '(6x,f12.6,14f28.16)') & nondim_time, & rho, & vel(1), & @@ -1482,7 +1482,7 @@ contains M20, & M02 else - write (i + 30, '(6x,f12.12,8f24.8)') & + write (i + 30, '(6x,f12.6,8f24.8)') & nondim_time, & rho, & vel(1), & @@ -1496,7 +1496,7 @@ contains ! ptot end if else if (bubbles .and. (num_fluids == 3)) then - write (i + 30, '(6x,f12.12,f24.8,f24.8,f24.8,f24.8,f24.8,'// & + write (i + 30, '(6x,f12.6,f24.8,f24.8,f24.8,f24.8,f24.8,'// & 'f24.8,f24.8,f24.8,f24.8,f24.8, f24.8)') & nondim_time, & rho, & @@ -1511,7 +1511,7 @@ contains ptilde, & ptot else if (bubbles .and. num_fluids == 4) then - write (i + 30, '(6x,f12.12,f24.8,f24.8,f24.8,f24.8,'// & + write (i + 30, '(6x,f12.6,f24.8,f24.8,f24.8,f24.8,'// & 'f24.8,f24.8,f24.8,f24.8,f24.8,f24.8,f24.8,f24.8,f24.8)') & nondim_time, & q_cons_vf(1)%sf(j - 2, 0, 0), & @@ -1528,7 +1528,7 @@ contains R(1), & Rdot(1) else - write (i + 30, '(6X,F12.12,F24.8,F24.8,F24.8)') & + write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8)') & nondim_time, & rho, & vel(1), & @@ -1548,7 +1548,7 @@ contains R(1), & Rdot(1) else if (hypoelasticity) then - write (i + 30, '(6X,F12.12,F24.8,F24.8,F24.8,F24.8,'// & + write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,'// & 'F24.8,F24.8,F24.8)') & nondim_time, & rho, & @@ -1559,7 +1559,7 @@ contains tau_e(2), & tau_e(3) else - write (i + 30, '(6X,F12.12,F24.8,F24.8,F24.8)') & + write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8)') & nondim_time, & rho, & vel(1), & @@ -1629,7 +1629,7 @@ contains if (proc_rank == 0) then if (bubbles .and. (num_fluids <= 2)) then - write (i + 70, '(6x,f12.12,f24.8)') & + write (i + 70, '(6x,f12.6,f24.8)') & nondim_time, int_pres end if end if @@ -1712,7 +1712,7 @@ contains if (proc_rank == 0) then if (bubbles .and. (num_fluids <= 2)) then - write (i + 70, '(6x,f12.12,f24.8,f24.8)') & + write (i + 70, '(6x,f12.6,f24.8,f24.8)') & nondim_time, int_pres, max_pres end if end if From 736f0d1bab54b64e35f7396a89756a08d5d0d33c Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 10 Jun 2024 12:43:20 -0500 Subject: [PATCH 146/380] still debugging the test suite --- src/common/m_constants.fpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp index 5d90f6afe1..13fa630e6d 100644 --- a/src/common/m_constants.fpp +++ b/src/common/m_constants.fpp @@ -7,7 +7,7 @@ module m_constants character, parameter :: dflt_char = ' ' !< Default string value real(kind(0d0)), parameter :: dflt_real = -1d6 !< Default real value - real(kind(0d0)), parameter :: sgm_eps = 1d-12 !< Segmentation tolerance + real(kind(0d0)), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance real(kind(0d0)), parameter :: small_alf = 1d-11 !< Small alf tolerance real(kind(0d0)), parameter :: pi = 3.141592653589793d0 !< Pi real(kind(0d0)), parameter :: verysmall = 1.d-12 !< Very small number From a61b5562cb714761e89a57498e5e4d9e965d71b3 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 10 Jun 2024 12:47:31 -0500 Subject: [PATCH 147/380] correcting the pressure relaxation --- src/simulation/m_rhs.fpp | 25 ++++++++++--------------- 1 file changed, 10 insertions(+), 15 deletions(-) diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index c00a2c55ea..b59adfaf21 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -1912,7 +1912,11 @@ contains (q_cons_vf(i + intxb - 1)%sf(j, k, l)/ & q_cons_vf(i + advxb - 1)%sf(j, k, l) & - pi_infs(i))/gammas(i) - if (pres_k_init(i) .le. 0d0) pres_k_init = 1e-2 + + if (pres_K_init(i) <= -(1d0 - 1d-8)*pres_inf(i) + 1d-8) & + pres_K_init(i) = -(1d0 - 1d-8)*pres_inf(i) + 1d-8 + else + pres_K_init(i) = 0d0 end if pres_relax = pres_relax + q_cons_vf(i + advxb - 1)%sf(j, k, l)*pres_K_init(i) end do @@ -1927,7 +1931,7 @@ contains end do !$acc loop seq - do iter = 0, 25 + do iter = 0, 49 if (DABS(f_pres) > 1d-10) then pres_relax = pres_relax - f_pres/df_pres @@ -1945,16 +1949,10 @@ contains !$acc loop seq do i = 1, num_fluids if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > sgm_eps) then - !rho_K_s(i) = q_cons_vf(i + contxb - 1)%sf(j, k, l)/ & - ! max(q_cons_vf(i + advxb - 1)%sf(j, k, l), sgm_eps) & - ! *((pres_relax + pres_inf(i))/(pres_K_init(i) + & - ! pres_inf(i)))**(1d0/gamma_min(i)) - rho_K_s(i) = q_cons_vf(i + contxb - 1)%sf(j, k, l)/ & - (max(q_cons_vf(i + advxb - 1)%sf(j, k, l), sgm_eps) & - *(gamma_min(i)*(pres_relax + pres_inf(i)) & - /(gamma_min(i)*(pres_relax + pres_inf(i)) + pres_K_init(i) - & - pres_relax))) + max(q_cons_vf(i + advxb - 1)%sf(j, k, l), sgm_eps) & + *((pres_relax + pres_inf(i))/(pres_K_init(i) + & + pres_inf(i)))**(1d0/gamma_min(i)) f_pres = f_pres + q_cons_vf(i + contxb - 1)%sf(j, k, l) & /rho_K_s(i) @@ -1970,7 +1968,7 @@ contains ! Cell update of the volume fraction !$acc loop seq do i = 1, num_fluids - !if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > sgm_eps) & + if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > sgm_eps) & q_cons_vf(i + advxb - 1)%sf(j, k, l) = q_cons_vf(i + contxb - 1)%sf(j, k, l) & /rho_K_s(i) end do @@ -2060,9 +2058,6 @@ contains end if end if - - - dyn_pres = 0d0 !$acc loop seq From 6be70cb8e1b60479c37cfd03ed47ecc0210ba148 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Tue, 11 Jun 2024 12:24:19 -0500 Subject: [PATCH 148/380] starting new branch --- submit_gpu.sh | 54 ++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 45 insertions(+), 9 deletions(-) diff --git a/submit_gpu.sh b/submit_gpu.sh index 21284621ba..e5ad46c5f4 100755 --- a/submit_gpu.sh +++ b/submit_gpu.sh @@ -1,17 +1,53 @@ ## Pre-process -#./mfc.sh run /scratch/bciv/sremillard/sph_col_2atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# sph2 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/sremillard/sph_col_50atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 1:00:00 -# sph50 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/sremillard/sph_col_20atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 1:00:00 -# sph20 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/sremillard/sph_col_10atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 1:00:00 -# sph10 -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/sph_col_20atm_BD/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# sph20prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/sph_col_35atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# sph30prp -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_10atm_quart/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 10q_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_hf/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 20fh_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_quart/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 20q_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_half/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 20h_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_50atm_quart/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 50q_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_p1/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 20p1_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_10atm_p1/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 20p1_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_35atm_p1/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 35p1_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/sph_col_10atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# sph10_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_10atm_hf/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 10fh_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_p1e/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 20p1e_prpN -t pre_process -a bciv-delta-gpu -c delta + + -#./mfc.sh run /scratch/bciv/sremillard/pert_col_2atm_tenth/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# base -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/sremillard/sph_col_1atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# sph_1 -t pre_process -a bciv-delta-gpu -c delta ## simulation -./mfc.sh run /scratch/bciv/sremillard/sph_col_50atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 5:30:00 -# sph50 -t simulation -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/sremillard/sph_col_20atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 5:30:00 -# sph20 -t simulation -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/sremillard/sph_col_10atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 5:30:00 -# sph10 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_10atm_hf/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 08:00:00 -# 10fh_sim -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/sph_col_10atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 10:00:00 -# sph10_sim -t simulation -a bciv-delta-gpu -c delta + + + + +#./mfc.sh run /scratch/bciv/sremillard/sph_col_35atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 09:00:00 -# sph35sim -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_p1/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 10:00:00 -# 20p1_sim -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_10atm_p1/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 09:00:00 -# 10p1_sim -t simulation -a bciv-delta-gpu -c delta + + +#./mfc.sh run /scratch/bciv/sremillard/sph_col_20atm_BD/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 04:30:00 -# sph20 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_10atm_quart/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# 10q -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_hf/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 07:30:00 -# 20fh -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_quart/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 07:30:00 -# 20q -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_half/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 10:00:00 -# 20h -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_50atm_quart/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 10:00:00 -# 50q -t simulation -a bciv-delta-gpu -c delta + +## post_process - Check if sim_data is TRUE!!!!! + +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_p1/3Dinput.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 03:00:00 -# 20p1_sim -t post_process -a bciv-delta-gpu -c delta + + +./mfc.sh run /scratch/bciv/sremillard/sph_col_20atm_BD/3Dinput.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:30:00 -# sph20 -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_10atm_quart/3Dinput.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:30:00 -# 10q -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_10atm_hf/3Dinput.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 02:30:00 -# 10fh -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /projects/bciv/sremillard/pert_20q/3Dinput.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 03:00:00 -# 20q -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_half/3Dinput.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:30:00 -# 20h -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_50atm_quart/3Dinput.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:30:00 -# 50q -t post_process -a bciv-delta-gpu -c delta + From 61bb1d2ad94a3175660405bbdf484117210ec239 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 11 Jun 2024 14:30:41 -0400 Subject: [PATCH 149/380] added 2D lung wave interaction problem --- examples/2D_lungwave/case.py | 129 +++++++++++++++++++++++++++++++++++ 1 file changed, 129 insertions(+) create mode 100644 examples/2D_lungwave/case.py diff --git a/examples/2D_lungwave/case.py b/examples/2D_lungwave/case.py new file mode 100644 index 0000000000..3db0c93b3c --- /dev/null +++ b/examples/2D_lungwave/case.py @@ -0,0 +1,129 @@ +#!/usr/bin/env python3 + +import math +import json + +ps = 248758.567 +gam = 1.4 +rho = 1. +c_l = math.sqrt( 1.4*ps/rho ) +vel = 230. + +leng = 1. +Ny = 100. +Nx = Ny*3 +dx = leng/Nx + +time_end = 5*leng/vel +cfl = 0.1 + +dt = cfl * dx/c_l +Nt = int(time_end/dt) + +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================================ + 'run_time_info' : 'T', + # ========================================================================== + + # Computational Domain Parameters ========================================== + 'x_domain%beg' : -leng/2., + 'x_domain%end' : leng/2+2*leng, + 'y_domain%beg' : -leng/2., + 'y_domain%end' : leng/2., + 'm' : int(Nx), + 'n' : int(Ny), + 'p' : 0, + 'dt' : dt, + 't_step_start' : 0, + 't_step_stop' : Nt, + 't_step_save' : int(Nt/20.), + # ========================================================================== + + # Simulation Algorithm Parameters ========================================== + 'num_patches' : 3, + 'model_eqns' : 2, + 'alt_soundspeed' : 'F', + 'num_fluids' : 2, + 'adv_alphan' : 'T', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'time_stepper' : 3, + 'weno_order' : 5, + 'weno_eps' : 1.E-16, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'F', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -6, + 'bc_x%end' : -6, + 'bc_y%beg' : -6, + 'bc_y%end' : -6, + # ========================================================================== + + # Formatted Database Files Structure Parameters ============================ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'T', + # ========================================================================== + + # Patch 1: Background ====================================================== + 'patch_icpp(1)%geometry' : 3, + 'patch_icpp(1)%x_centroid' : 0., + 'patch_icpp(1)%y_centroid' : 0., + 'patch_icpp(1)%length_x' : 10*leng, + 'patch_icpp(1)%length_y' : leng, + 'patch_icpp(1)%vel(1)' : vel, + 'patch_icpp(1)%vel(2)' : 0.E+00, + 'patch_icpp(1)%pres' : 101325., + 'patch_icpp(1)%alpha_rho(1)' : 1.29, + 'patch_icpp(1)%alpha_rho(2)' : 0.E+00, + 'patch_icpp(1)%alpha(1)' : 1.E+00, + 'patch_icpp(1)%alpha(2)' : 0.E+00, + # ========================================================================== + + # Patch 2: Shocked state =================================================== + 'patch_icpp(2)%geometry' : 3, + 'patch_icpp(2)%alter_patch(1)' : 'T', + 'patch_icpp(2)%x_centroid' : -3*leng/8., + 'patch_icpp(2)%y_centroid' : 0., + 'patch_icpp(2)%length_x' : leng/4., + 'patch_icpp(2)%length_y' : leng, + 'patch_icpp(2)%vel(1)' : vel, + 'patch_icpp(2)%vel(2)' : 0.E+00, + 'patch_icpp(2)%pres' : ps, + 'patch_icpp(2)%alpha_rho(1)' : 2.4, + 'patch_icpp(2)%alpha_rho(2)' : 0.E+00, + 'patch_icpp(2)%alpha(1)' : 1.E+00, + 'patch_icpp(2)%alpha(2)' : 0.E+00, + # ========================================================================== + + # Patch 3: Bubble ========================================================== + 'patch_icpp(3)%geometry' : 2, + 'patch_icpp(3)%x_centroid' : 0.E+00, + 'patch_icpp(3)%y_centroid' : 0.E+00, + 'patch_icpp(3)%radius' : leng/5., + 'patch_icpp(3)%alter_patch(1)' : 'T', + 'patch_icpp(3)%vel(1)' : 0., + 'patch_icpp(3)%vel(2)' : 0.E+00, + 'patch_icpp(3)%pres' : 101325., + 'patch_icpp(3)%alpha_rho(1)' : 0.E+00, + 'patch_icpp(3)%alpha_rho(2)' : 0.167, + 'patch_icpp(3)%alpha(1)' : 0.E+00, + 'patch_icpp(3)%alpha(2)' : 1.E+00, + # ========================================================================== + + # Fluids Physical Parameters =============================================== + 'fluid_pp(1)%gamma' : 1.E+00/(1.4E+00-1.E+00), + 'fluid_pp(1)%pi_inf' : 0., + 'fluid_pp(2)%gamma' : 1.E+00/(1.6666E+00-1.E+00), + 'fluid_pp(2)%pi_inf' : 0.E+00, +# ============================================================================== +})) + +# ============================================================================== From bcb18ea8b9868fba310ec1907a3660952e78ab83 Mon Sep 17 00:00:00 2001 From: "emma_slaght@brown.edu" Date: Tue, 11 Jun 2024 14:32:32 -0400 Subject: [PATCH 150/380] added file --- examples/2D_lungwave/case.py | 129 +++++++++++++++++++++++++++++++++++ 1 file changed, 129 insertions(+) create mode 100644 examples/2D_lungwave/case.py diff --git a/examples/2D_lungwave/case.py b/examples/2D_lungwave/case.py new file mode 100644 index 0000000000..3db0c93b3c --- /dev/null +++ b/examples/2D_lungwave/case.py @@ -0,0 +1,129 @@ +#!/usr/bin/env python3 + +import math +import json + +ps = 248758.567 +gam = 1.4 +rho = 1. +c_l = math.sqrt( 1.4*ps/rho ) +vel = 230. + +leng = 1. +Ny = 100. +Nx = Ny*3 +dx = leng/Nx + +time_end = 5*leng/vel +cfl = 0.1 + +dt = cfl * dx/c_l +Nt = int(time_end/dt) + +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================================ + 'run_time_info' : 'T', + # ========================================================================== + + # Computational Domain Parameters ========================================== + 'x_domain%beg' : -leng/2., + 'x_domain%end' : leng/2+2*leng, + 'y_domain%beg' : -leng/2., + 'y_domain%end' : leng/2., + 'm' : int(Nx), + 'n' : int(Ny), + 'p' : 0, + 'dt' : dt, + 't_step_start' : 0, + 't_step_stop' : Nt, + 't_step_save' : int(Nt/20.), + # ========================================================================== + + # Simulation Algorithm Parameters ========================================== + 'num_patches' : 3, + 'model_eqns' : 2, + 'alt_soundspeed' : 'F', + 'num_fluids' : 2, + 'adv_alphan' : 'T', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'time_stepper' : 3, + 'weno_order' : 5, + 'weno_eps' : 1.E-16, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'F', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -6, + 'bc_x%end' : -6, + 'bc_y%beg' : -6, + 'bc_y%end' : -6, + # ========================================================================== + + # Formatted Database Files Structure Parameters ============================ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'T', + # ========================================================================== + + # Patch 1: Background ====================================================== + 'patch_icpp(1)%geometry' : 3, + 'patch_icpp(1)%x_centroid' : 0., + 'patch_icpp(1)%y_centroid' : 0., + 'patch_icpp(1)%length_x' : 10*leng, + 'patch_icpp(1)%length_y' : leng, + 'patch_icpp(1)%vel(1)' : vel, + 'patch_icpp(1)%vel(2)' : 0.E+00, + 'patch_icpp(1)%pres' : 101325., + 'patch_icpp(1)%alpha_rho(1)' : 1.29, + 'patch_icpp(1)%alpha_rho(2)' : 0.E+00, + 'patch_icpp(1)%alpha(1)' : 1.E+00, + 'patch_icpp(1)%alpha(2)' : 0.E+00, + # ========================================================================== + + # Patch 2: Shocked state =================================================== + 'patch_icpp(2)%geometry' : 3, + 'patch_icpp(2)%alter_patch(1)' : 'T', + 'patch_icpp(2)%x_centroid' : -3*leng/8., + 'patch_icpp(2)%y_centroid' : 0., + 'patch_icpp(2)%length_x' : leng/4., + 'patch_icpp(2)%length_y' : leng, + 'patch_icpp(2)%vel(1)' : vel, + 'patch_icpp(2)%vel(2)' : 0.E+00, + 'patch_icpp(2)%pres' : ps, + 'patch_icpp(2)%alpha_rho(1)' : 2.4, + 'patch_icpp(2)%alpha_rho(2)' : 0.E+00, + 'patch_icpp(2)%alpha(1)' : 1.E+00, + 'patch_icpp(2)%alpha(2)' : 0.E+00, + # ========================================================================== + + # Patch 3: Bubble ========================================================== + 'patch_icpp(3)%geometry' : 2, + 'patch_icpp(3)%x_centroid' : 0.E+00, + 'patch_icpp(3)%y_centroid' : 0.E+00, + 'patch_icpp(3)%radius' : leng/5., + 'patch_icpp(3)%alter_patch(1)' : 'T', + 'patch_icpp(3)%vel(1)' : 0., + 'patch_icpp(3)%vel(2)' : 0.E+00, + 'patch_icpp(3)%pres' : 101325., + 'patch_icpp(3)%alpha_rho(1)' : 0.E+00, + 'patch_icpp(3)%alpha_rho(2)' : 0.167, + 'patch_icpp(3)%alpha(1)' : 0.E+00, + 'patch_icpp(3)%alpha(2)' : 1.E+00, + # ========================================================================== + + # Fluids Physical Parameters =============================================== + 'fluid_pp(1)%gamma' : 1.E+00/(1.4E+00-1.E+00), + 'fluid_pp(1)%pi_inf' : 0., + 'fluid_pp(2)%gamma' : 1.E+00/(1.6666E+00-1.E+00), + 'fluid_pp(2)%pi_inf' : 0.E+00, +# ============================================================================== +})) + +# ============================================================================== From 10ba6730dec2e6a0cc9099e5f9796780748345c4 Mon Sep 17 00:00:00 2001 From: "nazarii_koval@brown.edu" Date: Tue, 11 Jun 2024 14:36:05 -0400 Subject: [PATCH 151/380] added files to the lung program --- examples/2D_lungtissue/case.py | 251 ++++++++++++++++++++++ src/pre_process/include/2dHardcodedIC.fpp | 4 +- src/pre_process/m_initial_condition.fpp | 5 +- src/pre_process/m_patches.fpp | 109 ++++++++++ src/simulation/m_monopole.fpp | 13 ++ 5 files changed, 380 insertions(+), 2 deletions(-) create mode 100644 examples/2D_lungtissue/case.py diff --git a/examples/2D_lungtissue/case.py b/examples/2D_lungtissue/case.py new file mode 100644 index 0000000000..d94eceaa6a --- /dev/null +++ b/examples/2D_lungtissue/case.py @@ -0,0 +1,251 @@ +#!/usr/bin/env python3 + +import json +import math + +# Adjustung the parameters for the 2D case of U-Sound-lung tissue interaction +""" + TODO's +1. Runtime Parameters + (done) run_time_info + rdma_mpi +2. Computational Domain Parameters + (done) domain - [x,y] = [{0,1},{-20,15}] + streching? + (done) gridcells + (done) dt + (done) t_step_start + (done) t_step_stop + t_step_save + t_step_print +3. Patch Parameters + (done) geometry, density and volumetric fraction +4. Immersed Boundary Patches + geometry +5. Fluid Material's Parameters + Re(1) - sheer viscosity of the fluid (5 eq model only) + Re(2) - volume viscosity of the fluid (5 eq model only) + sigma - surface tension +6. Simulation Algorithm Parameters + BC + (done) model eq - eq.model + TBD +7. Formatted Database and Structure Parameters + TBD +8. (Optional) Acoustic Source Parameters + TBD - might be useful to implemetn US imaging +9. (Optional) Ensemble-Averaged Bubble Model Parameters +10. (Optional) Velocity Field Setup Parameters +11. (Optional) Phase Change Parameters +12. (Optional) Artificial Mach Number Parameters +""" + +#Define problem specific variables + + #refference values (water, characteristic lenght) +rho_0 = 996. #kg/m3 +c_0 = 1648.7 #m/s spped of sound +l_0 = 200.E-6 #length scale um +p_0 = rho_0*c_0*c_0 #characteristic pressure + + #define non-dim +N = 100 #points per l +dx = 1/(N-1) #dx of the grid +l_t = 15 #y-scaling +l_b = 20 #y-scaling + + #dimensional parameters (air at 300K) +p_atm = 101325 #Pa + #air +rho_a = 1.18/rho_0 #density air +c_a = 347.2/c_0 #speed of sound in water +n_a = 1.4 #stiffened EoS constant +B_a = 0 #stiffened EoS constant + #water +rho_w = 996./rho_0 #density water +c_w = 1648.7/c_0 #spped of sound in air +n_w = 5.5 #stiffened EoS constant +B_w = 492.E+6/p_0 #stiffened EoS constant + + #time settings (followed 2D_whale_bubble_annulus) +cfl = 0.25 #cfl condition +t_char = l_0/c_0 #s characteristic timescale +dt = cfl*t_char #s time step +L = 1000*l_0 #m total distance travelled by the wave +Tfinal = L/c_0 #s final time of the simulation +N_steps = int(Tfinal/dt) #number of steps the simulation will run (4000) + +''' + #time settings (followed 2D_whale_bubble_annulus) +u0 = math.sqrt(p_atm/rho_w) #refference velocity +cfl = 0.25 #cfl condition +dt = cfl*dx*u0/c_w #time step calculated +Tfinal = 5 #final time of the simulation +N_steps = int(Tfinal/dt) #number of steps the simulation will run +''' + + #DUS settings +P_amp = 10.E+6/p_0 +P_len = 45 #length of the impulse +theta = -math.pi/2 #direction of propagation + + #membrane setting +a_0 = 0.03 #amplitude +y_l_top = f"{l_t}-{a_0}*sin(2*pi*x/{1}-pi/2)" +#y_l_bot = f"{l_b}+{a_0}*sin(2*pi*x/{1}-pi/2)" + + +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================================ + 'run_time_info' : 'T', + # ========================================================================== + + # Computational Domain Parameters ========================================== + + # The domain consists of 2 regions with a membrane inwetween. The origin is + # set on the left end of the membrane. The domain of interest. y: -20l to 15l + 'x_domain%beg' : 0, # update + 'x_domain%end' : 1, # update + 'y_domain%beg' : -l_b, # update + 'y_domain%end' : l_t, # update + # Grid stretching is used in the all coordinate directions + # to minimize computational costs. The grid is coarsened + # away from the bubble / origin + #might not need + 'stretch_x' : 'T', + 'a_x' : 4.E+00, + 'x_a' : -1.5E-03/1.E-03, + 'x_b' : 1.5E-03/1.E-03, + 'stretch_y' : 'T', + 'a_y' : 4.E+00, + 'y_a' : -1.5E-03/1.E-03, + 'y_b' : 1.5E-03/1.E-03, + # grid sells setup - m=x,n=y,p=z + 'm' : int(N-1), # update + 'n' : int((l_t+l_b)*N-1), # update + # time setup + 'dt' : dt, # update : see above + 't_step_start' : 0, # update : start at 0 + 't_step_stop' : N_steps, # update : number of iterations + 't_step_save' : 10, + # ========================================================================== + + # Simulation Algorithm Parameters ========================================== + # Only two patches are necesssary, the liquid(tissue) and the + # gas(lung) + 'num_patches' : 2, # update: Tissue and Lung + # Use the 5 equation model + 'model_eqns' : 2, # update: number of equations is 5 + # 6 equations model does not need the K \div(u) term + 'alt_soundspeed' : 'F', + + # num_fluids defines the total number of fluids defined in each of the + # patches. + 'num_fluids' : 2, # update: each patch has 2 fluid associated with it + # Advect both volume fractions + 'adv_alphan' : 'T', + # Ensure the volume fractions sum to unity at the end of each + # time step + 'mpp_lim' : 'T', + # Correct errors when computing speed of sound + 'mixture_err' : 'T', + # Use TVD RK3 for time marching + 'time_stepper' : 3, # update: tvdrk3 + # Use WENO5 + 'weno_order' : 5, # update + 'weno_eps' : 1.E-16, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'avg_state' : 2, + # Use the mapped WENO weights to maintain monotinicity + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'F', + # Use the HLL Riemann solver + 'riemann_solver' : 1, # update : 1=HLL + 'wave_speeds' : 1, + + # We will use symmetric BC at the x-boundaries. THe bottom booundary needs + # to be at a zero gradient. Top - non-reflective boundary conditions + 'bc_x%beg' : -1, # update : used periodec + 'bc_x%end' : -1, # update : used periodic + 'bc_y%beg' : -6, # update : used non-reflecting subsonic buffer + 'bc_y%end' : -6, # update : used non-reflecting subsonic buffer + # ========================================================================== + + # Formatted Database Files Structure Parameters ============================ + # Export primitive variables in double precision with parallel + # I/O to minimize I/O computational time during large simulations + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'T', + # ========================================================================== + + # For now setting the the patches geometry to be rectangles with a + # varible y lenght: + # Patch 1: yl = 15-a_0*sin(2*pi*x/l-pi/2) + # Patch 2: yb = 20+a_0*sin(2*pi*x/l-pi/2) + + # Patch 1: Air (Lung) ====================================================== + # Specify the gas grid geometry + 'patch_icpp(1)%geometry' : 3, # update : assumes to be a rectangle + 'patch_icpp(1)%x_centroid' : 1/2, # update : x_centroid = 0.5l + 'patch_icpp(1)%y_centroid' : (l_t-l_b)/2, # update : y_centroid = -10l + 'patch_icpp(1)%length_x' : 1, # update : x_l = l + 'patch_icpp(1)%length_y' : l_t+l_b, # update : y_l = function of position + # Specify the patch primitive variables + 'patch_icpp(1)%vel(1)' : 0.E+00, # update : no initial velocity + 'patch_icpp(1)%vel(2)' : 0.E+00, # update : no initial velocity + 'patch_icpp(1)%pres' : p_atm/p_0, # update : assume atmospheric pressure + 'patch_icpp(1)%alpha_rho(1)' : 0.E+00, # update : Partial density of fluid 1 in patch 2 (no water) + 'patch_icpp(1)%alpha_rho(2)' : rho_a, # update : Partial density of fluid 2 in patch 2 (air only) + 'patch_icpp(1)%alpha(1)' : 0.E+00, # update : volume fraction of fluid 1 in patch 2 (no water) + 'patch_icpp(1)%alpha(2)' : 1.E+00, # update : volume fraction of fluid 2 in patch 2 (air only) + # ========================================================================== + + # Patch 2: Water(Tisue) ==================================================== + # Specify the water background grid geometry + 'patch_icpp(2)%geometry' : 3, # update : assumes to be a rectangle + #'patch_icpp(2)%hcid' : 205, # update : hardcoded geometry of the patch + 'patch_icpp(2)%alter_patch(1)' : 'T', + 'patch_icpp(2)%x_centroid' : 1/2, # update : x_centroid = 0.5l + 'patch_icpp(2)%y_centroid' : l_t/2, # update : y_centorid = 7.5l + 'patch_icpp(2)%length_x' : 1, # update : x_l = l + 'patch_icpp(2)%length_y' : l_t, # update : y_l = fucntion of position, y_l_top - didnot accept str + # Specify the patch primitive variables + 'patch_icpp(2)%vel(1)' : 0.E+00, # update : no initial velocity + 'patch_icpp(2)%vel(2)' : 0.E+00, # update : no initial velocity + 'patch_icpp(2)%pres' : p_atm/p_0, # update : assume atmospheric pressure + 'patch_icpp(2)%alpha_rho(1)' : rho_w, # update : Partial density of fluid 1 in patch 1 (water only) + 'patch_icpp(2)%alpha_rho(2)' : 0.E+00, # update : Partial density of fluid 2 in patch 1 (no air) + 'patch_icpp(2)%alpha(1)' : 1.E+00, # update : volume fraction of fluid 1 in patch 1 (water only) + 'patch_icpp(2)%alpha(2)' : 0.E+00, # update : volume fraction of fluid 2 in patch 1 (no air) + # ========================================================================== + + # Fluids Physical Parameters =============================================== + # Fluid 1 - water ; Fluid 2 - air + 'fluid_pp(1)%gamma' : 1.E+00/(n_w-1.E+00), # update : refferenced 2D_whale_bubble_annulus example for the formula + 'fluid_pp(1)%pi_inf' : n_w*B_w/(n_w-1.E+00), # update : refferenced 2D_whale_bubble_annulus example for the formula + 'fluid_pp(2)%gamma' : 1.E+00/(n_a-1.E+00), # update : refferenced 2D_whale_bubble_annulus example for the formula + 'fluid_pp(2)%pi_inf' : 0.E+00, # update : air has liquid stiffness = 0 + # ========================================================================== + + # Acoustic Wave source ===================================================== + # The acoustic wave is placed at y = 15, ?at each node along the boundary? + 'Monopole' : 'T', # update : creating an acoustic wave + 'num_mono' : 1, # update : place in the middle and expand + 'Mono(1)%pulse' : 3, # update : square wave + 'Mono(1)%npulse' : 1, # update : 1 impulse + 'Mono(1)%mag' : P_amp, # update : magnitude + 'Mono(1)%length' : P_len, # update : impulse length + 'Mono(1)%support' : 2, # update : 2D semi infinite plane (x: -inf,inf; y:-len/2, len/2) + 'Mono(1)%loc(1)' : 0.5, # update : x_center of the domain + 'Mono(1)%loc(2)' : 15, # update : upper boundary of the domain + 'Mono(1)%dir' : theta, # update : direction: -pi/2 + 'Mono(1)%support_width' : 49, # update : 49 cells in each direction + +})) + +# ============================================================================== \ No newline at end of file diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp index 7d6ee9602b..52fbce363e 100644 --- a/src/pre_process/include/2dHardcodedIC.fpp +++ b/src/pre_process/include/2dHardcodedIC.fpp @@ -2,8 +2,8 @@ real(kind(0d0)) :: eps real(kind(0d0)) :: r, rmax, gam, umax, p0 - real(kind(0d0)) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph + real(kind(0d0)) :: a_0, l_t eps = 1e-9 @@ -100,6 +100,8 @@ q_prim_vf(E_idx)%sf(i, j, 0) = pInt + rhoL*9.81*(intH - y_cc(j)) end if + case (205) ! 2D lung simulation + case default if (proc_rank == 0) then call s_int_to_str(patch_id, iStr) diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp index dc29206d8f..22bc90da01 100644 --- a/src/pre_process/m_initial_condition.fpp +++ b/src/pre_process/m_initial_condition.fpp @@ -257,7 +257,10 @@ contains ! STL patch elseif (patch_icpp(i)%geometry == 21) then call s_model(i, patch_id_fp, q_prim_vf) - + + elseif (patch_icpp(i)%geometry == 22) then + call s_2D_lung(i, patch_id_fp, q_prim_vf, .false.) + end if !> @} end do diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index 2ef618ff94..55bfa45e50 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -49,6 +49,9 @@ module m_patches s_cuboid, & s_cylinder, & s_sweep_plane, & + !Naz adding stuff + s_2D_lung, & + !Naz adding stuff s_model real(kind(0d0)) :: x_centroid, y_centroid, z_centroid @@ -2031,6 +2034,112 @@ contains end subroutine s_sweep_plane ! ----------------------------------------- + !Naz changing the code below + + !> The lung 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 + subroutine s_2D_lung(patch_id, patch_id_fp, q_prim_vf, ib) ! ------------------------------------- + + 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) :: q_prim_vf + + real(kind(0d0)) :: pi_inf, gamma, lit_gamma !< Equation of state parameters + logical :: ib !< True if this patch is an immersed boundary + + integer :: i, j, k !< generic loop iterators + + pi_inf = fluid_pp(1)%pi_inf + gamma = fluid_pp(1)%gamma + lit_gamma = (1d0 + gamma)/gamma + + ! Transferring the rectangle's centroid and length information + if (.not. ib) then + 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 + else + 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 + 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.5d0*length_x + x_boundary%end = x_centroid + 0.5d0*length_x + y_boundary%beg = y_centroid - 0.5d0*length_y - 0.03 + y_boundary%end = y_centroid + 0.5d0*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 = 1d0 + + ! 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 (.not. ib) then + if (x_boundary%beg <= x_cc(i) .and. & + x_boundary%end >= x_cc(i) .and. & + (y_boundary%beg+0.03*sin(2*pi*x_cc(i)-pi/2)) <= 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() + + 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))**(1d0/lit_gamma))* & + rhoref*(1d0 - q_prim_vf(alf_idx)%sf(i, j, 0)) + end if + + ! Updating the patch identities bookkeeping variable + if (1d0 - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + + end if + end if + + if (ib .and. x_boundary%beg <= x_cc(i) .and. & + x_boundary%end >= x_cc(i) .and. & + y_boundary%beg+0.03*sin(2*pi*x_cc(i)-pi/2) <= y_cc(j) .and. & + y_boundary%end >= y_cc(j)) & + then + + patch_id_fp(i, j, 0) = patch_id + + end if + + end do + end do + + end subroutine s_2d_lung ! ------------------------------------------- + + !Naz changing the code above + + !> The STL patch is a 2/3D geometry that is imported from an STL file. !! @param patch_id is the patch identifier subroutine s_model(patch_id, patch_id_fp, q_prim_vf) ! --------------------- diff --git a/src/simulation/m_monopole.fpp b/src/simulation/m_monopole.fpp index 3c316d07e7..c5ad184858 100644 --- a/src/simulation/m_monopole.fpp +++ b/src/simulation/m_monopole.fpp @@ -331,6 +331,19 @@ contains if (the_time > t0 .and. the_time < sigt) then f_g = mag(nm) end if + + else if (pulse(nm) == 4) then + ! Ultrasound pulse wave + period = length(nm)/sos + f_g = mag(nm)*cos((the_time + offset)*2.d0*pi/period)*EXP(-x**2/100) + + else if (pulse(nm) == 5) then + ! Trapesoidal wave + + if + else if + + else end if From 856db65b1933c06879d4f42cbfe51b7bb1d16890 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Wed, 12 Jun 2024 08:11:41 -0500 Subject: [PATCH 152/380] added G contirbution in speed of sound calc and adjusted in m_data_out. in sim --- src/common/include/inline_conversions.fpp | 29 ++++++++++++++++------- src/post_process/m_data_output.fpp | 2 +- src/simulation/m_data_output.fpp | 6 +++-- 3 files changed, 26 insertions(+), 11 deletions(-) diff --git a/src/common/include/inline_conversions.fpp b/src/common/include/inline_conversions.fpp index 4f455c511d..ffbd438678 100644 --- a/src/common/include/inline_conversions.fpp +++ b/src/common/include/inline_conversions.fpp @@ -1,5 +1,5 @@ #:def s_compute_speed_of_sound() - subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c) + subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c, G) #ifdef CRAY_ACC_WAR !DIR$ INLINEALWAYS s_compute_speed_of_sound #else @@ -11,17 +11,30 @@ real(kind(0d0)), dimension(num_fluids), intent(IN) :: adv real(kind(0d0)), intent(IN) :: vel_sum real(kind(0d0)), intent(OUT) :: c + real(kind(0d0)), dimension(num_fluids), intent(IN), optional :: G - real(kind(0d0)) :: blkmod1, blkmod2 + real(kind(0d0)), dimension(num_fluids) :: blkmod - integer :: q + integer :: q, i if (alt_soundspeed) then - blkmod1 = ((gammas(1) + 1d0)*pres + & - pi_infs(1))/gammas(1) - blkmod2 = ((gammas(2) + 1d0)*pres + & - pi_infs(2))/gammas(2) - c = (1d0/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2))) + c = 0d0 + do i = 1, num_fluids + if (hypoelasticity) then + blkmod(i) = ((gammas(i) + 1d0)*pres + & + pi_infs(i))/gammas(i)+4/3*G(i) + else + blkmod(i) = ((gammas(i) + 1d0)*pres + & + pi_infs(i))/gammas(i) + end if + c = c + adv(i)/blkmod(i) + end do + c = 1d0/(rho*c) +! blkmod1 = ((gammas(1) + 1d0)*pres + & +! pi_infs(1))/gammas(1) +! blkmod2 = ((gammas(2) + 1d0)*pres + & +! pi_infs(2))/gammas(2) +! c = (1d0/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2))) elseif (model_eqns == 3) then c = 0d0 !$acc loop seq diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 68e5d9d659..2551bc2625 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -1009,7 +1009,7 @@ contains cent = l end if end do - thres = 0.9d0 + thres = 0.9d0*max_alph_glb do k = 0, n OLoop: do j = 0, m axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 87525dfc60..49b9abf1e9 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -277,6 +277,7 @@ contains real(kind(0d0)) :: vel_sum !< Cell-avg. velocity sum real(kind(0d0)) :: pres !< Cell-avg. pressure real(kind(0d0)), dimension(num_fluids) :: alpha !< Cell-avg. volume fraction + real(kind(0d0)), dimension(num_fluids) :: G_K real(kind(0d0)) :: gamma !< Cell-avg. sp. heat ratio real(kind(0d0)) :: pi_inf !< Cell-avg. liquid stiffness function real(kind(0d0)) :: qv !< Cell-avg. fluid reference energy @@ -302,7 +303,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - + G_K(:) = fluid_pp(:)%G !SGR Reinitialize a vector for shear moduli do i = 1, num_fluids alpha_rho(i) = q_prim_vf(i)%sf(j, k, l) alpha(i) = q_prim_vf(E_idx + i)%sf(j, k, l) @@ -330,7 +331,8 @@ contains H = (E + pres)/rho ! Compute mixture sound speed - call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c) + call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c, G_K) + !SGR added G here for speed of sound if ( c .lt. 10d-12 ) then print*, 'code has crashed at processor: ',proc_rank,' at j :: ',j,', k :: ',k,' l :: ',l,'with alph1a ::',alpha(1),'and alpha2 ::', alpha(2) From 5e7a572cd20f750821f7f79d07a0a041e6219b96 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Wed, 12 Jun 2024 10:39:49 -0500 Subject: [PATCH 153/380] all is done in hllc for hypo besides the flux computation --- src/common/include/inline_conversions.fpp | 1 + src/simulation/m_data_output.fpp | 9 +-- src/simulation/m_riemann_solvers.fpp | 93 +++++++++++++++++++---- 3 files changed, 82 insertions(+), 21 deletions(-) diff --git a/src/common/include/inline_conversions.fpp b/src/common/include/inline_conversions.fpp index ffbd438678..bfdc1344fd 100644 --- a/src/common/include/inline_conversions.fpp +++ b/src/common/include/inline_conversions.fpp @@ -19,6 +19,7 @@ if (alt_soundspeed) then c = 0d0 + !$acc loop seq do i = 1, num_fluids if (hypoelasticity) then blkmod(i) = ((gammas(i) + 1d0)*pres + & diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 49b9abf1e9..1546097b2c 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -303,7 +303,6 @@ contains do l = 0, p do k = 0, n do j = 0, m - G_K(:) = fluid_pp(:)%G !SGR Reinitialize a vector for shear moduli do i = 1, num_fluids alpha_rho(i) = q_prim_vf(i)%sf(j, k, l) alpha(i) = q_prim_vf(E_idx + i)%sf(j, k, l) @@ -331,7 +330,7 @@ contains H = (E + pres)/rho ! Compute mixture sound speed - call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c, G_K) + call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c, fluid_pp(:)%G) !SGR added G here for speed of sound if ( c .lt. 10d-12 ) then @@ -1297,7 +1296,7 @@ contains ! Compute mixture sound Speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & - ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) + ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c, fluid_pp(:)%G) accel = accel_mag(j - 2, k, l) end if @@ -1372,7 +1371,7 @@ contains end if ! Compute mixture sound speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & - ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) + ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c, fluid_pp(:)%G) end if end if @@ -1424,7 +1423,7 @@ contains ! Compute mixture sound speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & - ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) + ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c, fluid_pp(:)%G) accel = accel_mag(j - 2, k - 2, l - 2) end if diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index b0295f971d..7926a5f2b0 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -509,16 +509,18 @@ contains @:compute_average_state() call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & - vel_L_rms, c_L) + vel_L_rms, c_L, Gs) call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & - vel_R_rms, c_R) + vel_R_rms, c_R, Gs) !> The computation of c_avg does not require all the variables, and therefore the non '_avg' ! variables are placeholders to call the subroutine. call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & - vel_avg_rms, c_avg) + vel_avg_rms, c_avg, Gs) + + !SGR added Gs to all of the above speed of sound clacs if (any(Re_size > 0)) then !$acc loop seq @@ -863,6 +865,9 @@ contains real(kind(0d0)) :: xi_L, xi_R !< Left and right wave speeds functions real(kind(0d0)) :: xi_M, xi_P + real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R + real(kind(0d0)) :: G_L, G_R + real(kind(0d0)) :: nbub_L, nbub_R real(kind(0d0)), dimension(nb) :: R0_L, R0_R real(kind(0d0)), dimension(nb) :: V0_L, V0_R @@ -1966,7 +1971,7 @@ contains end do !$acc end parallel loop else - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, & !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms) copyin(is1,is2,is3) do l = is3%beg, is3%end do k = is2%beg, is2%end @@ -2083,20 +2088,53 @@ contains H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R + + if (hypoelasticity) then + !$acc loop seq + do i = 1, strxe - strxb + 1 + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + end do + + G_L = 0d0 + G_R = 0d0 + !$acc loop seq + do i = 1, num_fluids + G_L = G_L + alpha_L(i)*Gs(i) + G_R = G_R + alpha_R(i)*Gs(i) + end do + + do i = 1, strxe - strxb + 1 + ! Elastic contribution to energy if G large enough + !TODO take out if statement if stable without + if ((G_L > 1000) .and. (G_R > 1000)) then + E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) + E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) + ! Additional terms in 2D and 3D + if ((i == 2) .or. (i == 4) .or. (i == 5)) then + E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) + E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) + end if + end if + end do + end if + !SGR Added exact code from hll here + @:compute_average_state() call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & - vel_L_rms, c_L) + vel_L_rms, c_L, Gs) call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & - vel_R_rms, c_R) + vel_R_rms, c_R, Gs) !> The computation of c_avg does not require all the variables, and therefore the non '_avg' ! variables are placeholders to call the subroutine. call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & - vel_avg_rms, c_avg) + vel_avg_rms, c_avg, Gs) + !SGR added Gs contribution to the speed of sound if (any(Re_size > 0)) then !$acc loop seq @@ -2106,15 +2144,38 @@ contains end if if (wave_speeds == 1) then - s_L = min(vel_L(idx1) - c_L, vel_R(idx1) - c_R) - s_R = max(vel_R(idx1) + c_R, vel_L(idx1) + c_L) - - s_S = (pres_R - pres_L + rho_L*vel_L(idx1)* & - (s_L - vel_L(idx1)) - & - rho_R*vel_R(idx1)* & - (s_R - vel_R(idx1))) & - /(rho_L*(s_L - vel_L(idx1)) - & - rho_R*(s_R - vel_R(idx1))) + if (hypoelasticity) then + s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + & + tau_e_L(dir_idx_tau(1)))/rho_L) & + , vel_R(dir_idx(1)) - sqrt(c_R*c_R + & + (((4d0*G_R)/3d0) + & + tau_e_R(dir_idx_tau(1)))/rho_R)) + s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & + (((4d0*G_R)/3d0) + & + tau_e_R(dir_idx_tau(1)))/rho_R) & + , vel_L(dir_idx(1)) + sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + & + tau_e_L(dir_idx_tau(1)))/rho_L)) + s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & + tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)* & + (s_L - vel_L(idx1)) - & + rho_R*vel_R(idx1)* & + (s_R - vel_R(idx1))) & + /(rho_L*(s_L - vel_L(idx1)) - & + rho_R*(s_R - vel_R(idx1))) + + else + s_L = min(vel_L(idx1) - c_L, vel_R(idx1) - c_R) + s_R = max(vel_R(idx1) + c_R, vel_L(idx1) + c_L) + + s_S = (pres_R - pres_L + rho_L*vel_L(idx1)* & + (s_L - vel_L(idx1)) - & + rho_R*vel_R(idx1)* & + (s_R - vel_R(idx1))) & + /(rho_L*(s_L - vel_L(idx1)) - & + rho_R*(s_R - vel_R(idx1))) + end if elseif (wave_speeds == 2) then pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & From bc90361ff4aaa468020a94741d47cc65b62eb12f Mon Sep 17 00:00:00 2001 From: "emma_slaght@brown.edu" Date: Wed, 12 Jun 2024 15:17:15 -0400 Subject: [PATCH 154/380] added lung case file, 2dhardocde initial condition --- examples/2D_lungwave/case.py | 169 ++++++++++++++-------- src/pre_process/include/2dHardcodedIC.fpp | 39 ++++- 2 files changed, 144 insertions(+), 64 deletions(-) diff --git a/examples/2D_lungwave/case.py b/examples/2D_lungwave/case.py index 3db0c93b3c..7d8bf8d152 100644 --- a/examples/2D_lungwave/case.py +++ b/examples/2D_lungwave/case.py @@ -3,22 +3,80 @@ import math import json -ps = 248758.567 -gam = 1.4 -rho = 1. -c_l = math.sqrt( 1.4*ps/rho ) -vel = 230. - -leng = 1. -Ny = 100. -Nx = Ny*3 -dx = leng/Nx - -time_end = 5*leng/vel +# material parameters +# material 1 :: gas +# Patterson 2018 et al. +gammag = 1.4 # unitless +Bg = 0. # Pascals +rhog = 1.18 # kg/m^3 +c_g = 347.2 # m/sec +Gg = 0. # Pascals + + +# material 2: lung +# Patterson 2018 et al. +gammal = 5.5 # unitless +Bl = 492E+06 # pascals. +rhol = 996.0 # kg/m^3 +c_l = 1648.7 # m/sec +Gl = 1E3 # Pascals, homework ! + +# primitive variables (if any) +patmos = 101325.0 # Pascals, at Standard temperature and pressue + + +# problem specific variable +lambda_wave = 1.E-3 # meters + +# non-dimensionalization +# define a characteristic density, length, time, and stress +rho_char = rhog +length = lambda_wave +vel_char = c_g +time_char = length/vel_char +stress_char = rho_char*vel_char*vel_char/gammag + + +# nondimensionalize the material properties +rhog_n = rhog/rho_char +c_g_n = c_g/vel_char +Bg_n = Bg/stress_char +Gg_n = Gg/stress_char + +rhol_n = rhol/rho_char +c_l_n = c_l/vel_char +Bl_n = Bl/stress_char +Gl_n = Gl/stress_char + +patmos_n = patmos/stress_char + +# spatial geometry +dlengx = 1.0 +dlengy = 20. +Nx = 200 +Ny = dlengy*Nx + +dx = dlengx/Nx +dy = dlengy/Ny + +alphal_back = 1.0 +alphag_back = 0.0 + +alphal_lung = 0.0 +alphag_lung = 1.0 + +interface_amp = 0.5 + +# time stepping requirements +time_end = 5.0 cfl = 0.1 dt = cfl * dx/c_l Nt = int(time_end/dt) +Nframes = 60 +tstart = 0 +tstop = Nt +tsave = int(Nt/Nframes) # Configuring case dictionary print(json.dumps({ @@ -27,21 +85,21 @@ # ========================================================================== # Computational Domain Parameters ========================================== - 'x_domain%beg' : -leng/2., - 'x_domain%end' : leng/2+2*leng, - 'y_domain%beg' : -leng/2., - 'y_domain%end' : leng/2., + 'x_domain%beg' : 0, + 'x_domain%end' : dlengx, + 'y_domain%beg' : -dlengy/2., + 'y_domain%end' : dlengy/2., 'm' : int(Nx), 'n' : int(Ny), 'p' : 0, 'dt' : dt, - 't_step_start' : 0, - 't_step_stop' : Nt, - 't_step_save' : int(Nt/20.), + 't_step_start' : tstart, + 't_step_stop' : tstop, + 't_step_save' : tsave, # ========================================================================== # Simulation Algorithm Parameters ========================================== - 'num_patches' : 3, + 'num_patches' : 2, 'model_eqns' : 2, 'alt_soundspeed' : 'F', 'num_fluids' : 2, @@ -55,12 +113,12 @@ 'weno_avg' : 'F', 'mapped_weno' : 'T', 'null_weights' : 'F', - 'mp_weno' : 'F', + 'mp_weno' : 'T', 'riemann_solver' : 2, 'wave_speeds' : 1, 'avg_state' : 2, - 'bc_x%beg' : -6, - 'bc_x%end' : -6, + 'bc_x%beg' : -1, + 'bc_x%end' : -1, 'bc_y%beg' : -6, 'bc_y%end' : -6, # ========================================================================== @@ -74,55 +132,42 @@ # Patch 1: Background ====================================================== 'patch_icpp(1)%geometry' : 3, - 'patch_icpp(1)%x_centroid' : 0., + 'patch_icpp(1)%x_centroid' : dlengx/2.0, 'patch_icpp(1)%y_centroid' : 0., - 'patch_icpp(1)%length_x' : 10*leng, - 'patch_icpp(1)%length_y' : leng, - 'patch_icpp(1)%vel(1)' : vel, + 'patch_icpp(1)%length_x' : dlengx, + 'patch_icpp(1)%length_y' : dlengy, + 'patch_icpp(1)%vel(1)' : 0.E+00, 'patch_icpp(1)%vel(2)' : 0.E+00, - 'patch_icpp(1)%pres' : 101325., - 'patch_icpp(1)%alpha_rho(1)' : 1.29, - 'patch_icpp(1)%alpha_rho(2)' : 0.E+00, - 'patch_icpp(1)%alpha(1)' : 1.E+00, - 'patch_icpp(1)%alpha(2)' : 0.E+00, + 'patch_icpp(1)%pres' : patmos_n, + 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, + 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, + 'patch_icpp(1)%alpha(1)' : alphal_back, + 'patch_icpp(1)%alpha(2)' : alphag_back, # ========================================================================== # Patch 2: Shocked state =================================================== - 'patch_icpp(2)%geometry' : 3, + 'patch_icpp(2)%geometry' : 7, + 'patch_icpp(2)%hcid' : 205, 'patch_icpp(2)%alter_patch(1)' : 'T', - 'patch_icpp(2)%x_centroid' : -3*leng/8., - 'patch_icpp(2)%y_centroid' : 0., - 'patch_icpp(2)%length_x' : leng/4., - 'patch_icpp(2)%length_y' : leng, - 'patch_icpp(2)%vel(1)' : vel, + 'patch_icpp(2)%x_centroid' : dlengx/2.0, + 'patch_icpp(2)%y_centroid' : -dlengy/4.0, + 'patch_icpp(2)%length_x' : dlengx, + 'patch_icpp(2)%length_y' : dlengy/2.0 + 2.0, + 'patch_icpp(2)%a2' : interface_amp, + 'patch_icpp(2)%vel(1)' : 0.E+00, 'patch_icpp(2)%vel(2)' : 0.E+00, - 'patch_icpp(2)%pres' : ps, - 'patch_icpp(2)%alpha_rho(1)' : 2.4, - 'patch_icpp(2)%alpha_rho(2)' : 0.E+00, - 'patch_icpp(2)%alpha(1)' : 1.E+00, - 'patch_icpp(2)%alpha(2)' : 0.E+00, - # ========================================================================== - - # Patch 3: Bubble ========================================================== - 'patch_icpp(3)%geometry' : 2, - 'patch_icpp(3)%x_centroid' : 0.E+00, - 'patch_icpp(3)%y_centroid' : 0.E+00, - 'patch_icpp(3)%radius' : leng/5., - 'patch_icpp(3)%alter_patch(1)' : 'T', - 'patch_icpp(3)%vel(1)' : 0., - 'patch_icpp(3)%vel(2)' : 0.E+00, - 'patch_icpp(3)%pres' : 101325., - 'patch_icpp(3)%alpha_rho(1)' : 0.E+00, - 'patch_icpp(3)%alpha_rho(2)' : 0.167, - 'patch_icpp(3)%alpha(1)' : 0.E+00, - 'patch_icpp(3)%alpha(2)' : 1.E+00, + 'patch_icpp(2)%pres' : patmos_n, + 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, + 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, + 'patch_icpp(2)%alpha(1)' : alphal_lung, + 'patch_icpp(2)%alpha(2)' : alphag_lung, # ========================================================================== # Fluids Physical Parameters =============================================== - 'fluid_pp(1)%gamma' : 1.E+00/(1.4E+00-1.E+00), - 'fluid_pp(1)%pi_inf' : 0., - 'fluid_pp(2)%gamma' : 1.E+00/(1.6666E+00-1.E+00), - 'fluid_pp(2)%pi_inf' : 0.E+00, + 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), + 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), + 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), + 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), # ============================================================================== })) diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp index 7d6ee9602b..b809b6257e 100644 --- a/src/pre_process/include/2dHardcodedIC.fpp +++ b/src/pre_process/include/2dHardcodedIC.fpp @@ -68,7 +68,7 @@ q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(E_idx)%sf(i, j, 0)**(1d0/gam) - case (204) ! Rayleigh-Taylor instability + case (204) ! Rayleigh-taylor problem rhoH = 3 rhoL = 1 pRef = 1e5 @@ -100,7 +100,42 @@ q_prim_vf(E_idx)%sf(i, j, 0) = pInt + rhoL*9.81*(intH - y_cc(j)) end if - case default + + + case (205) ! Lung-wave interaction problem + ! rhoH = patch_icpp(patch_id)%pres + ! rhoL = patch_icpp(patch_id)%pres + ! pRef = 1e5 + !pInt = patch_icpp(patch_id)%pres + h = 0.0 ! non-dimensional y-origin + lam = 1.0 ! non-dimensional wavelength of 1 + wl = 1.0 ! non-dimensional wavelength of 1 + amp = patch_icpp(patch_id)%a2 ! non-dimensional amplitude of the interface + + ! this is the interface function + intH = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h + ! this is the volume fraction of the air + ! alph = 1.0 + !alph = 5d-1*(1 + tanh((y_cc(j) - intH)/2.5e-3)) + + ! if (alph < eps) alph = eps + ! if (alph > 1 - eps) alph = 1 - eps + + ! if (y_cc(j) > intH) then ! this is the liquid + ! q_prim_vf(advxb)%sf(i, j, 0) = alph + ! q_prim_vf(advxe)%sf(i, j, 0) = 1 - alph + ! q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoH + ! q_prim_vf(contxe)%sf(i, j, 0) = (1 - alph)*rhoL + !q_prim_vf(E_idx)%sf(i, j, 0) = pref + rhoH*9.81*(1.2 - y_cc(j)) + if (y_cc(j) > intH) then ! this is the lungh with air + q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) + q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) + q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) + q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) + q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres + end if +!patch id counter + case default if (proc_rank == 0) then call s_int_to_str(patch_id, iStr) call s_mpi_abort("Invalid hcid specified for patch "//trim(iStr)) From b687d6a223463b07416574cf1fb191b48d78cf3b Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 12 Jun 2024 15:17:40 -0400 Subject: [PATCH 155/380] added lung case file in examples and 2D hardcode ic --- examples/2D_lungwave/case.py | 168 ++++++++++++++-------- src/pre_process/include/2dHardcodedIC.fpp | 28 ++++ 2 files changed, 133 insertions(+), 63 deletions(-) diff --git a/examples/2D_lungwave/case.py b/examples/2D_lungwave/case.py index 3db0c93b3c..9a3fa1d099 100644 --- a/examples/2D_lungwave/case.py +++ b/examples/2D_lungwave/case.py @@ -3,22 +3,77 @@ import math import json -ps = 248758.567 -gam = 1.4 -rho = 1. -c_l = math.sqrt( 1.4*ps/rho ) -vel = 230. - -leng = 1. -Ny = 100. -Nx = Ny*3 -dx = leng/Nx - -time_end = 5*leng/vel +# material parameters +# material 1 :: gas +# Patterson 2018 et al. +gammag = 1.4 # unitless +Bg = 0. # Pascals +rhog = 1.18 # kg/m^3 +c_g = 347.2 # m/sec +Gg = 0. # Pascals + +# material 2: lung +# Patterson 2018 et al. +gammal = 5.5 # unitless +Bl = 492E+06 # Pascals +rhol = 996.0 # kg/m^3 +c_l = 1648.7 # m/sec +Gl = 1E3 # Pascals, homework! + +# primitive variables (if any) +patmos = 101325.0 # Pascals, at Standard temperature and pressure + +# problem specific variable +lambda_wave = 1E-3 # meters + +# non-dimensionalization +# define a characteristic density, length, time, and stress +rho_char = rhog +length_char = lambda_wave +vel_char = c_g +time_char = length_char/vel_char +stress_char = rho_char*vel_char*vel_char/gammag + +# nondimensionalize the material properties +rhog_n = rhog/rho_char +c_g_n = c_g/vel_char +Bg_n = Bg/stress_char +Gg_n = Gg/stress_char + +rhol_n = rhol/rho_char +c_l_n = c_l/vel_char +Bl_n = Bl/stress_char +Gl_n = Gl/stress_char + +patmos_n = patmos/stress_char + +# spatial geometry +dlengx = 1.0 +dlengy = 20. +Nx = 200 +Ny = dlengy*Nx + +dx = dlengx/Nx +dy = dlengy/Ny + +alphal_back = 1.0 +alphag_back = 0.0 + +alphal_lung = 0.0 +alphag_lung = 1.0 + +interface_amp = 0.5 + +# time stepping requirements +time_end = 5.0 cfl = 0.1 dt = cfl * dx/c_l Nt = int(time_end/dt) +Nframes = 60. +tstart = 0 +tstop = Nt +tsave = int(Nt/Nframes) # Configuring case dictionary print(json.dumps({ @@ -27,21 +82,21 @@ # ========================================================================== # Computational Domain Parameters ========================================== - 'x_domain%beg' : -leng/2., - 'x_domain%end' : leng/2+2*leng, - 'y_domain%beg' : -leng/2., - 'y_domain%end' : leng/2., + 'x_domain%beg' : 0, + 'x_domain%end' : dlengx, + 'y_domain%beg' : -dlengy/2., + 'y_domain%end' : dlengy/2., 'm' : int(Nx), 'n' : int(Ny), 'p' : 0, 'dt' : dt, - 't_step_start' : 0, - 't_step_stop' : Nt, - 't_step_save' : int(Nt/20.), + 't_step_start' : tstart, + 't_step_stop' : tstop, + 't_step_save' : tsave, # ========================================================================== # Simulation Algorithm Parameters ========================================== - 'num_patches' : 3, + 'num_patches' : 2, 'model_eqns' : 2, 'alt_soundspeed' : 'F', 'num_fluids' : 2, @@ -55,12 +110,12 @@ 'weno_avg' : 'F', 'mapped_weno' : 'T', 'null_weights' : 'F', - 'mp_weno' : 'F', + 'mp_weno' : 'T', 'riemann_solver' : 2, 'wave_speeds' : 1, 'avg_state' : 2, - 'bc_x%beg' : -6, - 'bc_x%end' : -6, + 'bc_x%beg' : -1, + 'bc_x%end' : -1, 'bc_y%beg' : -6, 'bc_y%end' : -6, # ========================================================================== @@ -74,55 +129,42 @@ # Patch 1: Background ====================================================== 'patch_icpp(1)%geometry' : 3, - 'patch_icpp(1)%x_centroid' : 0., + 'patch_icpp(1)%x_centroid' : dlengx/2.0, 'patch_icpp(1)%y_centroid' : 0., - 'patch_icpp(1)%length_x' : 10*leng, - 'patch_icpp(1)%length_y' : leng, - 'patch_icpp(1)%vel(1)' : vel, + 'patch_icpp(1)%length_x' : dlengx, + 'patch_icpp(1)%length_y' : dlengy, + 'patch_icpp(1)%vel(1)' : 0.E+00, 'patch_icpp(1)%vel(2)' : 0.E+00, - 'patch_icpp(1)%pres' : 101325., - 'patch_icpp(1)%alpha_rho(1)' : 1.29, - 'patch_icpp(1)%alpha_rho(2)' : 0.E+00, - 'patch_icpp(1)%alpha(1)' : 1.E+00, - 'patch_icpp(1)%alpha(2)' : 0.E+00, + 'patch_icpp(1)%pres' : patmos_n, + 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, + 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, + 'patch_icpp(1)%alpha(1)' : alphal_back, + 'patch_icpp(1)%alpha(2)' : alphag_back, # ========================================================================== - # Patch 2: Shocked state =================================================== - 'patch_icpp(2)%geometry' : 3, + # Patch 2: Lung interface state =================================================== + 'patch_icpp(2)%geometry' : 7, + 'patch_icpp(2)%hcid' : 205, 'patch_icpp(2)%alter_patch(1)' : 'T', - 'patch_icpp(2)%x_centroid' : -3*leng/8., - 'patch_icpp(2)%y_centroid' : 0., - 'patch_icpp(2)%length_x' : leng/4., - 'patch_icpp(2)%length_y' : leng, - 'patch_icpp(2)%vel(1)' : vel, + 'patch_icpp(2)%x_centroid' : dlengx/2.0, + 'patch_icpp(2)%y_centroid' : -dlengy/4.0, + 'patch_icpp(2)%length_x' : dlengx, + 'patch_icpp(2)%length_y' : dlengy/2.0 + 2.0, + 'patch_icpp(2)%a2' : interface_amp, # this is the interface amplitude + 'patch_icpp(2)%vel(1)' : 0.E+00, 'patch_icpp(2)%vel(2)' : 0.E+00, - 'patch_icpp(2)%pres' : ps, - 'patch_icpp(2)%alpha_rho(1)' : 2.4, - 'patch_icpp(2)%alpha_rho(2)' : 0.E+00, - 'patch_icpp(2)%alpha(1)' : 1.E+00, - 'patch_icpp(2)%alpha(2)' : 0.E+00, - # ========================================================================== - - # Patch 3: Bubble ========================================================== - 'patch_icpp(3)%geometry' : 2, - 'patch_icpp(3)%x_centroid' : 0.E+00, - 'patch_icpp(3)%y_centroid' : 0.E+00, - 'patch_icpp(3)%radius' : leng/5., - 'patch_icpp(3)%alter_patch(1)' : 'T', - 'patch_icpp(3)%vel(1)' : 0., - 'patch_icpp(3)%vel(2)' : 0.E+00, - 'patch_icpp(3)%pres' : 101325., - 'patch_icpp(3)%alpha_rho(1)' : 0.E+00, - 'patch_icpp(3)%alpha_rho(2)' : 0.167, - 'patch_icpp(3)%alpha(1)' : 0.E+00, - 'patch_icpp(3)%alpha(2)' : 1.E+00, + 'patch_icpp(2)%pres' : patmos_n, + 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, + 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, + 'patch_icpp(2)%alpha(1)' : alphal_lung, + 'patch_icpp(2)%alpha(2)' : alphag_lung, # ========================================================================== # Fluids Physical Parameters =============================================== - 'fluid_pp(1)%gamma' : 1.E+00/(1.4E+00-1.E+00), - 'fluid_pp(1)%pi_inf' : 0., - 'fluid_pp(2)%gamma' : 1.E+00/(1.6666E+00-1.E+00), - 'fluid_pp(2)%pi_inf' : 0.E+00, + 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), + 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), + 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), + 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), # ============================================================================== })) diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp index 7d6ee9602b..ed2b2b7ebc 100644 --- a/src/pre_process/include/2dHardcodedIC.fpp +++ b/src/pre_process/include/2dHardcodedIC.fpp @@ -100,6 +100,34 @@ q_prim_vf(E_idx)%sf(i, j, 0) = pInt + rhoL*9.81*(intH - y_cc(j)) end if + case (205) ! Lung-wave interaction problem + h = 0.0 ! non-dimensional stand off, starting at origin + lam = 1.0 ! non-dimensional wavelength + wl = 1.0 ! non-dimensional wavelength + amp = patch_icpp(patch_id)%a2 ! non-dimensional amplitude + + ! this the interface function + intH = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h + ! this is the volume fraction of the air + !alph = 5d-1*(1 + tanh((y_cc(j) - intH)/2.5e-3)) + + !if (alph < eps) alph = eps + !if (alph > 1 - eps) alph = 1 - eps + + !if (y_cc(j) > intH) then ! this is the liquid + ! q_prim_vf(advxb)%sf(i, j, 0) = alph + ! q_prim_vf(advxe)%sf(i, j, 0) = 1 - alph + ! q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoH + ! q_prim_vf(contxe)%sf(i, j, 0) = (1 - alph)*rhoL + ! q_prim_vf(E_idx)%sf(i, j, 0) = pref + rhoH*9.81*(1.2 - y_cc(j)) + if (y_cc(j) > intH) then + q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) + q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) + q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres + q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) + q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) + end if + case default if (proc_rank == 0) then call s_int_to_str(patch_id, iStr) From 7f449ae783b17b92cc6494f3391400416d8f697d Mon Sep 17 00:00:00 2001 From: "nazarii_koval@brown.edu" Date: Wed, 12 Jun 2024 15:17:42 -0400 Subject: [PATCH 156/380] updated examples for lung --- examples/2D_lungtissue/case.py | 4 +- examples/2D_lungwave/case.py | 189 ++++++++++++++-------- src/pre_process/include/2dHardcodedIC.fpp | 49 +++++- src/simulation/m_monopole.fpp | 12 -- 4 files changed, 174 insertions(+), 80 deletions(-) diff --git a/examples/2D_lungtissue/case.py b/examples/2D_lungtissue/case.py index d94eceaa6a..74e1320091 100644 --- a/examples/2D_lungtissue/case.py +++ b/examples/2D_lungtissue/case.py @@ -113,11 +113,11 @@ # to minimize computational costs. The grid is coarsened # away from the bubble / origin #might not need - 'stretch_x' : 'T', + 'stretch_x' : 'F', 'a_x' : 4.E+00, 'x_a' : -1.5E-03/1.E-03, 'x_b' : 1.5E-03/1.E-03, - 'stretch_y' : 'T', + 'stretch_y' : 'F', 'a_y' : 4.E+00, 'y_a' : -1.5E-03/1.E-03, 'y_b' : 1.5E-03/1.E-03, diff --git a/examples/2D_lungwave/case.py b/examples/2D_lungwave/case.py index 3db0c93b3c..401804f72b 100644 --- a/examples/2D_lungwave/case.py +++ b/examples/2D_lungwave/case.py @@ -3,22 +3,82 @@ import math import json -ps = 248758.567 -gam = 1.4 -rho = 1. -c_l = math.sqrt( 1.4*ps/rho ) -vel = 230. - -leng = 1. -Ny = 100. -Nx = Ny*3 -dx = leng/Nx - -time_end = 5*leng/vel +#material parameter + + #material1 :: gas +#patterson 2018 + +gammag = 1.4 #unitless +Bg =0 #pascals +rhog = 1.18 #kg/m^3 +c_g = 347.2 #m/s +G_g = 0 #pa + + #material2 :: lung + +gammal = 5.5 +Bl = 492.E+06 +rhol = 996.0 +c_l = 1648.7 +G_l = 1E3 + +#primitive vartiables +patmos = 101325. #pa + +#problem specific variable +lambda_wave = 1E-3 + +#define pulse +P_amp = 10.E+6 +P_len = 45 #length of the impulse +theta = -math.pi/2 #direction of propagation + +#non-dim + +#define characteristic density, length, time, stress material +rho_char = rhog +length_char = lambda_wave +c_char = c_g +time_char = length_char/c_char +stress_char = rho_char*c_char*c_char/gammag + +#non-dim the properties +rhog_n = rhog/rho_char +c_g_n = c_g/c_char +rhol_n = rhol/rho_char +c_l_n = c_l/c_char +Bg_n = Bg/stress_char +Bl_n = Bl/stress_char +G_g_n = G_g/stress_char +G_l_n = G_l/stress_char +patmos_n = patmos/stress_char +P_amp_n = P_amp/stress_char + +#geometry +dlengx = 1. +dlengy = 20. +Nx = 200 +Ny = dlengy*Nx +dx = dlengx/Nx +dy = dlengy/Ny +alphal_back = 1.0 +alphag_back = 0.0 +alphal_lung = 0.0 +alphag_lung = 1.0 + +#timestepping +time_end = 5. cfl = 0.1 dt = cfl * dx/c_l Nt = int(time_end/dt) +Nframes = 60 +tstart = 0 +tstop = 100 #Nt +tsave = 10 #int(Nt/Nframes) + +#interface profile +interface_amp = 0.5 # Configuring case dictionary print(json.dumps({ @@ -27,21 +87,21 @@ # ========================================================================== # Computational Domain Parameters ========================================== - 'x_domain%beg' : -leng/2., - 'x_domain%end' : leng/2+2*leng, - 'y_domain%beg' : -leng/2., - 'y_domain%end' : leng/2., + 'x_domain%beg' : 0., + 'x_domain%end' : dlengx, + 'y_domain%beg' : -dlengy/2., + 'y_domain%end' : dlengy/2., 'm' : int(Nx), 'n' : int(Ny), 'p' : 0, 'dt' : dt, - 't_step_start' : 0, - 't_step_stop' : Nt, - 't_step_save' : int(Nt/20.), + 't_step_start' : tstart, + 't_step_stop' : tstop, + 't_step_save' : tsave, # ========================================================================== # Simulation Algorithm Parameters ========================================== - 'num_patches' : 3, + 'num_patches' : 2, 'model_eqns' : 2, 'alt_soundspeed' : 'F', 'num_fluids' : 2, @@ -55,12 +115,12 @@ 'weno_avg' : 'F', 'mapped_weno' : 'T', 'null_weights' : 'F', - 'mp_weno' : 'F', + 'mp_weno' : 'T', 'riemann_solver' : 2, 'wave_speeds' : 1, 'avg_state' : 2, - 'bc_x%beg' : -6, - 'bc_x%end' : -6, + 'bc_x%beg' : -1, + 'bc_x%end' : -1, 'bc_y%beg' : -6, 'bc_y%end' : -6, # ========================================================================== @@ -74,55 +134,56 @@ # Patch 1: Background ====================================================== 'patch_icpp(1)%geometry' : 3, - 'patch_icpp(1)%x_centroid' : 0., + 'patch_icpp(1)%x_centroid' : dlengx/2, 'patch_icpp(1)%y_centroid' : 0., - 'patch_icpp(1)%length_x' : 10*leng, - 'patch_icpp(1)%length_y' : leng, - 'patch_icpp(1)%vel(1)' : vel, + 'patch_icpp(1)%length_x' : dlengx, + 'patch_icpp(1)%length_y' : dlengy, + 'patch_icpp(1)%vel(1)' : 0., 'patch_icpp(1)%vel(2)' : 0.E+00, - 'patch_icpp(1)%pres' : 101325., - 'patch_icpp(1)%alpha_rho(1)' : 1.29, - 'patch_icpp(1)%alpha_rho(2)' : 0.E+00, - 'patch_icpp(1)%alpha(1)' : 1.E+00, - 'patch_icpp(1)%alpha(2)' : 0.E+00, + 'patch_icpp(1)%pres' : patmos_n, + 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, + 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, + 'patch_icpp(1)%alpha(1)' : alphal_back, + 'patch_icpp(1)%alpha(2)' : alphag_back, # ========================================================================== - # Patch 2: Shocked state =================================================== - 'patch_icpp(2)%geometry' : 3, + # Patch 2: Lung ============================================================ + 'patch_icpp(2)%geometry' : 7, + 'patch_icpp(2)%hcid' : 205, 'patch_icpp(2)%alter_patch(1)' : 'T', - 'patch_icpp(2)%x_centroid' : -3*leng/8., - 'patch_icpp(2)%y_centroid' : 0., - 'patch_icpp(2)%length_x' : leng/4., - 'patch_icpp(2)%length_y' : leng, - 'patch_icpp(2)%vel(1)' : vel, - 'patch_icpp(2)%vel(2)' : 0.E+00, - 'patch_icpp(2)%pres' : ps, - 'patch_icpp(2)%alpha_rho(1)' : 2.4, - 'patch_icpp(2)%alpha_rho(2)' : 0.E+00, - 'patch_icpp(2)%alpha(1)' : 1.E+00, - 'patch_icpp(2)%alpha(2)' : 0.E+00, - # ========================================================================== - - # Patch 3: Bubble ========================================================== - 'patch_icpp(3)%geometry' : 2, - 'patch_icpp(3)%x_centroid' : 0.E+00, - 'patch_icpp(3)%y_centroid' : 0.E+00, - 'patch_icpp(3)%radius' : leng/5., - 'patch_icpp(3)%alter_patch(1)' : 'T', - 'patch_icpp(3)%vel(1)' : 0., - 'patch_icpp(3)%vel(2)' : 0.E+00, - 'patch_icpp(3)%pres' : 101325., - 'patch_icpp(3)%alpha_rho(1)' : 0.E+00, - 'patch_icpp(3)%alpha_rho(2)' : 0.167, - 'patch_icpp(3)%alpha(1)' : 0.E+00, - 'patch_icpp(3)%alpha(2)' : 1.E+00, + 'patch_icpp(2)%x_centroid' : dlengx/2., + 'patch_icpp(2)%y_centroid' : -dlengy/4., #moved the center by amp/2 up and increased length of y to account for the bump + 'patch_icpp(2)%length_x' : dlengx, + 'patch_icpp(2)%length_y' : dlengy/2.+2, #add 2 + 'patch_icpp(2)%a2' : interface_amp, + 'patch_icpp(2)%vel(1)' : 0.E+00, + 'patch_icpp(2)%vel(2)' : 0.0, + 'patch_icpp(2)%pres' : patmos_n, + 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, + 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, + 'patch_icpp(2)%alpha(1)' : alphal_lung, + 'patch_icpp(2)%alpha(2)' : alphag_lung, # ========================================================================== # Fluids Physical Parameters =============================================== - 'fluid_pp(1)%gamma' : 1.E+00/(1.4E+00-1.E+00), - 'fluid_pp(1)%pi_inf' : 0., - 'fluid_pp(2)%gamma' : 1.E+00/(1.6666E+00-1.E+00), - 'fluid_pp(2)%pi_inf' : 0.E+00, + 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), + 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), + 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), + 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), + + # Acoustic Wave source ===================================================== + # The acoustic wave is placed at y = 10 + 'Monopole' : 'T', # update : creating an acoustic wave + 'num_mono' : 1, # update : place in the middle and expand + 'Mono(1)%pulse' : 3, # update : square wave + 'Mono(1)%npulse' : 1, # update : 1 impulse + 'Mono(1)%mag' : P_amp_n, # update : magnitude + 'Mono(1)%length' : P_len, # update : impulse length + 'Mono(1)%support' : 2, # update : 2D semi infinite plane (x: -inf,inf; y:-len/2, len/2) + 'Mono(1)%loc(1)' : dlengx/2, # update : x_center of the domain + 'Mono(1)%loc(2)' : dlengy/2, # update : upper boundary of the domain + 'Mono(1)%dir' : 0, #theta, # update : direction: -pi/2 + 'Mono(1)%support_width' : 3, # update : 49 cells in each direction # ============================================================================== })) diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp index 52fbce363e..052a4bdf14 100644 --- a/src/pre_process/include/2dHardcodedIC.fpp +++ b/src/pre_process/include/2dHardcodedIC.fpp @@ -3,7 +3,7 @@ real(kind(0d0)) :: eps real(kind(0d0)) :: r, rmax, gam, umax, p0 real(kind(0d0)) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph - real(kind(0d0)) :: a_0, l_t + real(kind(0d0)) :: gas, liq, gasn, liqn eps = 1e-9 @@ -12,6 +12,7 @@ #:def Hardcoded2D() select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case + case (200) if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1d0/3d0)) then ! Volume Fractions @@ -100,7 +101,51 @@ q_prim_vf(E_idx)%sf(i, j, 0) = pInt + rhoL*9.81*(intH - y_cc(j)) end if - case (205) ! 2D lung simulation + case (205) ! 2D lung wave interaction problem + h = 0.0 !non dim origin y + lam = 1.0 !non dim lambda + !wl = 1.0 !this is non dim wave length of 1 + amp = patch_icpp(patch_id)%a2 !to be changed later! !non dim amplitude + + !define liquids + gas = 1.18 + liq = 996.0 + gasn = gas/gas + liqn = liq/gas + + + intH = amp*sin(2*pi*x_cc(i)/lam - pi/2)+h + + !alph = 5d-1*(1 + tanh((y_cc(j) - intH)/2.5e-3)) + + !if (alph < eps) alph = eps + !if (alph > 1 - eps) alph = 1 - eps + + ! if (y_cc(j) > intH) then !this is the liquid + ! q_prim_vf(advxb)%sf(i, j, 0) = alph + ! q_prim_vf(advxe)%sf(i, j, 0) = 1 - alph + ! q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoH + ! q_prim_vf(contxe)%sf(i, j, 0) = (1 - alph)*rhoL + ! q_prim_vf(E_idx)%sf(i, j, 0) = pref + rhoH*9.81*(1.2 - y_cc(j)) + + ! updatig with air, need to define wa + + + if (y_cc(j) > intH) then !this is the lung + q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) + q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) + q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres + q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) + q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) + end if + + !if (y_cc(j) < intH) then !this is the lung + ! q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(patch_id)%alpha_rho(1) + ! q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(patch_id)%alpha_rho(2) + ! q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(patch_id)%pres + ! q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(patch_id)%alpha(1) + ! q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(patch_id)%alpha(2) + !end if case default if (proc_rank == 0) then diff --git a/src/simulation/m_monopole.fpp b/src/simulation/m_monopole.fpp index c5ad184858..eeb35544c1 100644 --- a/src/simulation/m_monopole.fpp +++ b/src/simulation/m_monopole.fpp @@ -331,19 +331,7 @@ contains if (the_time > t0 .and. the_time < sigt) then f_g = mag(nm) end if - - else if (pulse(nm) == 4) then - ! Ultrasound pulse wave - period = length(nm)/sos - f_g = mag(nm)*cos((the_time + offset)*2.d0*pi/period)*EXP(-x**2/100) - - else if (pulse(nm) == 5) then - ! Trapesoidal wave - if - else if - - else end if From dff44056246005f2f35a999644b2460ae708c3ec Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 12 Jun 2024 16:35:10 -0400 Subject: [PATCH 157/380] changed module for openmpi on Oscar --- examples/2D_lungwave/case.py | 4 ++-- toolchain/modules | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/examples/2D_lungwave/case.py b/examples/2D_lungwave/case.py index 38db192a0d..e86bdcab29 100644 --- a/examples/2D_lungwave/case.py +++ b/examples/2D_lungwave/case.py @@ -65,12 +65,12 @@ interface_amp = 0.5 # time stepping requirements -time_end = 5.0 +time_end = 0.5 cfl = 0.1 dt = cfl * dx/c_l Nt = int(time_end/dt) -Nframes = 60 +Nframes = 50000 tstart = 0 tstop = Nt tsave = int(Nt/Nframes) diff --git a/toolchain/modules b/toolchain/modules index 5aa4c4b1ab..9560d9d67f 100644 --- a/toolchain/modules +++ b/toolchain/modules @@ -62,6 +62,6 @@ d-gpu CC=nvc CXX=nvc++ FC=nvfortran o Brown Oscar o-all python -o-cpu hpcx-mpi +o-cpu openmpi/4.1.4s o-gpu nvhpc cuda/12.3.0 cmake/3.26.3 o-gpu CC=nvc CXX=nvc++ FC=nvfortran From fd52f19cb068e42e44061ced706637aed2847582 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Wed, 12 Jun 2024 15:55:33 -0500 Subject: [PATCH 158/380] compiles, started to modify the fluxes for hypo hllc --- src/simulation/m_riemann_solvers.fpp | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 7926a5f2b0..4a5c422358 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -2227,6 +2227,21 @@ contains !$acc loop seq do i = 1, num_dims idxi = dir_idx(i) + if (hypoelasticity) then + flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & + xi_M*(rho_L*(vel_L(idx1)* & + vel_L(idxi) + & + s_M*(xi_L*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))* & + vel_L(idxi)) - vel_L(idxi))) + & + dir_flg(idxi)*(pres_L) - tau_e_L(dir_idx_tau(i))) & + + xi_P*(rho_R*(vel_R(idx1)* & + vel_R(idxi) + & + s_P*(xi_R*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))* & + vel_R(idxi)) - vel_R(idxi))) + & + dir_flg(idxi)*(pres_R) - tau_e_R(dir_idx_tau(i))) + end if !SGR added this if statement for hypo flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & xi_M*(rho_L*(vel_L(idx1)* & vel_L(idxi) + & From f47f2f4a2186205f772fe3e6a0e9eeb23fe34196 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 12 Jun 2024 17:50:56 -0400 Subject: [PATCH 159/380] added monopole for lung problem example, not working yet --- examples/2D_lungwave/case.py | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/examples/2D_lungwave/case.py b/examples/2D_lungwave/case.py index e86bdcab29..c0979a472b 100644 --- a/examples/2D_lungwave/case.py +++ b/examples/2D_lungwave/case.py @@ -3,6 +3,7 @@ import math import json +pi = 3.141592653589 # material parameters # material 1 :: gas # Patterson 2018 et al. @@ -120,6 +121,20 @@ 'bc_y%end' : -6, # ========================================================================== + # Monopole settings ======================================================== + 'Monopole' :'T', + 'num_mono' : 1, + 'Mono(1)%pulse' : 3, # this is for a sine wave + 'Mono(1)%npulse' : 10, # one cycle for now + 'Mono(1)%support' : 2, # plane of monopole + 'Mono(1)%support_width' : 10, + 'Mono(1)%loc(1)' : dlengx/2.0, + 'Mono(1)%loc(2)' : 5.0*dlengx, + 'Mono(1)%dir' : 0.0, + 'Mono(1)%mag' : 5.0*patmos_n, + 'Mono(1)%length' : 100.*dlengx, + # ========================================================================== + # Formatted Database Files Structure Parameters ============================ 'format' : 1, 'precision' : 2, From ff284e15d3a6eab53db2e7df77a0632c2b8cf31d Mon Sep 17 00:00:00 2001 From: "nazarii_koval@brown.edu" Date: Wed, 12 Jun 2024 17:51:37 -0400 Subject: [PATCH 160/380] changes --- examples/2D_lungwave/case.py | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/examples/2D_lungwave/case.py b/examples/2D_lungwave/case.py index d4a21b164e..01c1b2c199 100644 --- a/examples/2D_lungwave/case.py +++ b/examples/2D_lungwave/case.py @@ -176,19 +176,18 @@ 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), - # Acoustic Wave source ===================================================== - # The acoustic wave is placed at y = 10 - #'Monopole' : 'T', # update : creating an acoustic wave - #'num_mono' : 1, # update : place in the middle and expand - #'Mono(1)%pulse' : 3, # update : square wave - #'Mono(1)%npulse' : 1, # update : 1 impulse - #'Mono(1)%mag' : P_amp_n, # update : magnitude - #'Mono(1)%length' : P_len, # update : impulse length - #'Mono(1)%support' : 2, # update : 2D semi infinite plane (x: -inf,inf; y:-len/2, len/2) - #'Mono(1)%loc(1)' : dlengx/2, # update : x_center of the domain - #'Mono(1)%loc(2)' : dlengy/2, # update : upper boundary of the domain - #'Mono(1)%dir' : 0, #theta, # update : direction: -pi/2 - #'Mono(1)%support_width' : 3, # update : 49 cells in each direction + # Monopole setting ========================================================= + 'Monopole' : 'T', # update : creating an acoustic wave + 'num_mono' : 1, # update : place in the middle and expand + 'Mono(1)%pulse' : 3, # update : sin wave + 'Mono(1)%npulse' : 10, # update : 1 impulse + 'Mono(1)%mag' : 5.0*patmos_n, # update : magnitude + 'Mono(1)%length' : 100*dlengx, # update : impulse length + 'Mono(1)%support' : 2, # update : 2D semi infinite plane (x: -inf,inf; y:-len/2, len/2) + 'Mono(1)%support_width' : 10, # update : 49 cells in each direction + 'Mono(1)%loc(1)' : dlengx/2, # update : x_center of the domain + 'Mono(1)%loc(2)' : 5.0*dlengx, # update : upper boundary of the domain + 'Mono(1)%dir' : 0, # update : direction: -pi/2 #============================================================================== })) From 9e93795f90e39e70608657b1219952065e883caf Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Tue, 11 Jun 2024 12:24:19 -0500 Subject: [PATCH 161/380] starting new branch --- submit_gpu.sh | 54 ++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 45 insertions(+), 9 deletions(-) diff --git a/submit_gpu.sh b/submit_gpu.sh index 21284621ba..e5ad46c5f4 100755 --- a/submit_gpu.sh +++ b/submit_gpu.sh @@ -1,17 +1,53 @@ ## Pre-process -#./mfc.sh run /scratch/bciv/sremillard/sph_col_2atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# sph2 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/sremillard/sph_col_50atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 1:00:00 -# sph50 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/sremillard/sph_col_20atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 1:00:00 -# sph20 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/sremillard/sph_col_10atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 1:00:00 -# sph10 -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/sph_col_20atm_BD/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# sph20prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/sph_col_35atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# sph30prp -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_10atm_quart/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 10q_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_hf/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 20fh_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_quart/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 20q_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_half/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 20h_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_50atm_quart/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 50q_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_p1/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 20p1_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_10atm_p1/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 20p1_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_35atm_p1/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 35p1_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/sph_col_10atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# sph10_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_10atm_hf/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 10fh_prpN -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_p1e/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 0:15:00 -# 20p1e_prpN -t pre_process -a bciv-delta-gpu -c delta + + -#./mfc.sh run /scratch/bciv/sremillard/pert_col_2atm_tenth/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# base -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/sremillard/sph_col_1atm/3Dshinput_new.py -e batch -p gpuA100x4 -N 8 -n 4 -g 4 -w 1:00:00 -# sph_1 -t pre_process -a bciv-delta-gpu -c delta ## simulation -./mfc.sh run /scratch/bciv/sremillard/sph_col_50atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 5:30:00 -# sph50 -t simulation -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/sremillard/sph_col_20atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 5:30:00 -# sph20 -t simulation -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/sremillard/sph_col_10atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 4 -w 5:30:00 -# sph10 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_10atm_hf/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 08:00:00 -# 10fh_sim -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/sph_col_10atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 10:00:00 -# sph10_sim -t simulation -a bciv-delta-gpu -c delta + + + + +#./mfc.sh run /scratch/bciv/sremillard/sph_col_35atm/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 09:00:00 -# sph35sim -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_p1/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 10:00:00 -# 20p1_sim -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_10atm_p1/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 09:00:00 -# 10p1_sim -t simulation -a bciv-delta-gpu -c delta + + +#./mfc.sh run /scratch/bciv/sremillard/sph_col_20atm_BD/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 04:30:00 -# sph20 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_10atm_quart/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# 10q -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_hf/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 07:30:00 -# 20fh -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_quart/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 07:30:00 -# 20q -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_half/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 10:00:00 -# 20h -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_50atm_quart/3Dinput.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 10:00:00 -# 50q -t simulation -a bciv-delta-gpu -c delta + +## post_process - Check if sim_data is TRUE!!!!! + +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_p1/3Dinput.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 03:00:00 -# 20p1_sim -t post_process -a bciv-delta-gpu -c delta + + +./mfc.sh run /scratch/bciv/sremillard/sph_col_20atm_BD/3Dinput.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:30:00 -# sph20 -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_10atm_quart/3Dinput.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:30:00 -# 10q -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_10atm_hf/3Dinput.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 02:30:00 -# 10fh -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /projects/bciv/sremillard/pert_20q/3Dinput.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 03:00:00 -# 20q -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_20atm_half/3Dinput.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:30:00 -# 20h -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/sremillard/pert_col_50atm_quart/3Dinput.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:30:00 -# 50q -t post_process -a bciv-delta-gpu -c delta + From 36f1bb3aeea182e30227fd29acab2ca7b7f9110d Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Wed, 12 Jun 2024 08:11:41 -0500 Subject: [PATCH 162/380] added G contirbution in speed of sound calc and adjusted in m_data_out. in sim --- src/common/include/inline_conversions.fpp | 29 ++++++++++++++++------- src/post_process/m_data_output.fpp | 2 +- src/simulation/m_data_output.fpp | 6 +++-- 3 files changed, 26 insertions(+), 11 deletions(-) diff --git a/src/common/include/inline_conversions.fpp b/src/common/include/inline_conversions.fpp index 4f455c511d..ffbd438678 100644 --- a/src/common/include/inline_conversions.fpp +++ b/src/common/include/inline_conversions.fpp @@ -1,5 +1,5 @@ #:def s_compute_speed_of_sound() - subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c) + subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c, G) #ifdef CRAY_ACC_WAR !DIR$ INLINEALWAYS s_compute_speed_of_sound #else @@ -11,17 +11,30 @@ real(kind(0d0)), dimension(num_fluids), intent(IN) :: adv real(kind(0d0)), intent(IN) :: vel_sum real(kind(0d0)), intent(OUT) :: c + real(kind(0d0)), dimension(num_fluids), intent(IN), optional :: G - real(kind(0d0)) :: blkmod1, blkmod2 + real(kind(0d0)), dimension(num_fluids) :: blkmod - integer :: q + integer :: q, i if (alt_soundspeed) then - blkmod1 = ((gammas(1) + 1d0)*pres + & - pi_infs(1))/gammas(1) - blkmod2 = ((gammas(2) + 1d0)*pres + & - pi_infs(2))/gammas(2) - c = (1d0/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2))) + c = 0d0 + do i = 1, num_fluids + if (hypoelasticity) then + blkmod(i) = ((gammas(i) + 1d0)*pres + & + pi_infs(i))/gammas(i)+4/3*G(i) + else + blkmod(i) = ((gammas(i) + 1d0)*pres + & + pi_infs(i))/gammas(i) + end if + c = c + adv(i)/blkmod(i) + end do + c = 1d0/(rho*c) +! blkmod1 = ((gammas(1) + 1d0)*pres + & +! pi_infs(1))/gammas(1) +! blkmod2 = ((gammas(2) + 1d0)*pres + & +! pi_infs(2))/gammas(2) +! c = (1d0/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2))) elseif (model_eqns == 3) then c = 0d0 !$acc loop seq diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 68e5d9d659..2551bc2625 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -1009,7 +1009,7 @@ contains cent = l end if end do - thres = 0.9d0 + thres = 0.9d0*max_alph_glb do k = 0, n OLoop: do j = 0, m axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 87525dfc60..49b9abf1e9 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -277,6 +277,7 @@ contains real(kind(0d0)) :: vel_sum !< Cell-avg. velocity sum real(kind(0d0)) :: pres !< Cell-avg. pressure real(kind(0d0)), dimension(num_fluids) :: alpha !< Cell-avg. volume fraction + real(kind(0d0)), dimension(num_fluids) :: G_K real(kind(0d0)) :: gamma !< Cell-avg. sp. heat ratio real(kind(0d0)) :: pi_inf !< Cell-avg. liquid stiffness function real(kind(0d0)) :: qv !< Cell-avg. fluid reference energy @@ -302,7 +303,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - + G_K(:) = fluid_pp(:)%G !SGR Reinitialize a vector for shear moduli do i = 1, num_fluids alpha_rho(i) = q_prim_vf(i)%sf(j, k, l) alpha(i) = q_prim_vf(E_idx + i)%sf(j, k, l) @@ -330,7 +331,8 @@ contains H = (E + pres)/rho ! Compute mixture sound speed - call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c) + call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c, G_K) + !SGR added G here for speed of sound if ( c .lt. 10d-12 ) then print*, 'code has crashed at processor: ',proc_rank,' at j :: ',j,', k :: ',k,' l :: ',l,'with alph1a ::',alpha(1),'and alpha2 ::', alpha(2) From efe6ac0f3d3be7fb9522f9e2e2e4828671b2be3f Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Wed, 12 Jun 2024 10:39:49 -0500 Subject: [PATCH 163/380] all is done in hllc for hypo besides the flux computation --- src/common/include/inline_conversions.fpp | 1 + src/simulation/m_data_output.fpp | 9 +-- src/simulation/m_riemann_solvers.fpp | 93 +++++++++++++++++++---- 3 files changed, 82 insertions(+), 21 deletions(-) diff --git a/src/common/include/inline_conversions.fpp b/src/common/include/inline_conversions.fpp index ffbd438678..bfdc1344fd 100644 --- a/src/common/include/inline_conversions.fpp +++ b/src/common/include/inline_conversions.fpp @@ -19,6 +19,7 @@ if (alt_soundspeed) then c = 0d0 + !$acc loop seq do i = 1, num_fluids if (hypoelasticity) then blkmod(i) = ((gammas(i) + 1d0)*pres + & diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 49b9abf1e9..1546097b2c 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -303,7 +303,6 @@ contains do l = 0, p do k = 0, n do j = 0, m - G_K(:) = fluid_pp(:)%G !SGR Reinitialize a vector for shear moduli do i = 1, num_fluids alpha_rho(i) = q_prim_vf(i)%sf(j, k, l) alpha(i) = q_prim_vf(E_idx + i)%sf(j, k, l) @@ -331,7 +330,7 @@ contains H = (E + pres)/rho ! Compute mixture sound speed - call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c, G_K) + call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c, fluid_pp(:)%G) !SGR added G here for speed of sound if ( c .lt. 10d-12 ) then @@ -1297,7 +1296,7 @@ contains ! Compute mixture sound Speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & - ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) + ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c, fluid_pp(:)%G) accel = accel_mag(j - 2, k, l) end if @@ -1372,7 +1371,7 @@ contains end if ! Compute mixture sound speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & - ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) + ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c, fluid_pp(:)%G) end if end if @@ -1424,7 +1423,7 @@ contains ! Compute mixture sound speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & - ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) + ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c, fluid_pp(:)%G) accel = accel_mag(j - 2, k - 2, l - 2) end if diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index b0295f971d..7926a5f2b0 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -509,16 +509,18 @@ contains @:compute_average_state() call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & - vel_L_rms, c_L) + vel_L_rms, c_L, Gs) call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & - vel_R_rms, c_R) + vel_R_rms, c_R, Gs) !> The computation of c_avg does not require all the variables, and therefore the non '_avg' ! variables are placeholders to call the subroutine. call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & - vel_avg_rms, c_avg) + vel_avg_rms, c_avg, Gs) + + !SGR added Gs to all of the above speed of sound clacs if (any(Re_size > 0)) then !$acc loop seq @@ -863,6 +865,9 @@ contains real(kind(0d0)) :: xi_L, xi_R !< Left and right wave speeds functions real(kind(0d0)) :: xi_M, xi_P + real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R + real(kind(0d0)) :: G_L, G_R + real(kind(0d0)) :: nbub_L, nbub_R real(kind(0d0)), dimension(nb) :: R0_L, R0_R real(kind(0d0)), dimension(nb) :: V0_L, V0_R @@ -1966,7 +1971,7 @@ contains end do !$acc end parallel loop else - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, & !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms) copyin(is1,is2,is3) do l = is3%beg, is3%end do k = is2%beg, is2%end @@ -2083,20 +2088,53 @@ contains H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R + + if (hypoelasticity) then + !$acc loop seq + do i = 1, strxe - strxb + 1 + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + end do + + G_L = 0d0 + G_R = 0d0 + !$acc loop seq + do i = 1, num_fluids + G_L = G_L + alpha_L(i)*Gs(i) + G_R = G_R + alpha_R(i)*Gs(i) + end do + + do i = 1, strxe - strxb + 1 + ! Elastic contribution to energy if G large enough + !TODO take out if statement if stable without + if ((G_L > 1000) .and. (G_R > 1000)) then + E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) + E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) + ! Additional terms in 2D and 3D + if ((i == 2) .or. (i == 4) .or. (i == 5)) then + E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) + E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) + end if + end if + end do + end if + !SGR Added exact code from hll here + @:compute_average_state() call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & - vel_L_rms, c_L) + vel_L_rms, c_L, Gs) call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & - vel_R_rms, c_R) + vel_R_rms, c_R, Gs) !> The computation of c_avg does not require all the variables, and therefore the non '_avg' ! variables are placeholders to call the subroutine. call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & - vel_avg_rms, c_avg) + vel_avg_rms, c_avg, Gs) + !SGR added Gs contribution to the speed of sound if (any(Re_size > 0)) then !$acc loop seq @@ -2106,15 +2144,38 @@ contains end if if (wave_speeds == 1) then - s_L = min(vel_L(idx1) - c_L, vel_R(idx1) - c_R) - s_R = max(vel_R(idx1) + c_R, vel_L(idx1) + c_L) - - s_S = (pres_R - pres_L + rho_L*vel_L(idx1)* & - (s_L - vel_L(idx1)) - & - rho_R*vel_R(idx1)* & - (s_R - vel_R(idx1))) & - /(rho_L*(s_L - vel_L(idx1)) - & - rho_R*(s_R - vel_R(idx1))) + if (hypoelasticity) then + s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + & + tau_e_L(dir_idx_tau(1)))/rho_L) & + , vel_R(dir_idx(1)) - sqrt(c_R*c_R + & + (((4d0*G_R)/3d0) + & + tau_e_R(dir_idx_tau(1)))/rho_R)) + s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & + (((4d0*G_R)/3d0) + & + tau_e_R(dir_idx_tau(1)))/rho_R) & + , vel_L(dir_idx(1)) + sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + & + tau_e_L(dir_idx_tau(1)))/rho_L)) + s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & + tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)* & + (s_L - vel_L(idx1)) - & + rho_R*vel_R(idx1)* & + (s_R - vel_R(idx1))) & + /(rho_L*(s_L - vel_L(idx1)) - & + rho_R*(s_R - vel_R(idx1))) + + else + s_L = min(vel_L(idx1) - c_L, vel_R(idx1) - c_R) + s_R = max(vel_R(idx1) + c_R, vel_L(idx1) + c_L) + + s_S = (pres_R - pres_L + rho_L*vel_L(idx1)* & + (s_L - vel_L(idx1)) - & + rho_R*vel_R(idx1)* & + (s_R - vel_R(idx1))) & + /(rho_L*(s_L - vel_L(idx1)) - & + rho_R*(s_R - vel_R(idx1))) + end if elseif (wave_speeds == 2) then pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & From 407e3e17a1ce829739bb2a2d77b30327c4fb5952 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Wed, 12 Jun 2024 15:55:33 -0500 Subject: [PATCH 164/380] compiles, started to modify the fluxes for hypo hllc --- src/simulation/m_riemann_solvers.fpp | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 7926a5f2b0..4a5c422358 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -2227,6 +2227,21 @@ contains !$acc loop seq do i = 1, num_dims idxi = dir_idx(i) + if (hypoelasticity) then + flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & + xi_M*(rho_L*(vel_L(idx1)* & + vel_L(idxi) + & + s_M*(xi_L*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))* & + vel_L(idxi)) - vel_L(idxi))) + & + dir_flg(idxi)*(pres_L) - tau_e_L(dir_idx_tau(i))) & + + xi_P*(rho_R*(vel_R(idx1)* & + vel_R(idxi) + & + s_P*(xi_R*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))* & + vel_R(idxi)) - vel_R(idxi))) + & + dir_flg(idxi)*(pres_R) - tau_e_R(dir_idx_tau(i))) + end if !SGR added this if statement for hypo flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & xi_M*(rho_L*(vel_L(idx1)* & vel_L(idxi) + & From 528e153dacac2d99f1194477338313bf0cfae5f2 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Thu, 13 Jun 2024 13:09:47 -0500 Subject: [PATCH 165/380] all fluxes have been coded for hllc hypo, need to verify that there are no source terms, code compiles --- src/simulation/m_riemann_solvers.fpp | 48 ++++++++++++++++++++++------ 1 file changed, 38 insertions(+), 10 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 4a5c422358..b5490d3710 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -2260,16 +2260,34 @@ contains ! Energy flux. ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) - flux_rs${XYZ}$_vf(j, k, l, E_idx) = & - xi_M*(vel_L(idx1)*(E_L + pres_L) + & - s_M*(xi_L*(E_L + (s_S - vel_L(idx1))* & - (rho_L*s_S + pres_L/ & - (s_L - vel_L(idx1)))) - E_L)) & - + xi_P*(vel_R(idx1)*(E_R + pres_R) + & - s_P*(xi_R*(E_R + (s_S - vel_R(idx1))* & - (rho_R*s_S + pres_R/ & - (s_R - vel_R(idx1)))) - E_R)) - + if (hypoelasticity) then + flux_rs${XYZ}$_vf(j, k, l, E_idx) = & + xi_M*(vel_L(idx1)*(E_L + pres_L - tau_e_L(dir_idx_tau(1))) + & + s_M*(xi_L*(E_L + (s_S - vel_L(idx1))* & + (rho_L*s_S + (pres_L - tau_e_L(dir_idx_tau(1)))/ & + (s_L - vel_L(idx1)))) - E_L)) & + + xi_P*(vel_R(idx1)*(E_R + pres_R - tau_e_R(dir_idx_tau(1))) + & + s_P*(xi_R*(E_R + (s_S - vel_R(idx1))* & + (rho_R*s_S + (pres_R - tau_e_R(dir_idx_tau(1)))/ & + (s_R - vel_R(idx1)))) - E_R)) + if (num_dims > 1) then + do i = 1, num_dims - 1 + flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + & + xi_M*(s_S/(s_L-s_S))*(tau_e_L(dir_idx_tau(i+1))*vel_L(dir_idx(i+1))) + & + xi_P*(s_S/(s_R-s_S))*(tau_e_R(dir_idx_tau(i+1))*vel_R(dir_idx(i+1))) + end do + end if + else ! SGR added Hypo statement to calc energy flux + flux_rs${XYZ}$_vf(j, k, l, E_idx) = & + xi_M*(vel_L(idx1)*(E_L + pres_L) + & + s_M*(xi_L*(E_L + (s_S - vel_L(idx1))* & + (rho_L*s_S + pres_L/ & + (s_L - vel_L(idx1)))) - E_L)) & + + xi_P*(vel_R(idx1)*(E_R + pres_R) + & + s_P*(xi_R*(E_R + (s_S - vel_R(idx1))* & + (rho_R*s_S + pres_R/ & + (s_R - vel_R(idx1)))) - E_R)) + end if ! Volume fraction flux !$acc loop seq do i = advxb, advxe @@ -2295,6 +2313,16 @@ contains !if ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0d0 end do + ! Elastic Stresses + if (hypoelasticity) then + do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow + flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & + xi_M*(s_S/(s_L-s_S))*(s_L*rho_L*tau_e_L(i)-rho_L*vel_L(dir_idx(1))*tau_e_L(i)) + & + xi_P*(s_S/(s_R-s_S))*(s_R*rho_R*tau_e_R(i)-rho_R*vel_R(dir_idx(1))*tau_e_R(i)) + end do + end if + + flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) ! Geometrical source flux for cylindrical coordinates From ec229f87602a32be895543a472f8171affb5a896 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Thu, 13 Jun 2024 15:04:53 -0500 Subject: [PATCH 166/380] code compiles all implementation for hllc_hypo is done, pending testing --- src/simulation/m_checker.fpp | 6 +++--- src/simulation/m_riemann_solvers.fpp | 2 ++ 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index c6f0e8d9c7..d35a39ad44 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -290,9 +290,9 @@ contains elseif (riemann_solver /= 2 .and. alt_soundspeed) then call s_mpi_abort('Unsupported combination of riemann_solver '// & 'and alt_soundspeed. Exiting ...') - elseif (hypoelasticity .and. (riemann_solver /= 1)) then - call s_mpi_abort('hypoelasticity requires riemann_solver = 1'// & - 'Exiting ...') +! elseif (hypoelasticity .and. (riemann_solver /= 1)) then +! call s_mpi_abort('hypoelasticity requires riemann_solver = 1'// & +! 'Exiting ...') !SGR commented out for testing! end if if (adap_dt) then diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index b5490d3710..222e3a1d3f 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -2271,6 +2271,7 @@ contains (rho_R*s_S + (pres_R - tau_e_R(dir_idx_tau(1)))/ & (s_R - vel_R(idx1)))) - E_R)) if (num_dims > 1) then + !$acc loop seq do i = 1, num_dims - 1 flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + & xi_M*(s_S/(s_L-s_S))*(tau_e_L(dir_idx_tau(i+1))*vel_L(dir_idx(i+1))) + & @@ -2315,6 +2316,7 @@ contains ! Elastic Stresses if (hypoelasticity) then + !$acc loop seq do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & xi_M*(s_S/(s_L-s_S))*(s_L*rho_L*tau_e_L(i)-rho_L*vel_L(dir_idx(1))*tau_e_L(i)) + & From 98a4503979867d50b1fd32d3c36e31f809c83169 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Thu, 13 Jun 2024 15:28:38 -0500 Subject: [PATCH 167/380] fixed bug in post_process --- src/post_process/m_data_output.fpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 2551bc2625..ea000550ae 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -1009,7 +1009,7 @@ contains cent = l end if end do - thres = 0.9d0*max_alph_glb + thres = 0.9d0*maxalph_glb do k = 0, n OLoop: do j = 0, m axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) From 627da11469584da49819567bc46ba8362ca815fb Mon Sep 17 00:00:00 2001 From: "nazarii_koval@brown.edu" Date: Fri, 14 Jun 2024 15:54:24 -0400 Subject: [PATCH 168/380] added horizontal domain fro lung problem --- examples/2D_lungtissue/case.py | 251 ---------------------- examples/2D_lungwave/case.py | 63 ++---- examples/2D_lungwave_horizontal/case.py | 191 ++++++++++++++++ src/pre_process/include/2dHardcodedIC.fpp | 40 ++-- src/simulation/m_monopole.fpp | 5 + 5 files changed, 231 insertions(+), 319 deletions(-) delete mode 100644 examples/2D_lungtissue/case.py create mode 100644 examples/2D_lungwave_horizontal/case.py diff --git a/examples/2D_lungtissue/case.py b/examples/2D_lungtissue/case.py deleted file mode 100644 index 74e1320091..0000000000 --- a/examples/2D_lungtissue/case.py +++ /dev/null @@ -1,251 +0,0 @@ -#!/usr/bin/env python3 - -import json -import math - -# Adjustung the parameters for the 2D case of U-Sound-lung tissue interaction -""" - TODO's -1. Runtime Parameters - (done) run_time_info - rdma_mpi -2. Computational Domain Parameters - (done) domain - [x,y] = [{0,1},{-20,15}] - streching? - (done) gridcells - (done) dt - (done) t_step_start - (done) t_step_stop - t_step_save - t_step_print -3. Patch Parameters - (done) geometry, density and volumetric fraction -4. Immersed Boundary Patches - geometry -5. Fluid Material's Parameters - Re(1) - sheer viscosity of the fluid (5 eq model only) - Re(2) - volume viscosity of the fluid (5 eq model only) - sigma - surface tension -6. Simulation Algorithm Parameters - BC - (done) model eq - eq.model - TBD -7. Formatted Database and Structure Parameters - TBD -8. (Optional) Acoustic Source Parameters - TBD - might be useful to implemetn US imaging -9. (Optional) Ensemble-Averaged Bubble Model Parameters -10. (Optional) Velocity Field Setup Parameters -11. (Optional) Phase Change Parameters -12. (Optional) Artificial Mach Number Parameters -""" - -#Define problem specific variables - - #refference values (water, characteristic lenght) -rho_0 = 996. #kg/m3 -c_0 = 1648.7 #m/s spped of sound -l_0 = 200.E-6 #length scale um -p_0 = rho_0*c_0*c_0 #characteristic pressure - - #define non-dim -N = 100 #points per l -dx = 1/(N-1) #dx of the grid -l_t = 15 #y-scaling -l_b = 20 #y-scaling - - #dimensional parameters (air at 300K) -p_atm = 101325 #Pa - #air -rho_a = 1.18/rho_0 #density air -c_a = 347.2/c_0 #speed of sound in water -n_a = 1.4 #stiffened EoS constant -B_a = 0 #stiffened EoS constant - #water -rho_w = 996./rho_0 #density water -c_w = 1648.7/c_0 #spped of sound in air -n_w = 5.5 #stiffened EoS constant -B_w = 492.E+6/p_0 #stiffened EoS constant - - #time settings (followed 2D_whale_bubble_annulus) -cfl = 0.25 #cfl condition -t_char = l_0/c_0 #s characteristic timescale -dt = cfl*t_char #s time step -L = 1000*l_0 #m total distance travelled by the wave -Tfinal = L/c_0 #s final time of the simulation -N_steps = int(Tfinal/dt) #number of steps the simulation will run (4000) - -''' - #time settings (followed 2D_whale_bubble_annulus) -u0 = math.sqrt(p_atm/rho_w) #refference velocity -cfl = 0.25 #cfl condition -dt = cfl*dx*u0/c_w #time step calculated -Tfinal = 5 #final time of the simulation -N_steps = int(Tfinal/dt) #number of steps the simulation will run -''' - - #DUS settings -P_amp = 10.E+6/p_0 -P_len = 45 #length of the impulse -theta = -math.pi/2 #direction of propagation - - #membrane setting -a_0 = 0.03 #amplitude -y_l_top = f"{l_t}-{a_0}*sin(2*pi*x/{1}-pi/2)" -#y_l_bot = f"{l_b}+{a_0}*sin(2*pi*x/{1}-pi/2)" - - -# Configuring case dictionary -print(json.dumps({ - # Logistics ================================================================ - 'run_time_info' : 'T', - # ========================================================================== - - # Computational Domain Parameters ========================================== - - # The domain consists of 2 regions with a membrane inwetween. The origin is - # set on the left end of the membrane. The domain of interest. y: -20l to 15l - 'x_domain%beg' : 0, # update - 'x_domain%end' : 1, # update - 'y_domain%beg' : -l_b, # update - 'y_domain%end' : l_t, # update - # Grid stretching is used in the all coordinate directions - # to minimize computational costs. The grid is coarsened - # away from the bubble / origin - #might not need - 'stretch_x' : 'F', - 'a_x' : 4.E+00, - 'x_a' : -1.5E-03/1.E-03, - 'x_b' : 1.5E-03/1.E-03, - 'stretch_y' : 'F', - 'a_y' : 4.E+00, - 'y_a' : -1.5E-03/1.E-03, - 'y_b' : 1.5E-03/1.E-03, - # grid sells setup - m=x,n=y,p=z - 'm' : int(N-1), # update - 'n' : int((l_t+l_b)*N-1), # update - # time setup - 'dt' : dt, # update : see above - 't_step_start' : 0, # update : start at 0 - 't_step_stop' : N_steps, # update : number of iterations - 't_step_save' : 10, - # ========================================================================== - - # Simulation Algorithm Parameters ========================================== - # Only two patches are necesssary, the liquid(tissue) and the - # gas(lung) - 'num_patches' : 2, # update: Tissue and Lung - # Use the 5 equation model - 'model_eqns' : 2, # update: number of equations is 5 - # 6 equations model does not need the K \div(u) term - 'alt_soundspeed' : 'F', - - # num_fluids defines the total number of fluids defined in each of the - # patches. - 'num_fluids' : 2, # update: each patch has 2 fluid associated with it - # Advect both volume fractions - 'adv_alphan' : 'T', - # Ensure the volume fractions sum to unity at the end of each - # time step - 'mpp_lim' : 'T', - # Correct errors when computing speed of sound - 'mixture_err' : 'T', - # Use TVD RK3 for time marching - 'time_stepper' : 3, # update: tvdrk3 - # Use WENO5 - 'weno_order' : 5, # update - 'weno_eps' : 1.E-16, - 'weno_Re_flux' : 'F', - 'weno_avg' : 'F', - 'avg_state' : 2, - # Use the mapped WENO weights to maintain monotinicity - 'mapped_weno' : 'T', - 'null_weights' : 'F', - 'mp_weno' : 'F', - # Use the HLL Riemann solver - 'riemann_solver' : 1, # update : 1=HLL - 'wave_speeds' : 1, - - # We will use symmetric BC at the x-boundaries. THe bottom booundary needs - # to be at a zero gradient. Top - non-reflective boundary conditions - 'bc_x%beg' : -1, # update : used periodec - 'bc_x%end' : -1, # update : used periodic - 'bc_y%beg' : -6, # update : used non-reflecting subsonic buffer - 'bc_y%end' : -6, # update : used non-reflecting subsonic buffer - # ========================================================================== - - # Formatted Database Files Structure Parameters ============================ - # Export primitive variables in double precision with parallel - # I/O to minimize I/O computational time during large simulations - 'format' : 1, - 'precision' : 2, - 'prim_vars_wrt' :'T', - 'parallel_io' :'T', - # ========================================================================== - - # For now setting the the patches geometry to be rectangles with a - # varible y lenght: - # Patch 1: yl = 15-a_0*sin(2*pi*x/l-pi/2) - # Patch 2: yb = 20+a_0*sin(2*pi*x/l-pi/2) - - # Patch 1: Air (Lung) ====================================================== - # Specify the gas grid geometry - 'patch_icpp(1)%geometry' : 3, # update : assumes to be a rectangle - 'patch_icpp(1)%x_centroid' : 1/2, # update : x_centroid = 0.5l - 'patch_icpp(1)%y_centroid' : (l_t-l_b)/2, # update : y_centroid = -10l - 'patch_icpp(1)%length_x' : 1, # update : x_l = l - 'patch_icpp(1)%length_y' : l_t+l_b, # update : y_l = function of position - # Specify the patch primitive variables - 'patch_icpp(1)%vel(1)' : 0.E+00, # update : no initial velocity - 'patch_icpp(1)%vel(2)' : 0.E+00, # update : no initial velocity - 'patch_icpp(1)%pres' : p_atm/p_0, # update : assume atmospheric pressure - 'patch_icpp(1)%alpha_rho(1)' : 0.E+00, # update : Partial density of fluid 1 in patch 2 (no water) - 'patch_icpp(1)%alpha_rho(2)' : rho_a, # update : Partial density of fluid 2 in patch 2 (air only) - 'patch_icpp(1)%alpha(1)' : 0.E+00, # update : volume fraction of fluid 1 in patch 2 (no water) - 'patch_icpp(1)%alpha(2)' : 1.E+00, # update : volume fraction of fluid 2 in patch 2 (air only) - # ========================================================================== - - # Patch 2: Water(Tisue) ==================================================== - # Specify the water background grid geometry - 'patch_icpp(2)%geometry' : 3, # update : assumes to be a rectangle - #'patch_icpp(2)%hcid' : 205, # update : hardcoded geometry of the patch - 'patch_icpp(2)%alter_patch(1)' : 'T', - 'patch_icpp(2)%x_centroid' : 1/2, # update : x_centroid = 0.5l - 'patch_icpp(2)%y_centroid' : l_t/2, # update : y_centorid = 7.5l - 'patch_icpp(2)%length_x' : 1, # update : x_l = l - 'patch_icpp(2)%length_y' : l_t, # update : y_l = fucntion of position, y_l_top - didnot accept str - # Specify the patch primitive variables - 'patch_icpp(2)%vel(1)' : 0.E+00, # update : no initial velocity - 'patch_icpp(2)%vel(2)' : 0.E+00, # update : no initial velocity - 'patch_icpp(2)%pres' : p_atm/p_0, # update : assume atmospheric pressure - 'patch_icpp(2)%alpha_rho(1)' : rho_w, # update : Partial density of fluid 1 in patch 1 (water only) - 'patch_icpp(2)%alpha_rho(2)' : 0.E+00, # update : Partial density of fluid 2 in patch 1 (no air) - 'patch_icpp(2)%alpha(1)' : 1.E+00, # update : volume fraction of fluid 1 in patch 1 (water only) - 'patch_icpp(2)%alpha(2)' : 0.E+00, # update : volume fraction of fluid 2 in patch 1 (no air) - # ========================================================================== - - # Fluids Physical Parameters =============================================== - # Fluid 1 - water ; Fluid 2 - air - 'fluid_pp(1)%gamma' : 1.E+00/(n_w-1.E+00), # update : refferenced 2D_whale_bubble_annulus example for the formula - 'fluid_pp(1)%pi_inf' : n_w*B_w/(n_w-1.E+00), # update : refferenced 2D_whale_bubble_annulus example for the formula - 'fluid_pp(2)%gamma' : 1.E+00/(n_a-1.E+00), # update : refferenced 2D_whale_bubble_annulus example for the formula - 'fluid_pp(2)%pi_inf' : 0.E+00, # update : air has liquid stiffness = 0 - # ========================================================================== - - # Acoustic Wave source ===================================================== - # The acoustic wave is placed at y = 15, ?at each node along the boundary? - 'Monopole' : 'T', # update : creating an acoustic wave - 'num_mono' : 1, # update : place in the middle and expand - 'Mono(1)%pulse' : 3, # update : square wave - 'Mono(1)%npulse' : 1, # update : 1 impulse - 'Mono(1)%mag' : P_amp, # update : magnitude - 'Mono(1)%length' : P_len, # update : impulse length - 'Mono(1)%support' : 2, # update : 2D semi infinite plane (x: -inf,inf; y:-len/2, len/2) - 'Mono(1)%loc(1)' : 0.5, # update : x_center of the domain - 'Mono(1)%loc(2)' : 15, # update : upper boundary of the domain - 'Mono(1)%dir' : theta, # update : direction: -pi/2 - 'Mono(1)%support_width' : 49, # update : 49 cells in each direction - -})) - -# ============================================================================== \ No newline at end of file diff --git a/examples/2D_lungwave/case.py b/examples/2D_lungwave/case.py index a511874ca4..5edc472742 100644 --- a/examples/2D_lungwave/case.py +++ b/examples/2D_lungwave/case.py @@ -3,21 +3,10 @@ import math import json -<<<<<<< HEAD -#material parameter -======= pi = 3.141592653589 # material parameters -# material 1 :: gas -# Patterson 2018 et al. -gammag = 1.4 # unitless -Bg = 0. # Pascals -rhog = 1.18 # kg/m^3 -c_g = 347.2 # m/sec -Gg = 0. # Pascals ->>>>>>> f47f2f4a2186205f772fe3e6a0e9eeb23fe34196 - - #material1 :: gas + +#material1 :: gas #patterson 2018 gammag = 1.4 #unitless @@ -81,8 +70,8 @@ interface_amp = 0.5 # time stepping requirements -time_end = 0.5 -cfl = 0.1 +time_end = 2.5 +cfl = 0.5 dt = cfl * dx/c_l Nt = int(time_end/dt) @@ -139,30 +128,29 @@ 'bc_y%end' : -6, # ========================================================================== - # Monopole settings ======================================================== - 'Monopole' :'T', - 'num_mono' : 1, - 'Mono(1)%pulse' : 3, # this is for a sine wave - 'Mono(1)%npulse' : 10, # one cycle for now - 'Mono(1)%support' : 2, # plane of monopole - 'Mono(1)%support_width' : 10, - 'Mono(1)%loc(1)' : dlengx/2.0, - 'Mono(1)%loc(2)' : 5.0*dlengx, - 'Mono(1)%dir' : 0.0, - 'Mono(1)%mag' : 5.0*patmos_n, - 'Mono(1)%length' : 100.*dlengx, - # ========================================================================== - # Formatted Database Files Structure Parameters ============================ 'format' : 1, 'precision' : 2, 'prim_vars_wrt' :'T', 'parallel_io' :'T', # ========================================================================== + + # Monopole setting ========================================================= + 'Monopole' : 'T', # update : creating an acoustic wave + 'num_mono' : 1, # update : place in the middle and expand + 'Mono(1)%pulse' : 3, # update : sin wave + 'Mono(1)%npulse' : 1, # update : 1 impulse + 'Mono(1)%mag' : 10.0*patmos_n, # update : magnitude + 'Mono(1)%length' : 1*dlengx, # update : impulse length + #'Mono(1)%support' : 2, # update : 2D semi infinite plane (x: -inf,inf; y:-len/2, len/2) + #'Mono(1)%support_width' : 30, # update : 49 cells in each direction + 'Mono(1)%loc(1)' : dlengx/2, # update : x_center of the domain + 'Mono(1)%loc(2)' : 5.0*dlengx, # update : upper boundary of the domain + 'Mono(1)%dir' : -math.pi/2, # update : direction: -pi/2 + #============================================================================== # Patch 1: Background ====================================================== 'patch_icpp(1)%geometry' : 3, - 'patch_icpp(1)%x_centroid' : dlengx/2, 'patch_icpp(1)%y_centroid' : 0., 'patch_icpp(1)%length_x' : dlengx, @@ -200,21 +188,8 @@ 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), - + # ========================================================================== - # Monopole setting ========================================================= - 'Monopole' : 'T', # update : creating an acoustic wave - 'num_mono' : 1, # update : place in the middle and expand - 'Mono(1)%pulse' : 3, # update : sin wave - 'Mono(1)%npulse' : 10, # update : 1 impulse - 'Mono(1)%mag' : 5.0*patmos_n, # update : magnitude - 'Mono(1)%length' : 100*dlengx, # update : impulse length - 'Mono(1)%support' : 2, # update : 2D semi infinite plane (x: -inf,inf; y:-len/2, len/2) - 'Mono(1)%support_width' : 10, # update : 49 cells in each direction - 'Mono(1)%loc(1)' : dlengx/2, # update : x_center of the domain - 'Mono(1)%loc(2)' : 5.0*dlengx, # update : upper boundary of the domain - 'Mono(1)%dir' : 0, # update : direction: -pi/2 - #============================================================================== })) # ============================================================================== diff --git a/examples/2D_lungwave_horizontal/case.py b/examples/2D_lungwave_horizontal/case.py new file mode 100644 index 0000000000..090a61ea47 --- /dev/null +++ b/examples/2D_lungwave_horizontal/case.py @@ -0,0 +1,191 @@ +#!/usr/bin/env python3 + +import math +import json + +pi = 3.141592653589 +# material parameters + +#material1 :: gas +#patterson 2018 + +gammag = 1.4 #unitless +Bg =0 #pascals +rhog = 1.18 #kg/m^3 +c_g = 347.2 #m/s +G_g = 0 #pa + +#material2 :: water +gammal = 5.5 +Bl = 492.E+06 +rhol = 996.0 +c_l = 1648.7 +G_l = 1E3 + +#primitive vartiables +patmos = 101325. #pa + +#problem specific variable +lambda_wave = 1E-3 + +#define pulse +P_amp = 10.E+6 +P_len = 45 #length of the impulse +theta = -math.pi/2 #direction of propagation + +#non-dim + +#define characteristic density, length, time, stress material +rho_char = rhog +length_char = lambda_wave +c_char = c_g +time_char = length_char/c_char +stress_char = rho_char*c_char*c_char/gammag + +#non-dim the properties +rhog_n = rhog/rho_char +c_g_n = c_g/c_char +rhol_n = rhol/rho_char +c_l_n = c_l/c_char +Bg_n = Bg/stress_char +Bl_n = Bl/stress_char +G_g_n = G_g/stress_char +G_l_n = G_l/stress_char +patmos_n = patmos/stress_char +P_amp_n = P_amp/stress_char + +#geometry +dlengx = 20. +dlengy = 1. +Ny = 100 +Nx = dlengx*Ny +dx = dlengx/Nx +dy = dlengy/Ny +alphal_back = 1.0 +alphag_back = 0.0 +alphal_lung = 0.0 +alphag_lung = 1.0 + +interface_amp = 0.5 + +# time stepping requirements +time_end = 5 +cfl = 0.75 + +dt = cfl * dx/c_l +Nt = int(time_end/dt) +Nframes = 50000 +tstart = 0 +tstop = Nt +tsave = int(Nt/Nframes) + +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================================ + 'run_time_info' : 'T', + # ========================================================================== + + # Computational Domain Parameters ========================================== + 'x_domain%beg' : -dlengx/2., + 'x_domain%end' : dlengx/2., + 'y_domain%beg' : 0., + 'y_domain%end' : dlengy, + 'm' : int(Nx), + 'n' : int(Ny), + 'p' : 0, + 'dt' : dt, + 't_step_start' : tstart, + 't_step_stop' : tstop, + 't_step_save' : tsave, + # ========================================================================== + + # Simulation Algorithm Parameters ========================================== + 'num_patches' : 2, + 'model_eqns' : 2, + 'alt_soundspeed' : 'F', + 'num_fluids' : 2, + 'adv_alphan' : 'T', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'time_stepper' : 3, + 'weno_order' : 5, + 'weno_eps' : 1.E-16, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'T', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -1, + 'bc_x%end' : -1, + 'bc_y%beg' : -6, + 'bc_y%end' : -6, + # ========================================================================== + + # Formatted Database Files Structure Parameters ============================ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'T', + # ========================================================================== + + # Patch 1: Background ====================================================== + 'patch_icpp(1)%geometry' : 3, + 'patch_icpp(1)%x_centroid' : 0., + 'patch_icpp(1)%y_centroid' : dlengy/2., + 'patch_icpp(1)%length_x' : dlengx, + 'patch_icpp(1)%length_y' : dlengy, + 'patch_icpp(1)%vel(1)' : 0., + 'patch_icpp(1)%vel(2)' : 0.E+00, + 'patch_icpp(1)%pres' : patmos_n, + 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, + 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, + 'patch_icpp(1)%alpha(1)' : alphal_back, + 'patch_icpp(1)%alpha(2)' : alphag_back, + # ========================================================================== + + + # Patch 2: Lung ============================================================ + 'patch_icpp(2)%geometry' : 7, + 'patch_icpp(2)%hcid' : 206, + 'patch_icpp(2)%alter_patch(1)' : 'T', + 'patch_icpp(2)%x_centroid' : -dlengx/4., + 'patch_icpp(2)%y_centroid' : dlengy/2., + 'patch_icpp(2)%length_x' : dlengx/2.+2, + 'patch_icpp(2)%length_y' : dlengy, + 'patch_icpp(2)%a2' : interface_amp, + 'patch_icpp(2)%vel(1)' : 0.E+00, + 'patch_icpp(2)%vel(2)' : 0.0, + 'patch_icpp(2)%pres' : patmos_n, + 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, + 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, + 'patch_icpp(2)%alpha(1)' : alphal_lung, + 'patch_icpp(2)%alpha(2)' : alphag_lung, + # ========================================================================== + + # Fluids Physical Parameters =============================================== + 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), + 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), + 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), + 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), + + # Monopole setting ========================================================= + 'Monopole' : 'T', # update : creating an acoustic wave + 'num_mono' : 1, # update : place in the middle and expand + 'Mono(1)%pulse' : 3, # update : square wave + 'Mono(1)%npulse' : 1, # update : 1 impulse + 'Mono(1)%mag' : 10.0*patmos_n, # update : magnitude + 'Mono(1)%length' : 1*dlengy, # update : impulse length + 'Mono(1)%support' : 2, # update : 2D semi infinite plane (x: -inf,inf; y:-len/2, len/2) + 'Mono(1)%support_width' : 30, # update + 'Mono(1)%loc(1)' : 0.7*dlengy, # update : x_center of the domain + 'Mono(1)%loc(2)' : dlengy/2, # update : upper boundary of the domain + 'Mono(1)%dir' : -math.pi, # update : direction: -pi/2 + + + #============================================================================== +})) + +# ============================================================================== \ No newline at end of file diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp index 7fb7fa0887..e07821f225 100644 --- a/src/pre_process/include/2dHardcodedIC.fpp +++ b/src/pre_process/include/2dHardcodedIC.fpp @@ -2,7 +2,7 @@ real(kind(0d0)) :: eps real(kind(0d0)) :: r, rmax, gam, umax, p0 - real(kind(0d0)) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph + real(kind(0d0)) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph eps = 1e-9 @@ -103,26 +103,11 @@ case (205) ! 2D lung wave interaction problem h = 0.0 !non dim origin y lam = 1.0 !non dim lambda - !wl = 1.0 !this is non dim wave length of 1 amp = patch_icpp(patch_id)%a2 !to be changed later! !non dim amplitude intH = amp*sin(2*pi*x_cc(i)/lam - pi/2)+h - !alph = 5d-1*(1 + tanh((y_cc(j) - intH)/2.5e-3)) - - !if (alph < eps) alph = eps - !if (alph > 1 - eps) alph = 1 - eps - - if (y_cc(j) > intH) then !this is the liquid - ! q_prim_vf(advxb)%sf(i, j, 0) = alph - ! q_prim_vf(advxe)%sf(i, j, 0) = 1 - alph - ! q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoH - ! q_prim_vf(contxe)%sf(i, j, 0) = (1 - alph)*rhoL - ! q_prim_vf(E_idx)%sf(i, j, 0) = pref + rhoH*9.81*(1.2 - y_cc(j)) - - ! updatig with air, need to define wa - - + if (y_cc(j) > intH) then q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres @@ -130,14 +115,21 @@ q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) end if - !if (y_cc(j) < intH) then !this is the lung - ! q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(patch_id)%alpha_rho(1) - ! q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(patch_id)%alpha_rho(2) - ! q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(patch_id)%pres - ! q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(patch_id)%alpha(1) - ! q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(patch_id)%alpha(2) - !end if + case (206) ! 2D lung wave interaction problem - horizontal domain + h = 0.0 !non dim origin y + lam = 1.0 !non dim lambda + amp = patch_icpp(patch_id)%a2 + + intL = amp*sin(2*pi*y_cc(j)/lam - pi/2)+h + if (x_cc(i) > intL) then !this is the liquid + q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) + q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) + q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres + q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) + q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) + end if + case default if (proc_rank == 0) then call s_int_to_str(patch_id, iStr) diff --git a/src/simulation/m_monopole.fpp b/src/simulation/m_monopole.fpp index 3c316d07e7..ad012a0f2f 100644 --- a/src/simulation/m_monopole.fpp +++ b/src/simulation/m_monopole.fpp @@ -331,6 +331,11 @@ contains if (the_time > t0 .and. the_time < sigt) then f_g = mag(nm) end if + else if (pulse(nm) == 4) then + ! DUS_like wave + sigt = dsqrt(10.d0) + period = length(nm)/sos + f_g = mag(nm)*cos(2.d0*pi*the_time/period)*dexp(-((the_time)**2.d0)/(sigt**2.d0)) else end if From 623d5d609e11ef782cfe12630a9a017352e6e156 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 14 Jun 2024 16:05:57 -0400 Subject: [PATCH 169/380] cleaned up a few files --- examples/2D_lungwave/case.py | 24 ++++++++--------- examples/2D_lungwave_horizontal/case.py | 34 ++++++++++++------------- 2 files changed, 27 insertions(+), 31 deletions(-) diff --git a/examples/2D_lungwave/case.py b/examples/2D_lungwave/case.py index 5edc472742..e5888cbe96 100644 --- a/examples/2D_lungwave/case.py +++ b/examples/2D_lungwave/case.py @@ -136,17 +136,15 @@ # ========================================================================== # Monopole setting ========================================================= - 'Monopole' : 'T', # update : creating an acoustic wave - 'num_mono' : 1, # update : place in the middle and expand - 'Mono(1)%pulse' : 3, # update : sin wave - 'Mono(1)%npulse' : 1, # update : 1 impulse - 'Mono(1)%mag' : 10.0*patmos_n, # update : magnitude - 'Mono(1)%length' : 1*dlengx, # update : impulse length - #'Mono(1)%support' : 2, # update : 2D semi infinite plane (x: -inf,inf; y:-len/2, len/2) - #'Mono(1)%support_width' : 30, # update : 49 cells in each direction - 'Mono(1)%loc(1)' : dlengx/2, # update : x_center of the domain - 'Mono(1)%loc(2)' : 5.0*dlengx, # update : upper boundary of the domain - 'Mono(1)%dir' : -math.pi/2, # update : direction: -pi/2 + 'Monopole' : 'T', # creating an acoustic wave + 'num_mono' : 1, # place in the middle and expand + 'Mono(1)%pulse' : 3, # sine wave + 'Mono(1)%npulse' : 1, # 1 pulse + 'Mono(1)%mag' : 10.0*patmos_n, # magnitude + 'Mono(1)%length' : 1*dlengx, # impulse length + 'Mono(1)%loc(1)' : dlengx/2, # x_center of the domain + 'Mono(1)%loc(2)' : 5.0*dlengx, # upper boundary of the domain + 'Mono(1)%dir' : -math.pi/2, # direction: -pi/2 #============================================================================== # Patch 1: Background ====================================================== @@ -170,9 +168,9 @@ 'patch_icpp(2)%hcid' : 205, 'patch_icpp(2)%alter_patch(1)' : 'T', 'patch_icpp(2)%x_centroid' : dlengx/2., - 'patch_icpp(2)%y_centroid' : -dlengy/4., #moved the center by amp/2 up and increased length of y to account for the bump + 'patch_icpp(2)%y_centroid' : -dlengy/4., 'patch_icpp(2)%length_x' : dlengx, - 'patch_icpp(2)%length_y' : dlengy/2.+2, #add 2 + 'patch_icpp(2)%length_y' : dlengy/2.+2, 'patch_icpp(2)%a2' : interface_amp, 'patch_icpp(2)%vel(1)' : 0.E+00, 'patch_icpp(2)%vel(2)' : 0.0, diff --git a/examples/2D_lungwave_horizontal/case.py b/examples/2D_lungwave_horizontal/case.py index 090a61ea47..9bb498d5cf 100644 --- a/examples/2D_lungwave_horizontal/case.py +++ b/examples/2D_lungwave_horizontal/case.py @@ -130,7 +130,20 @@ 'prim_vars_wrt' :'T', 'parallel_io' :'T', # ========================================================================== - + + # Monopole setting ========================================================= + 'Monopole' : 'T', # creating an acoustic wave + 'num_mono' : 1, # place in the middle and expand + 'Mono(1)%pulse' : 3, # square wave + 'Mono(1)%npulse' : 1, # 1 pulse + 'Mono(1)%mag' : 10.0*patmos_n, # magnitude + 'Mono(1)%length' : 1*dlengy, # pulse length + 'Mono(1)%support' : 2, # 2D semi infinite plane (x: -inf,inf; y:-len/2, len/2) + 'Mono(1)%support_width' : 30, + 'Mono(1)%loc(1)' : 0.7*dlengy, # x_center of the domain + 'Mono(1)%loc(2)' : dlengy/2, # upper boundary of the domain + 'Mono(1)%dir' : -math.pi, # direction: -pi/2 + # Patch 1: Background ====================================================== 'patch_icpp(1)%geometry' : 3, 'patch_icpp(1)%x_centroid' : 0., @@ -146,7 +159,6 @@ 'patch_icpp(1)%alpha(2)' : alphag_back, # ========================================================================== - # Patch 2: Lung ============================================================ 'patch_icpp(2)%geometry' : 7, 'patch_icpp(2)%hcid' : 206, @@ -169,23 +181,9 @@ 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), - 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), - - # Monopole setting ========================================================= - 'Monopole' : 'T', # update : creating an acoustic wave - 'num_mono' : 1, # update : place in the middle and expand - 'Mono(1)%pulse' : 3, # update : square wave - 'Mono(1)%npulse' : 1, # update : 1 impulse - 'Mono(1)%mag' : 10.0*patmos_n, # update : magnitude - 'Mono(1)%length' : 1*dlengy, # update : impulse length - 'Mono(1)%support' : 2, # update : 2D semi infinite plane (x: -inf,inf; y:-len/2, len/2) - 'Mono(1)%support_width' : 30, # update - 'Mono(1)%loc(1)' : 0.7*dlengy, # update : x_center of the domain - 'Mono(1)%loc(2)' : dlengy/2, # update : upper boundary of the domain - 'Mono(1)%dir' : -math.pi, # update : direction: -pi/2 - + 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), #============================================================================== })) -# ============================================================================== \ No newline at end of file +# ============================================================================== From b5874675244a2af98fd0878611f5ce8e36b85cf6 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Mon, 17 Jun 2024 13:18:52 -0400 Subject: [PATCH 170/380] hllc_hypo push --- src/post_process/m_data_output.fpp | 2 +- src/simulation/m_riemann_solvers.fpp | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 2551bc2625..ea000550ae 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -1009,7 +1009,7 @@ contains cent = l end if end do - thres = 0.9d0*max_alph_glb + thres = 0.9d0*maxalph_glb do k = 0, n OLoop: do j = 0, m axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 222e3a1d3f..84198de3c5 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -2142,9 +2142,9 @@ contains Re_avg_rs${XYZ}$_vf(j, k, l, i) = 2d0/(1d0/Re_L(i) + 1d0/Re_R(i)) end do end if - if (wave_speeds == 1) then if (hypoelasticity) then + s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & (((4d0*G_L)/3d0) + & tau_e_L(dir_idx_tau(1)))/rho_L) & From 86c8c60eb0f11c752884de6b02ecec521dc2c776 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Tue, 18 Jun 2024 13:40:04 -0400 Subject: [PATCH 171/380] 1D tests running on hllc hypo --- src/simulation/m_riemann_solvers.fpp | 35 ++++++++++++++-------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 84198de3c5..7e54642eb1 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -2111,7 +2111,7 @@ contains if ((G_L > 1000) .and. (G_R > 1000)) then E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) - ! Additional terms in 2D and 3D + ! Additional terms in 2D and 3D if ((i == 2) .or. (i == 4) .or. (i == 5)) then E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) @@ -2175,7 +2175,7 @@ contains (s_R - vel_R(idx1))) & /(rho_L*(s_L - vel_L(idx1)) - & rho_R*(s_R - vel_R(idx1))) - end if + end if elseif (wave_speeds == 2) then pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & @@ -2241,21 +2241,22 @@ contains (1d0 - dir_flg(idxi))* & vel_R(idxi)) - vel_R(idxi))) + & dir_flg(idxi)*(pres_R) - tau_e_R(dir_idx_tau(i))) - end if !SGR added this if statement for hypo - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & - xi_M*(rho_L*(vel_L(idx1)* & - vel_L(idxi) + & - s_M*(xi_L*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))* & - vel_L(idxi)) - vel_L(idxi))) + & - dir_flg(idxi)*(pres_L)) & - + xi_P*(rho_R*(vel_R(idx1)* & - vel_R(idxi) + & - s_P*(xi_R*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))* & - vel_R(idxi)) - vel_R(idxi))) + & - dir_flg(idxi)*(pres_R)) - ! if (j==0) print*, 'flux_rs_vf', flux_rs_vf(cont_idx%end+dir_idx(i))%sf(j,k,l) + else !SGR added this if statement for hypo + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & + xi_M*(rho_L*(vel_L(idx1)* & + vel_L(idxi) + & + s_M*(xi_L*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))* & + vel_L(idxi)) - vel_L(idxi))) + & + dir_flg(idxi)*(pres_L)) & + + xi_P*(rho_R*(vel_R(idx1)* & + vel_R(idxi) + & + s_P*(xi_R*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))* & + vel_R(idxi)) - vel_R(idxi)))+ & + dir_flg(idxi)*(pres_R)) + end if + ! if (j==0) print*, 'flux_rs_vf', flux_rs_vf(cont_idx%end+dir_idx(i))%sf(j,k,l) end do ! Energy flux. From a1c2dea2365d923953d2b116184f9ed0bdffc6c5 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 19 Jun 2024 13:01:52 -0500 Subject: [PATCH 172/380] added files for the lung problem --- examples/2D_lungwave_horizontal/case.py | 22 +++++++++++----------- submit_gpu_lung.sh | 6 ++++++ 2 files changed, 17 insertions(+), 11 deletions(-) create mode 100755 submit_gpu_lung.sh diff --git a/examples/2D_lungwave_horizontal/case.py b/examples/2D_lungwave_horizontal/case.py index 9bb498d5cf..d11aeac26a 100644 --- a/examples/2D_lungwave_horizontal/case.py +++ b/examples/2D_lungwave_horizontal/case.py @@ -55,9 +55,9 @@ P_amp_n = P_amp/stress_char #geometry -dlengx = 20. -dlengy = 1. -Ny = 100 +dlengx = 10. +dlengy = 2. +Ny = 500 Nx = dlengx*Ny dx = dlengx/Nx dy = dlengy/Ny @@ -70,11 +70,11 @@ # time stepping requirements time_end = 5 -cfl = 0.75 +cfl = 8.0 dt = cfl * dx/c_l Nt = int(time_end/dt) -Nframes = 50000 +Nframes = 500 tstart = 0 tstop = Nt tsave = int(Nt/Nframes) @@ -118,10 +118,10 @@ 'riemann_solver' : 2, 'wave_speeds' : 1, 'avg_state' : 2, - 'bc_x%beg' : -1, - 'bc_x%end' : -1, - 'bc_y%beg' : -6, - 'bc_y%end' : -6, + 'bc_x%beg' : -6, + 'bc_x%end' : -6, + 'bc_y%beg' : -1, + 'bc_y%end' : -1, # ========================================================================== # Formatted Database Files Structure Parameters ============================ @@ -136,8 +136,8 @@ 'num_mono' : 1, # place in the middle and expand 'Mono(1)%pulse' : 3, # square wave 'Mono(1)%npulse' : 1, # 1 pulse - 'Mono(1)%mag' : 10.0*patmos_n, # magnitude - 'Mono(1)%length' : 1*dlengy, # pulse length + 'Mono(1)%mag' : 100.0*patmos_n,# magnitude + 'Mono(1)%length' : 45.0*dlengy, # pulse length 'Mono(1)%support' : 2, # 2D semi infinite plane (x: -inf,inf; y:-len/2, len/2) 'Mono(1)%support_width' : 30, 'Mono(1)%loc(1)' : 0.7*dlengy, # x_center of the domain diff --git a/submit_gpu_lung.sh b/submit_gpu_lung.sh new file mode 100755 index 0000000000..b7902da8db --- /dev/null +++ b/submit_gpu_lung.sh @@ -0,0 +1,6 @@ +#!/bin/bash + +./mfc.sh run ./examples/2D_lungwave_horizontal/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +./mfc.sh run ./examples/2D_lungwave_horizontal/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta + From 564ed18c287f94b31c4c23c590299f1c4b0925be Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Fri, 21 Jun 2024 08:30:01 -0500 Subject: [PATCH 173/380] attempting to fix the code is running a bit slow --- src/common/include/inline_conversions.fpp | 10 +++++----- src/simulation/m_data_output.fpp | 2 +- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/common/include/inline_conversions.fpp b/src/common/include/inline_conversions.fpp index bfdc1344fd..2d74f4aaa6 100644 --- a/src/common/include/inline_conversions.fpp +++ b/src/common/include/inline_conversions.fpp @@ -21,13 +21,13 @@ c = 0d0 !$acc loop seq do i = 1, num_fluids - if (hypoelasticity) then + ! if (hypoelasticity) then blkmod(i) = ((gammas(i) + 1d0)*pres + & pi_infs(i))/gammas(i)+4/3*G(i) - else - blkmod(i) = ((gammas(i) + 1d0)*pres + & - pi_infs(i))/gammas(i) - end if + ! else + ! blkmod(i) = ((gammas(i) + 1d0)*pres + & + ! pi_infs(i))/gammas(i) + ! end if c = c + adv(i)/blkmod(i) end do c = 1d0/(rho*c) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 1546097b2c..535a8cef53 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -330,7 +330,7 @@ contains H = (E + pres)/rho ! Compute mixture sound speed - call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c, fluid_pp(:)%G) + call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c) !SGR added G here for speed of sound if ( c .lt. 10d-12 ) then From 5fc9d9c15e6127cf1c512fd855cc06a5db363ad6 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 26 Jun 2024 17:17:37 -0400 Subject: [PATCH 174/380] still trying compilation --- toolchain/mfc/run/case_dicts.py | 22 ++-------------------- 1 file changed, 2 insertions(+), 20 deletions(-) diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index baca9d8a53..53f10b1eaa 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -8,25 +8,6 @@ class ParamType(Enum): LOG = {"enum": ["T", "F"]} STR = {"type": "string"} -<<<<<<< HEAD -COMMON = [ - "hypoelasticity", "hyperelasticity", "cyl_coord", "pref", "p", "parallel_io", - "Web", "poly_sigma", "case_dir", "thermal", "polytropic", - "m", "mpp_lim", "R0ref", "adv_alphan", "num_fluids", "model_eqns", - "nb", "weno_order", "rhoref", "bubbles", "Re_inv", "n", "precision", - "Ca", "polydisperse", "file_per_process", "relax", "relax_model", - "adv_n" -] - - -PRE_PROCESS = COMMON + [ - 'old_grid', 'old_ic', 't_step_old', 't_step_start', 'vel_profile', - 'instability_wave', 'perturb_flow', 'perturb_flow_fluid', 'perturb_flow_mag', - 'perturb_sph', 'perturb_sph_fluid', 'fluid_rho', 'num_patches', 'qbmm', - 'dist_type', 'R0_type', 'sigR', 'sigV', 'rhoRV', "palpha_eps", "ptgalpha_eps", - 'pi_fac', 'ib', 'num_ibs','pre_stress' -] -======= COMMON = { 'hypoelasticity': ParamType.LOG, 'cyl_coord': ParamType.LOG, @@ -58,6 +39,7 @@ class ParamType(Enum): 'relax_model': ParamType.INT, 'sigma': ParamType.REAL, 'adv_n': ParamType.LOG, + 'hyperelasticity': ParamType.LOG, } PRE_PROCESS = COMMON.copy() @@ -86,8 +68,8 @@ class ParamType(Enum): 'pi_fac': ParamType.REAL, 'ib': ParamType.LOG, 'num_ibs': ParamType.INT, + 'pre_stress': ParamType.LOG, }) ->>>>>>> master for ib_id in range(1, 10+1): for real_attr, ty in [("geometry", ParamType.INT), ("radius", ParamType.REAL), From 63ad273a93256c5e0a4a27398af21c0669295837 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 26 Jun 2024 18:21:33 -0400 Subject: [PATCH 175/380] merged changes with source, cleaned up lung additions that were not necessary --- src/pre_process/m_initial_condition.fpp | 5 +---- src/pre_process/m_patches.fpp | 11 ----------- src/simulation/m_start_up.fpp | 2 +- 3 files changed, 2 insertions(+), 16 deletions(-) diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp index 4ade49af7e..755fa6a32c 100644 --- a/src/pre_process/m_initial_condition.fpp +++ b/src/pre_process/m_initial_condition.fpp @@ -257,10 +257,7 @@ contains ! STL patch elseif (patch_icpp(i)%geometry == 21) then call s_model(i, patch_id_fp, q_prim_vf) - - elseif (patch_icpp(i)%geometry == 22) then - call s_2D_lung(i, patch_id_fp, q_prim_vf, .false.) - + end if !> @} end do diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index f0cc58f604..4849415339 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -1420,7 +1420,6 @@ contains !! @param q_prim_vf Array of primitive variables subroutine s_spherical_harmonic(patch_id, patch_id_fp, q_prim_vf) -<<<<<<< HEAD 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) :: q_prim_vf @@ -1431,16 +1430,6 @@ contains logical :: non_axis_sym integer :: i, j, k !< generic loop iterators -======= - 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(kind(0d0)) :: radius, epsilon, beta - complex(kind(0d0)) :: cmplx_i = (0d0, 1d0) - complex(kind(0d0)) :: H ->>>>>>> source ! Transferring the patch's centroid and radius information x_centroid = patch_icpp(patch_id)%x_centroid diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index bbe2f6a9ab..525bf6b6a5 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -1097,7 +1097,7 @@ contains end do end if - call s_compute_derived_variables(q_prim_vf,t_step) + call s_compute_derived_variables(t_step) #ifdef DEBUG print *, 'Computed derived vars' From 494238ff437485133eeb1ae54ba8a1ddd2025197 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 27 Jun 2024 17:49:27 -0400 Subject: [PATCH 176/380] debugging the code significantly --- batch_mfc.sh | 14 + examples/3D_hyperelasticity/hyper_gel.py | 312 +++++++++++++++++++++++ run_mfc.sh | 14 + src/common/m_variables_conversion.fpp | 88 +++---- src/post_process/m_global_parameters.fpp | 4 + src/pre_process/m_assign_variables.f90 | 10 +- src/pre_process/m_global_parameters.fpp | 4 + src/pre_process/m_initial_condition.fpp | 3 +- src/simulation/m_checker.fpp | 3 - src/simulation/m_data_output.fpp | 27 +- src/simulation/m_global_parameters.fpp | 9 +- src/simulation/m_rhs.fpp | 6 +- src/simulation/m_riemann_solvers.fpp | 33 ++- src/simulation/m_start_up.fpp | 2 +- src/simulation/m_time_steppers.fpp | 13 +- submit_gpu.sh | 42 +++ submit_hyper.sh | 6 + 17 files changed, 486 insertions(+), 104 deletions(-) create mode 100755 batch_mfc.sh create mode 100644 examples/3D_hyperelasticity/hyper_gel.py create mode 100755 run_mfc.sh create mode 100755 submit_gpu.sh create mode 100755 submit_hyper.sh diff --git a/batch_mfc.sh b/batch_mfc.sh new file mode 100755 index 0000000000..41df3c3473 --- /dev/null +++ b/batch_mfc.sh @@ -0,0 +1,14 @@ +#!/bin/bash + +./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar + +./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar + +./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar + diff --git a/examples/3D_hyperelasticity/hyper_gel.py b/examples/3D_hyperelasticity/hyper_gel.py new file mode 100644 index 0000000000..bd153ee797 --- /dev/null +++ b/examples/3D_hyperelasticity/hyper_gel.py @@ -0,0 +1,312 @@ +import math +import json +#need quadrant and collapse near hypoelastic wall + +## Define characteristic values for the sim +Ri = 230.4E-6 +# temperature +T = (10*101325+1.0E+09)/(1000*(2.35-1)*1816) +# print("T :: ",T) +rhog = 1 +Pb = 3550 #Pb = 101325 +Pl = 101325 #Pl = 20*101325 +Po = Pl +Pi_inf_l = 1.0E+09 +Pi_inf_b = 0.0E+00 +Pi_inf_o = 1.1754E+09 + +## fluid properties +# liquid +nl = 2.35E+00 +cv_l = 1816 +rhol = (Pl+Pi_inf_l)/((nl-1)*cv_l*T) +# object +obj_rhol = rhol +cv_o = cv_l +rhoo = 1060 +no = 2.35 +#no = 1.19E+00 +muo = 0.060E+00 +# gas +ng = 1.47E+00 + +# alpha seeding fractions +bub_wl = 1.0E-12 +bub_wo = 1.0E-12 +bub_wg = 1 - bub_wl - bub_wo +liq_wo = 1.0E-12 +liq_wg = 1.0E-12 +liq_wl = 1 - liq_wo - liq_wg +obj_wl = 1.0E-12 +obj_wg = 1.0E-12 +obj_wo = 1 - obj_wl - obj_wg + +Gl = 0. +Gg = 0. +Go = 0.57E+03 #1.0933E+04 + +## mixture values in the liquid +#rhoml = (alpha1-alph_eps)*rhol+alph_eps*rhog +#pi_inf_m = (alpha1-alph_eps)*Pi_inf_l +#nml = (alpha1-alph_eps)*nl+alph_eps*ng +cl = (nl*(Pl+Pi_inf_l)/rhol)**(0.5) +rhoml = liq_wl*rhol + liq_wg*rhog + liq_wo*rhoo + +## Defining Characteristic Values +Rc = Ri +rhoc = rhol +uc = (Pl/rhol)**(0.5E+00) +ucc = (Pl/rhoml)**(0.5E+00) +# characteristic collapse time, change later to prevent horrific confusion +tc = Ri/uc +Pc = rhoc*uc**(2.0E+00) + +## Non-Dimensionalizing values using characteristic values +Rin = Ri/Rc +rholn = rhol/rhoc +rhogn = rhog/rhoc +rhoon = rhoo/rhoc +Pln = Pl/Pc +Pbn = Pb/Pc +Pon = Po/Pc +tcn = tc/tc +Pi_inf_ln = Pi_inf_l/Pc +clc = cl/uc +sod_nd = 2.17 +#clmc = clm/ucc +Pi_inf_on = Pi_inf_o/Pc + +# Un comment if dimensional +#Rin = Ri +#rholn = rhol +#rhogn = rhog +#rhoon = rhoo +#Pln = Pl +#Pbn = Pb/rhoo +#Pon = Po +#tcn = tc +#Pi_inf_ln = Pi_inf_l +#leng = domain_length +#clc = cl +#sod_nd = sod + +## Non-Dimensional Numbers +#Rel = rhol*uc*2*Rin/mulc +#Reb = rhog*uc*2*Rin/mubc +Rel = 0 +Reb = 0 +Reo = rhoo*uc*2/muo +Ma = uc/cl +Co = Pl/Go +iCo = 1/Co + +## GEOMETRY:: Grid Specifications +lengx = 8.0E+00 +lengy = 3.0E+00 +lengz = 3.0E+00 +CFL = 0.3 +PPBR = 16 #92 +x_beg = -5.0E+00 +x_end = 3.0E+00 +y_beg = 0.0E+00 +y_end = lengy +z_beg = 0.0E+00 +z_end = lengz +Nx = PPBR*lengx +Ny = PPBR*lengy +Nz = PPBR*lengz +delta_x = lengx/Nx +delta_t = CFL*delta_x/clc + +#print("NX :: ",Nx,", NY :: ",Ny,", NZ :: ",Nz) + +#delta_t_c = 0.185*delta_x/clmc +#print(delta_t_c) + +Nt = int(1.7*tcn/delta_t) +# liquid centroid, patch 1 +x_centroidl = x_beg/(2.0E+00) +y_centroidl = (y_end+y_beg)/(2.0E+00) +z_centroidl = (z_end+z_beg)/(2.0E+00) +# bubble centroid, patch 2 +x_centroidb = -sod_nd +y_centroidb = 0.0 +z_centroidb = 0.0 +# objective centroid, patch 3 +x_centroido = x_end/2 +y_centroido = (y_end+y_beg)/(2.0E+00) +z_centroido = (z_end+z_beg)/(2.0E+00) + +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================ + 'run_time_info' : 'T', + 'sim_data' : 'T', + # ========================================================== + + # Computational Domain Parameters ========================== + 'x_domain%beg' : x_beg, + 'x_domain%end' : x_end, + 'y_domain%beg' : y_beg, + 'y_domain%end' : y_end, + 'z_domain%beg' : z_beg, + 'z_domain%end' : z_end, + 'm' : int(Nx), + 'n' : int(Ny), + 'p' : int(Nz), + 'cyl_coord' : 'F', + 'dt' : delta_t, + 't_step_start' : 0, + 't_step_stop' : Nt, + 't_step_save' : int(5),#int(Nt/150), +# ========================================================== + + # Simulation Algorithm Parameters ========================== + 'num_patches' : 3, + 'model_eqns' : 2, + 'hypoelasticity' : 'F', + 'hyperelasticity' : 'T', + 'pre_stress' : 'F', + 'alt_soundspeed' : 'F', + 'num_fluids' : 3, + 'adv_alphan' : 'T', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'time_stepper' : 3, + 'weno_order' : 5, + 'weno_eps' : 1.E-16, + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'T', + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'riemann_solver' : 1, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -6, #-16,#-2 + 'bc_x%end' : -6, + 'bc_y%beg' : -2, + 'bc_y%end' : -6, + 'bc_z%beg' : -2, + 'bc_z%end' : -6, + 'stretch_x' : 'F', + 'stretch_y' : 'F', + 'stretch_z' : 'F', + 'a_x' : 4.0E+00, + 'x_a' : -1.5E+00-sod_nd, + 'x_b' : 2.5E+00, + #'loops_x' : 0, + 'a_y' : 4.0E+00, + 'y_a' : -1.5E+00, + 'y_b' : 1.5E+00, + #'loops_y' : 0, + 'a_z' : 4.0E+00, + 'z_a' : -1.5E+00, + 'z_b' : 1.5E+00, + #'loops_z' : 0, + # ========================================================== + + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'T', + 'probe_wrt' :'T', + 'fd_order' : 1, + 'num_probes' : 1, + 'probe(1)%x' : 0., + 'probe(1)%y' : 0., + 'probe(1)%z' : 0., + # ========================================================== + + # Patch 1: Background ============================ + 'patch_icpp(1)%geometry' : 9,# for 3D + 'patch_icpp(1)%x_centroid' : x_centroidl, #100*x_centroidl, + 'patch_icpp(1)%y_centroid' : y_centroidl, #100*y_centroidl, + 'patch_icpp(1)%z_centroid' : z_centroidl, #100*z_centroidl, + 'patch_icpp(1)%length_x' : lengx, #200*lengx, + 'patch_icpp(1)%length_y' : lengy, #200*lengy, + 'patch_icpp(1)%length_z' : lengz, #200*lengz, + 'patch_icpp(1)%vel(1)' : 0.E+00, + 'patch_icpp(1)%vel(2)' : 0.E+00, + 'patch_icpp(1)%vel(3)' : 0.E+00, + 'patch_icpp(1)%pres' : Pln, + 'patch_icpp(1)%alpha_rho(1)' : liq_wl*rholn, + 'patch_icpp(1)%alpha_rho(2)' : liq_wg*rhogn, + 'patch_icpp(1)%alpha_rho(3)' : liq_wo*rhoon, + 'patch_icpp(1)%alpha(1)' : liq_wl, + 'patch_icpp(1)%alpha(2)' : liq_wg, + 'patch_icpp(1)%alpha(3)' : liq_wo, + # ========================================================== + # Patch 2: Bubble ====================================== + # Specify the spherical gas bubble grid geometry + 'patch_icpp(2)%geometry' : 8,# for 3D + 'patch_icpp(2)%smoothen' : 'T', + 'patch_icpp(2)%smooth_patch_id' : 1, + 'patch_icpp(2)%smooth_coeff' : 4.0E+00, + 'patch_icpp(2)%x_centroid' : x_centroidb, + 'patch_icpp(2)%y_centroid' : y_centroidb, + 'patch_icpp(2)%z_centroid' : z_centroidb, + 'patch_icpp(2)%radius' : Rin, + 'patch_icpp(2)%alter_patch(1)' : 'T', + # Specify the patch primitive variables + 'patch_icpp(2)%vel(1)' : 0.E+00, + 'patch_icpp(2)%vel(2)' : 0.E+00, + 'patch_icpp(2)%vel(3)' : 0.E+00, + 'patch_icpp(2)%pres' : Pbn, + 'patch_icpp(2)%alpha_rho(1)' : bub_wl*rholn, + 'patch_icpp(2)%alpha_rho(2)' : bub_wg*rhogn, + 'patch_icpp(2)%alpha_rho(3)' : bub_wo*rhoon, + 'patch_icpp(2)%alpha(1)' : bub_wl, + 'patch_icpp(2)%alpha(2)' : bub_wg, + 'patch_icpp(2)%alpha(3)' : bub_wo, + # ========================================================== + # Patch 3: Gel =========================================== + # Specify the gel grid geometry + 'patch_icpp(3)%geometry' : 9,# for 3D + 'patch_icpp(3)%x_centroid' : x_centroido, #100*x_centroido, + 'patch_icpp(3)%y_centroid' : y_centroido, #100*y_centroido, + 'patch_icpp(3)%z_centroid' : z_centroido, #100*z_centroido, + 'patch_icpp(3)%length_x' : 3.0E+00, #100*lengx, + 'patch_icpp(3)%length_y' : lengy, #200*lengy, + 'patch_icpp(3)%length_z' : lengz, #200*lengz, + 'patch_icpp(3)%alter_patch(1)' : 'T', + # Specify the patch primitive variables + 'patch_icpp(3)%vel(1)' : 0.E+00, + 'patch_icpp(3)%vel(2)' : 0.E+00, + 'patch_icpp(3)%vel(3)' : 0.E+00, + 'patch_icpp(3)%pres' : Pon, + 'patch_icpp(3)%alpha_rho(1)' : obj_wl*rholn, + 'patch_icpp(3)%alpha_rho(2)' : obj_wg*rhogn, + 'patch_icpp(3)%alpha_rho(3)' : obj_wo*rhoon, + 'patch_icpp(3)%alpha(1)' : obj_wl, + 'patch_icpp(3)%alpha(2)' : obj_wg, + 'patch_icpp(3)%alpha(3)' : obj_wo, + # ========================================================== + + + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1./(nl-1.), + 'fluid_pp(1)%pi_inf' : nl*Pi_inf_ln/(nl-1.), + 'fluid_pp(1)%G' : Gl, + 'fluid_pp(2)%gamma' : 1./(ng-1.), + 'fluid_pp(2)%pi_inf' : 0.0E+00, + 'fluid_pp(2)%G' : Gg, + 'fluid_pp(3)%gamma' : 1./(no-1.), + 'fluid_pp(3)%pi_inf' : no*Pi_inf_on/(no-1.), + 'fluid_pp(3)%G' : iCo, + 'fluid_pp(1)%qv' : 0.0E+00, + 'fluid_pp(1)%qvp' : 0.0E+00, + 'fluid_pp(2)%qv' : 0.0E+00, + 'fluid_pp(2)%qvp' : 0.0E+00, + 'fluid_pp(3)%qv' : 0.0E+00, + 'fluid_pp(3)%qvp' : 0.0E+00, +# 'fluid_pp(1)%Re(1)' : Rel, +# 'fluid_pp(2)%Re(1)' : Reb, +# 'fluid_pp(3)%Re(1)' : Reo, + # ===========++============================================= +})) + +# ============================================================================== + + diff --git a/run_mfc.sh b/run_mfc.sh new file mode 100755 index 0000000000..fc734beaea --- /dev/null +++ b/run_mfc.sh @@ -0,0 +1,14 @@ +#!/bin/bash + +./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar + +./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar + +./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar + diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 33a147b29a..46461d8e9b 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -149,7 +149,7 @@ contains )**(1/gamma + 1) - pi_inf end if - if ( (hypoelasticity .or. hyperelasticity) .and. present(G)) then + if ( hypoelasticity .and. present(G)) then !if ( hypoelasticity .and. present(G)) then ! calculate elastic contribution to Energy E_e = 0d0 @@ -929,7 +929,7 @@ contains if (model_eqns /= 4) then #ifdef MFC_SIMULATION ! If in simulation, use acc mixture subroutines - if (hypoelasticity) then ! .or. hyperelasticity) then + if (elasticity) then call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & alpha_rho_K, Re_K, j, k, l, G_K, Gs) else if (bubbles) then @@ -941,7 +941,7 @@ contains end if #else ! If pre-processing, use non acc mixture subroutines - if (hypoelasticity) then !.or. hyperelasticity) then + if (elasticity) then call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) else @@ -1034,8 +1034,7 @@ contains if ( hyperelasticity ) then !$acc loop seq do i = xibeg, xiend - qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & - / rho_K + ! qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K !print *, 'i ::',i,',j,k,l ::',j,k,l,', qprim ::',qK_prim_vf(i)%sf(j,k,l) end do end if @@ -1053,17 +1052,17 @@ contains end do !$acc end parallel loop - ! going through hyperelasticity to calculate btensor - ! s_calculate_btensor has its own triple nested for loop with openacc + !print *, 'I got here AA' + #ifdef MFC_SIMULATION - if (hyperelasticity) then + if ( hyperelasticity ) then ! MAURO HERE - call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf, 0, m, 0, n, 0, p) - + !call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf, 0, m, 0, n, 0, p) + !print *, 'I got here AAA' !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) - do l = 0, p - do k = 0, n - do j = 0, m + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe !$acc loop seq do i = 1, num_fluids alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) @@ -1072,11 +1071,12 @@ contains ! If in simulation, use acc mixture subroutines call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & alpha_rho_K, Re_K, j, k, l, G_K, Gs) - if (G_K > 1d-3) then - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K + rho_K = max(rho_K, sgm_eps) + !if (G_K > 1d-3) then + ! qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & + !G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) - end if + !end if end do end do end do @@ -1085,12 +1085,12 @@ contains #endif #ifdef MFC_POST_PROCESS - do l = 1, b_size + do l = 1, b_size allocate(q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) end do if (hyperelasticity) then - call s_calculate_btensor(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) + !call s_calculate_btensor(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) do l = 0, p do k = 0, n do j = 0, m @@ -1101,9 +1101,9 @@ contains ! If pre-processing, use non acc mixture subroutines call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) - if ( G_K > 1d-3 ) then - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K + if ( G_K > 1000 ) then + !qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) ! - & + !G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K end if end do end do @@ -1124,14 +1124,8 @@ contains subroutine s_convert_primitive_to_conservative_variables(q_prim_vf, & q_cons_vf) - type(scalar_field), & - dimension(sys_size), & - intent(in) :: q_prim_vf - - type(scalar_field), & - dimension(sys_size), & - intent(inout) :: q_cons_vf - + type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf type(scalar_field), dimension(b_size) :: q_btensor ! Density, specific heat ratio function, liquid stiffness function @@ -1156,8 +1150,8 @@ contains ! going through hyperelasticity again due to the btensor calculation ! s_calculate_btensor has its own triple nested for loop, with openacc - if (hyperelasticity ) then - call s_calculate_btensor(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) + if ( hyperelasticity ) then + !call s_calculate_btensor(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) end if ! Converting the primitive variables to the conservative variables @@ -1272,11 +1266,11 @@ contains if ( hyperelasticity ) then ! adding the elastic contribution do i = xibeg, xiend - q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) + !q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) end do - if (G > 1d-3) then - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - G*f_elastic_energy(q_btensor, j, k, l) + if (G > 1000) then + !q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & + ! G*f_elastic_energy(q_btensor, j, k, l) end if end if @@ -1373,7 +1367,7 @@ contains end do pres_K = qK_prim_vf(j, k, l, E_idx) - if (hypoelasticity .or. hyperelasticity) then + if (elasticity) then call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, & alpha_K, alpha_rho_K, Re_K, & j, k, l, G_K, Gs) @@ -1485,9 +1479,9 @@ contains subroutine s_calculate_btensor_acc(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(OUT) :: btensor - integer, intent(IN) :: xb, xe, yb, ye, zb, ze + type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(inout) :: btensor + integer, intent(in) :: xb, xe, yb, ye, zb, ze real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb integer :: j, k, l, i @@ -1525,11 +1519,15 @@ contains ! !$acc end parallel loop ! else ! 3D + + !print *,'I got here AAAA' !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) do l = zb, ze do k = yb, ye do j = xb, xe - + !print *, j,k,l + !print *,xibeg + !print *,xiend ! STEP 1: computing the grad_xi tensor ! grad_xi definition / organization ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx @@ -1904,6 +1902,7 @@ contains /(12d0*(z_cb(l) - z_cb(l - 1))) end if + !print *, 'I got here AAAAA' ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) @@ -1950,7 +1949,7 @@ contains do i = 1, tensor_size - 1 tensora(i) = tensorb(i)/tensorb(tensor_size) end do - + !print *, 'I got here A6' ! STEP 3: computing F tranpose F !tensorb(1) = tensora(1)**2 tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 @@ -1962,7 +1961,7 @@ contains tensorb(4) = tensorb(2) tensorb(7) = tensorb(3) tensorb(8) = tensorb(6) - + !print *, 'I got here A7' !call s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, & !iye, izb, ize, j, k, l, tensora, tensorb) !! 1: 1D, 3: 2D, 6: 3D @@ -1972,13 +1971,14 @@ contains btensor(4)%sf(j,k,l) = tensorb(5) btensor(5)%sf(j,k,l) = tensorb(6) btensor(6)%sf(j,k,l) = tensorb(9) + !print *, 'I got here A8' !! store the determinant at the last entry of the btensor sf btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) end do end do end do !$acc end parallel loop - + !print *, 'I got here A9' ! end if end subroutine s_calculate_btensor_acc diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index c208db65c7..ddfca98727 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -94,6 +94,7 @@ module m_global_parameters logical :: alt_soundspeed !< Alternate sound speed logical :: hypoelasticity !< Turn hypoelasticity on logical :: hyperelasticity !< Turn hyperelasticity on + logical :: elasticity !< elasticity modeling, true for hyper or hypo integer :: b_size !< Number of components in the b tensor integer :: tensor_size !< Number of components in the nonsymmetric tensor !> @} @@ -292,6 +293,7 @@ contains hypoelasticity = .false. hyperelasticity = .false. + elasticity = .false. bc_x%beg = dflt_int; bc_x%end = dflt_int bc_y%beg = dflt_int; bc_y%end = dflt_int @@ -496,6 +498,7 @@ contains stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 sys_size = stress_idx%end + elasticity = .true. end if if (hyperelasticity) then @@ -507,6 +510,7 @@ contains ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 tensor_size = num_dims**2 + 1 + elasticity = .true. end if if (sigma /= dflt_real) then diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 index 54f0e20296..ff17a222f3 100644 --- a/src/pre_process/m_assign_variables.f90 +++ b/src/pre_process/m_assign_variables.f90 @@ -457,6 +457,7 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & ! Elastic Shear Stress if (hyperelasticity) then + if (pre_stress) then ! pre stressed initial condition in spatial domain rcoord = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2)) theta = atan2(y_cc(k), x_cc(j)) @@ -473,13 +474,10 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & end if do i = 1, num_dims - q_prim_vf(i+xibeg-1)%sf(j,k,l) = xi_cart(i) + q_prim_vf(i+xibeg-1)%sf(j,k,l) = eta*xi_cart(i) + & + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1) end do - !(eta*xi_cart(i) + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1)) - !if (proc_rank == 0) then - ! write(*,*) 'q(',i,') :: ',q_prim_vf(i+stress_idx%end)%sf(j, k, l), & - ! ', xi_cart :: ',xi_cart(i) - !end if + end if if (mpp_lim .and. bubbles) then diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index ccb9285536..d2e9542b70 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -84,6 +84,7 @@ module m_global_parameters integer :: weno_order !< Order of accuracy for the WENO reconstruction logical :: hypoelasticity !< activate hypoelasticity logical :: hyperelasticity !< activate hyperelasticity + logical :: elasticity !< elasticity modeling, true for hyper or hypo integer :: b_size !< Number of components in the b tensor integer :: tensor_size !< Number of components in the nonsymmetric tensor logical :: pre_stress !< activate pre_stressed domain @@ -286,6 +287,7 @@ contains hypoelasticity = .false. hyperelasticity = .false. + elasticity = .false. pre_stress = .false. bc_x%beg = dflt_int; bc_x%end = dflt_int @@ -600,6 +602,7 @@ contains stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D sys_size = stress_idx%end + elasticity = .true. end if if (hyperelasticity) then @@ -611,6 +614,7 @@ contains ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 tensor_size = num_dims**2 + 1 + elasticity = .true. end if if (sigma /= dflt_real) then diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp index 755fa6a32c..f81fe81636 100644 --- a/src/pre_process/m_initial_condition.fpp +++ b/src/pre_process/m_initial_condition.fpp @@ -315,8 +315,7 @@ contains if (instability_wave) call s_superposition_instability_wave() ! Converting the primitive variables to the conservative ones - call s_convert_primitive_to_conservative_variables(q_prim_vf, & - q_cons_vf) + call s_convert_primitive_to_conservative_variables(q_prim_vf, q_cons_vf) if (qbmm .and. .not. polytropic) then !Initialize pb and mv diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index 1af5ceb211..ba0bb65775 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -306,9 +306,6 @@ contains elseif (riemann_solver /= 2 .and. alt_soundspeed) then call s_mpi_abort('Unsupported combination of riemann_solver '// & 'and alt_soundspeed. Exiting ...') - elseif ((hypoelasticity .or. hyperelasticity) .and. (riemann_solver /= 1)) then - call s_mpi_abort('hypoelasticity and hyperelasticity requires riemann_solver = 1'// & - 'Exiting ...') end if if (adap_dt) then diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index f3bfaa71d0..311207d55b 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -332,13 +332,16 @@ contains H = (E + pres)/rho + ! Compute mixture sound speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c) - if (c < 1d-12) then - !print *, 'crashed at processor: ', proc_rank,' at j :: ',j,', k :: ',k,' l :: ',l - !print *, 'with alpha1 ::', alpha(1),'and alpha2 ::',alpha(2), ' alpha3 :: ',alpha(3) - !stop + if (c /= c) then + print *, 'crashed at processor: ', proc_rank,', at j :: ',j,', k :: ',k,' l :: ',l + print *, 'alpha1 ::', alpha(1),'and alpha2 ::',alpha(2), ' alpha3 :: ',alpha(3) + print *, 'alpha_rho1 ::', alpha_rho(1),', alpha_rho2 ::',alpha_rho(2), ' alpha_rho3 :: ',alpha_rho(3) + print *, 'E :: ',E,', pres :: ',pres,', rho :: ',rho + call s_mpi_abort('Exiting ...') end if if (grid_geometry == 3) then @@ -1214,7 +1217,7 @@ contains l = 0 ! Computing/Sharing necessary state variables - if (hypoelasticity .or. hyperelasticity) then + if (elasticity) then call s_convert_to_mixture_variables(q_cons_vf, j - 2, k, l, & rho, gamma, pi_inf, qv, & Re, G, fluid_pp(:)%G) @@ -1228,7 +1231,7 @@ contains dyn_p = 0.5d0*rho*dot_product(vel, vel) - if (hypoelasticity .or. hyperelasticity) then + if (elasticity) then call s_compute_pressure( & q_cons_vf(1)%sf(j - 2, k, l), & @@ -1245,7 +1248,7 @@ contains if (model_eqns == 4) then lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 - else if (hypoelasticity .or. hyperelasticity) then + else if (elasticity) then tau_e(1) = q_cons_vf(stress_idx%end)%sf(j - 2, k, l)/rho end if @@ -1329,7 +1332,7 @@ contains dyn_p = 0.5d0*rho*dot_product(vel, vel) - if (hypoelasticity) then + if (elasticity) then call s_compute_pressure( & q_cons_vf(1)%sf(j - 2, k - 2, l), & q_cons_vf(alf_idx)%sf(j - 2, k - 2, l), & @@ -1344,7 +1347,7 @@ contains if (model_eqns == 4) then lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 - else if (hypoelasticity .or. hyperelasticity) then + else if (elasticity) then do s = 1, 3 tau_e(s) = q_cons_vf(s)%sf(j - 2, k - 2, l)/rho end do @@ -1410,7 +1413,7 @@ contains dyn_p = 0.5d0*rho*dot_product(vel, vel) - if (hypoelasticity) then + if (elasticity) then call s_compute_pressure( & q_cons_vf(1)%sf(j - 2, k - 2, l - 2), & q_cons_vf(alf_idx)%sf(j - 2, k - 2, l - 2), & @@ -1457,7 +1460,7 @@ contains end if end if - if (hypoelasticity .or. hyperelasticity) then + if (elasticity) then do s = 1, (num_dims*(num_dims + 1))/2 tmp = tau_e(s) call s_mpi_allreduce_sum(tmp, tau_e(s)) @@ -1550,7 +1553,7 @@ contains nRdot(1), & R(1), & Rdot(1) - else if (hypoelasticity .or. hyperelasticity) then + else if (elasticity) then write (i + 30, '(6X,F12.12,F24.8,F24.8,F24.8,F24.8,'// & 'F24.8,F24.8,F24.8)') & nondim_time, & diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 46e7f00ea2..16d8734261 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -146,7 +146,7 @@ module m_global_parameters logical :: mixture_err !< Mixture properties correction logical :: hypoelasticity !< hypoelasticity modeling logical :: hyperelasticity !< hyperelasticity modeling - logical :: elasticity !< elasticity modeling + logical :: elasticity !< elasticity modeling, true for hyper or hypo logical :: cu_tensor logical :: bodyForces @@ -166,7 +166,7 @@ module m_global_parameters !$acc declare create(num_dims, weno_polyn, weno_order, num_fluids, wenojs, mapped_weno, wenoz, teno) #:endif - !$acc declare create(mpp_lim, model_eqns, mixture_err,alt_soundspeed, avg_state, mp_weno, weno_eps, teno_CT,hypoelasticity,hyperelasticity) + !$acc declare create(mpp_lim, model_eqns,mixture_err,alt_soundspeed, avg_state, mp_weno, weno_eps, teno_CT, hypoelasticity, hyperelasticity, elasticity) logical :: relax !< activate phase change integer :: relax_model !< Relaxation model @@ -831,7 +831,6 @@ contains if ( hypoelasticity ) then elasticity = .true. - hyperelasticity = .false. stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D @@ -840,7 +839,7 @@ contains if ( hyperelasticity ) then elasticity = .true. - hypoelasticity = .false. + !print *, elasticity ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 @@ -1071,7 +1070,7 @@ contains !$acc update device(m, n, p) !$acc update device(alt_soundspeed, monopole, num_mono) - !$acc update device(dt, sys_size, buff_size, pref, rhoref, gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim, bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids, model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord, mp_weno, weno_eps, teno_CT, hyperelasticity) + !$acc update device(dt, sys_size, buff_size, pref, rhoref,gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim,bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids,model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord,mp_weno, weno_eps, teno_CT, hyperelasticity,elasticity) #:if not MFC_CASE_OPTIMIZATION !$acc update device(wenojs, mapped_weno, wenoz, teno) diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index f7b97320ec..68d950bbc3 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -798,9 +798,9 @@ contains print *, "I got here B" call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") - if ( hyperelasticity ) then - call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) - end if + !if ( hyperelasticity ) then + ! call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) + !end if call nvtxEndRange call nvtxStartRange("RHS-MPI") diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 995224e289..fe988dee2c 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -558,7 +558,7 @@ contains end if if (wave_speeds == 1) then - if ( hypoelasticity ) then + if ( elasticity ) then s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & (((4d0*G_L)/3d0) + & tau_e_L(dir_idx_tau(1)))/rho_L) & @@ -571,12 +571,11 @@ contains , vel_L(dir_idx(1)) + sqrt(c_L*c_L + & (((4d0*G_L)/3d0) + & tau_e_L(dir_idx_tau(1)))/rho_L)) - elseif ( hyperelasticity ) then - s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L ) & - , vel_R(dir_idx(1)) - sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R )) - s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R ) & - , vel_L(dir_idx(1)) + sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L )) - + !elseif ( hyperelasticity ) then + ! s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L ) & + ! , vel_R(dir_idx(1)) - sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R )) + ! s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R ) & + ! , vel_L(dir_idx(1)) + sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L )) else s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) @@ -753,16 +752,16 @@ contains end do ! Xi field - if ( hyperelasticity ) then - do i = 1, num_dims - flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & - (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & - - s_P*rho_L*vel_L(dir_idx(1))*xi_field_L(i) & - + s_M*s_P*(rho_L*xi_field_L(i) & - - rho_R*xi_field_R(i))) & - /(s_M - s_P) - end do - end if + !if ( hyperelasticity ) then + ! do i = 1, num_dims + ! flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & + ! (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & + ! - s_P*rho_L*vel_L(dir_idx(1))*xi_field_L(i) & + ! + s_M*s_P*(rho_L*xi_field_L(i) & + ! - rho_R*xi_field_R(i))) & + ! /(s_M - s_P) + ! end do + !end if ! Div(U)? !$acc loop seq diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 168c33ad09..e7157a1cdd 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -585,7 +585,7 @@ contains NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) ! Read the data for each variable - if ( bubbles .or. hypoelasticity .or. hyperelasticity ) then + if ( bubbles .or. elasticity ) then do i = 1, sys_size!adv_idx%end var_MOK = int(i, MPI_OFFSET_KIND) diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index b30554bc35..8fab76310f 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -181,7 +181,7 @@ contains end if end if - if (hypoelasticity) then + if (elasticity) then do i = stress_idx%beg, stress_idx%end @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & iy_t%beg:iy_t%end, & @@ -191,12 +191,6 @@ contains end if if (hyperelasticity) then - do i = stress_idx%beg, stress_idx%end - @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & - iy_t%beg:iy_t%end, & - iz_t%beg:iz_t%end)) - @:ACC_SETUP_SFs(q_prim_vf(i)) - end do do i = xibeg, xiend + 1 @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & iy_t%beg:iy_t%end, & @@ -1030,16 +1024,13 @@ contains @:DEALLOCATE(q_prim_vf(i)%sf) end do - if (hypoelasticity) then + if (elasticity) then do i = stress_idx%beg, stress_idx%end @:DEALLOCATE(q_prim_vf(i)%sf) end do end if if (hyperelasticity) then - do i = stress_idx%beg, stress_idx%end - @:DEALLOCATE(q_prim_vf(i)%sf) - end do do i = xibeg, xiend + 1 @:DEALLOCATE(q_prim_vf(i)%sf) end do diff --git a/submit_gpu.sh b/submit_gpu.sh new file mode 100755 index 0000000000..6909cf3938 --- /dev/null +++ b/submit_gpu.sh @@ -0,0 +1,42 @@ +#!/bin/bash + +### A100s +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwex_pre -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta + +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta + +### A40s +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwex_pre -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# test -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta + +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 03:00:00 -# test_sim -t simulation -a bciv-delta-gpu -c delta + + +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# bwex_post -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta + +#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# test_post -t post_process -a bciv-delta-gpu -c delta + +#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta + +./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta + +#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta + diff --git a/submit_hyper.sh b/submit_hyper.sh new file mode 100755 index 0000000000..1bc47245cd --- /dev/null +++ b/submit_hyper.sh @@ -0,0 +1,6 @@ +#!/bin/bash + +./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar +#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta + From c808065cd51fdef7fc228acfe8cec17bcf70260f Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 27 Jun 2024 18:33:10 -0400 Subject: [PATCH 177/380] fixing global parameters --- src/simulation/m_global_parameters.fpp | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 16d8734261..9418bae7a0 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -829,8 +829,11 @@ contains end if end if - if ( hypoelasticity ) then - elasticity = .true. + if ( hypoelasticity .or. hyperelasticity ) then + elasticity = .true. + end if + + if ( elasticity ) then stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D @@ -838,11 +841,6 @@ contains end if if ( hyperelasticity ) then - elasticity = .true. - !print *, elasticity - ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 ! storing the jacobian in the last entry From be469bba552b5e16fe12a58da2fbd11fdebf7363 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 27 Jun 2024 19:22:06 -0400 Subject: [PATCH 178/380] debugged the hypoelasticity riemann issue, compiles, passes test suite, example hyperelasticity fails --- examples/3D_hyperelasticity/hyper_gel.py | 4 ++-- src/post_process/m_global_parameters.fpp | 19 +++++++++---------- src/pre_process/m_checker.f90 | 22 ++++++++++------------ src/pre_process/m_global_parameters.fpp | 11 +++++------ src/simulation/m_global_parameters.fpp | 6 +++--- src/simulation/m_riemann_solvers.fpp | 2 +- 6 files changed, 30 insertions(+), 34 deletions(-) diff --git a/examples/3D_hyperelasticity/hyper_gel.py b/examples/3D_hyperelasticity/hyper_gel.py index bd153ee797..7f8a2df452 100644 --- a/examples/3D_hyperelasticity/hyper_gel.py +++ b/examples/3D_hyperelasticity/hyper_gel.py @@ -164,8 +164,8 @@ # Simulation Algorithm Parameters ========================== 'num_patches' : 3, 'model_eqns' : 2, - 'hypoelasticity' : 'F', - 'hyperelasticity' : 'T', + 'hypoelasticity' : 'T', + 'hyperelasticity' : 'F', 'pre_stress' : 'F', 'alt_soundspeed' : 'F', 'num_fluids' : 3, diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index ddfca98727..568de47501 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -493,24 +493,23 @@ contains end if - if (hypoelasticity) then - ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - sys_size = stress_idx%end - elasticity = .true. + if (hypoelasticity .or. hyperelasticity) then + elasticity = .true. + end if + + if (elasticity) then + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end end if if (hyperelasticity) then - ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! adding three more equations for the \xi field and the elastic energy sys_size = stress_idx%end + num_dims + 1 ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 tensor_size = num_dims**2 + 1 - elasticity = .true. end if if (sigma /= dflt_real) then diff --git a/src/pre_process/m_checker.f90 b/src/pre_process/m_checker.f90 index 8b0e255e1c..03ce268064 100644 --- a/src/pre_process/m_checker.f90 +++ b/src/pre_process/m_checker.f90 @@ -103,12 +103,12 @@ subroutine s_check_inputs 'exiting ...') end if - if (hyperelasticity .and. (model_eqns /= 2)) then - call s_mpi_abort('hyperelasticity requires model_eqns = 2'// & - 'exiting ...') - end if + !if (hyperelasticity .and. (model_eqns /= 2)) then + ! call s_mpi_abort('hyperelasticity requires model_eqns = 2'// & + ! 'exiting ...') + !end if - if (pre_stress .and. .not. hyperelasticity) then + if (pre_stress .and. .not. hyperelasticity) then call s_mpi_abort('pre_stress requires hyperelasticity'// & 'exiting ...') end if @@ -713,13 +713,11 @@ subroutine s_check_inputs call s_mpi_abort('Unsupported value of '// & 'fluid_pp('//trim(iStr)//')%'// & 'cv. Make sure cv is positive. Exiting ...') - ! elseif ((hyperelasticity .or. hypoelasticity) & - ! .and. & - ! fluid_pp(i)%G /= dflt_real) then - ! call s_mpi_abort('Unsupported combination '// & - ! 'of values of model_eqns '// & - ! 'and fluid_pp('//trim(iStr)//')%'// & - ! 'hyperelasticity. Exiting ...') + elseif (elasticity .and. fluid_pp(i)%G /= dflt_real) then + call s_mpi_abort('Unsupported combination '// & + 'of values of model_eqns '// & + 'and fluid_pp('//trim(iStr)//')%'// & + 'elasticity. Exiting ...') end if end do diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index d2e9542b70..8f307d61ee 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -597,24 +597,23 @@ contains end if end if - if (hypoelasticity) then + if (hypoelasticity .or. hyperelasticity) then + elasticity = .true. + end if + + if (elasticity) then stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D sys_size = stress_idx%end - elasticity = .true. end if if (hyperelasticity) then - ! number of distinct stress is 1 in 1D, 2 in 2D, and 3 in 3D - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! adding three more equations for the \xi field and the elastic energy sys_size = stress_idx%end + num_dims + 1 ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 tensor_size = num_dims**2 + 1 - elasticity = .true. end if if (sigma /= dflt_real) then diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 9418bae7a0..ae057aa9b6 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -829,18 +829,18 @@ contains end if end if - if ( hypoelasticity .or. hyperelasticity ) then + if (hypoelasticity .or. hyperelasticity) then elasticity = .true. end if - if ( elasticity ) then + if (elasticity) then stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D sys_size = stress_idx%end end if - if ( hyperelasticity ) then + if (hyperelasticity) then ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 ! storing the jacobian in the last entry diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index fe988dee2c..29befeeb71 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -506,7 +506,7 @@ contains end if ! elastic energy update - if ( hypoelasticity ) then + if ( hyperelasticity ) then G_L = 0d0 G_R = 0d0 From 67efa55f9c458d925e92582b63c0dbf72f4214ab Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 27 Jun 2024 20:19:55 -0400 Subject: [PATCH 179/380] added more changes to the code, still testing --- examples/3D_hyperelasticity/hyper_gel.py | 4 +- src/post_process/m_global_parameters.fpp | 9 +++-- src/pre_process/m_global_parameters.fpp | 9 +++-- src/simulation/m_global_parameters.fpp | 13 +++--- src/simulation/m_riemann_solvers.fpp | 50 ++++++++++++------------ 5 files changed, 47 insertions(+), 38 deletions(-) diff --git a/examples/3D_hyperelasticity/hyper_gel.py b/examples/3D_hyperelasticity/hyper_gel.py index 7f8a2df452..bd153ee797 100644 --- a/examples/3D_hyperelasticity/hyper_gel.py +++ b/examples/3D_hyperelasticity/hyper_gel.py @@ -164,8 +164,8 @@ # Simulation Algorithm Parameters ========================== 'num_patches' : 3, 'model_eqns' : 2, - 'hypoelasticity' : 'T', - 'hyperelasticity' : 'F', + 'hypoelasticity' : 'F', + 'hyperelasticity' : 'T', 'pre_stress' : 'F', 'alt_soundspeed' : 'F', 'num_fluids' : 3, diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 568de47501..4e575e768f 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -112,6 +112,7 @@ module m_global_parameters integer :: alf_idx !< Index of specific heat ratio func. eqn. integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. type(int_bounds_info) :: stress_idx !< Indices of elastic stresses + type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. integer :: c_idx !< Index of color function !> @} @@ -505,8 +506,10 @@ contains end if if (hyperelasticity) then + xi_idx%beg = sys_size + 1 + xi_idx%end = sys_size + num_dims ! adding three more equations for the \xi field and the elastic energy - sys_size = stress_idx%end + num_dims + 1 + sys_size = xi_idx%end + 1 ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 tensor_size = num_dims**2 + 1 @@ -611,8 +614,8 @@ contains strxe = stress_idx%end intxb = internalEnergies_idx%beg intxe = internalEnergies_idx%end - xibeg = stress_idx%end+1 - xiend = stress_idx%end+num_dims + xibeg = xi_idx%beg + xiend = xi_idx%end ! ================================================================== #ifdef MFC_MPI diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 8f307d61ee..0c71331be4 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -101,6 +101,7 @@ module m_global_parameters integer :: gamma_idx !< Index of specific heat ratio func. eqn. integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. type(int_bounds_info) :: stress_idx !< Indexes of elastic shear stress eqns. + type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. integer :: c_idx !< Index of the color function type(int_bounds_info) :: bc_x, bc_y, bc_z !< @@ -609,8 +610,10 @@ contains end if if (hyperelasticity) then + xi_idx%beg = sys_size + 1 + xi_idx%end = sys_size + num_dims ! adding three more equations for the \xi field and the elastic energy - sys_size = stress_idx%end + num_dims + 1 + sys_size = xi_idx%end + 1 ! number of entries in the symmetric btensor plus the jacobian b_size = (num_dims*(num_dims + 1))/2 + 1 tensor_size = num_dims**2 + 1 @@ -716,8 +719,8 @@ contains strxe = stress_idx%end intxb = internalEnergies_idx%beg intxe = internalEnergies_idx%end - xibeg = stress_idx%end+1 - xiend = stress_idx%end+num_dims + xibeg = xi_idx%beg + xiend = xi_idx%end ! ================================================================== diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index ae057aa9b6..6c57a8a109 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -222,6 +222,7 @@ module m_global_parameters integer :: gamma_idx !< Index of specific heat ratio func. eqn. integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. type(int_bounds_info) :: stress_idx !< Indexes of first and last shear stress eqns. + type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. integer :: b_size !< Number of elements in the symmetric b tensor, plus one integer :: tensor_size !< Number of elements in the full tensor plus one integer :: c_idx !< Index of the color function @@ -277,7 +278,7 @@ module m_global_parameters integer :: startx, starty, startz - !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx, b_size, tensor_size) + !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx, b_size, tensor_size, xi_idx) ! END: Simulation Algorithm Parameters ===================================== @@ -845,8 +846,10 @@ contains b_size = (num_dims*(num_dims + 1))/2 + 1 ! storing the jacobian in the last entry tensor_size = num_dims**2 + 1 + xi_idx%beg = sys_size + 1 + xi_idx%end = sys_size + num_dims ! adding three more equations for the \xi field and the elastic energy - sys_size = stress_idx%end + num_dims + 1 + sys_size = xi_idx%end + 1 end if if (sigma /= dflt_real) then @@ -1061,14 +1064,14 @@ contains strxe = stress_idx%end intxb = internalEnergies_idx%beg intxe = internalEnergies_idx%end - xibeg = stress_idx%end+1 - xiend = stress_idx%end+num_dims + xibeg = xi_idx%beg + xiend = xi_idx%end !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe, b_size, xibeg, xiend, tensor_size) !$acc update device(m, n, p) !$acc update device(alt_soundspeed, monopole, num_mono) - !$acc update device(dt, sys_size, buff_size, pref, rhoref,gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim,bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids,model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord,mp_weno, weno_eps, teno_CT, hyperelasticity,elasticity) + !$acc update device(dt, sys_size, buff_size, pref, rhoref,gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim,bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids,model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord,mp_weno, weno_eps, teno_CT, hyperelasticity, elasticity, xi_idx) #:if not MFC_CASE_OPTIMIZATION !$acc update device(wenojs, mapped_weno, wenoz, teno) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 29befeeb71..e3eb994e56 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -506,31 +506,31 @@ contains end if ! elastic energy update - if ( hyperelasticity ) then - G_L = 0d0 - G_R = 0d0 - - !$acc loop seq - do i = 1, num_fluids - G_L = G_L + alpha_L(i)*Gs(i) - G_R = G_R + alpha_R(i)*Gs(i) - end do - ! Elastic contribution to energy if G large enough - if ((G_L > 1d-3) .and. (G_R > 1d-3)) then - E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) - E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) - !$acc loop seq - do i = 1, b_size-1 - tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) - end do - !$acc loop seq - do i = 1, num_dims - xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) - xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) - end do - end if - end if + !if ( hyperelasticity ) then + ! G_L = 0d0 + ! G_R = 0d0 + ! + ! !$acc loop seq + ! do i = 1, num_fluids + ! G_L = G_L + alpha_L(i)*Gs(i) + ! G_R = G_R + alpha_R(i)*Gs(i) + ! end do + ! ! Elastic contribution to energy if G large enough + ! if ((G_L > 1d-3) .and. (G_R > 1d-3)) then + ! E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) + ! E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) + ! !$acc loop seq + ! do i = 1, b_size-1 + ! tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + ! tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + ! end do + ! !$acc loop seq + ! do i = 1, num_dims + ! xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) + ! xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) + ! end do + ! end if + !end if ! moving this down to account for the elasticity H_L = (E_L + pres_L)/rho_L From a8fd46c6eedd7d13b1947779e3dd5bb556c1f3ed Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 27 Jun 2024 20:03:27 -0500 Subject: [PATCH 180/380] added some small changes to the code towards tesing --- src/common/m_variables_conversion.fpp | 16 ++++++++-------- src/simulation/m_data_output.fpp | 16 ++++++++-------- src/simulation/m_global_parameters.fpp | 8 ++++---- src/simulation/m_rhs.fpp | 10 +++++----- 4 files changed, 25 insertions(+), 25 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 46461d8e9b..5635ad7ac0 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1520,14 +1520,14 @@ contains ! else ! 3D - !print *,'I got here AAAA' + !print *,'I got here AAAA' !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) do l = zb, ze do k = yb, ye do j = xb, xe - !print *, j,k,l - !print *,xibeg - !print *,xiend + !print *, j,k,l + !print *,xibeg + !print *,xiend ! STEP 1: computing the grad_xi tensor ! grad_xi definition / organization ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx @@ -1902,7 +1902,7 @@ contains /(12d0*(z_cb(l) - z_cb(l - 1))) end if - !print *, 'I got here AAAAA' + !print *, 'I got here AAAAA' ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) @@ -1949,7 +1949,7 @@ contains do i = 1, tensor_size - 1 tensora(i) = tensorb(i)/tensorb(tensor_size) end do - !print *, 'I got here A6' + !print *, 'I got here A6' ! STEP 3: computing F tranpose F !tensorb(1) = tensora(1)**2 tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 @@ -1961,7 +1961,7 @@ contains tensorb(4) = tensorb(2) tensorb(7) = tensorb(3) tensorb(8) = tensorb(6) - !print *, 'I got here A7' + !print *, 'I got here A7' !call s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, & !iye, izb, ize, j, k, l, tensora, tensorb) !! 1: 1D, 3: 2D, 6: 3D @@ -1971,7 +1971,7 @@ contains btensor(4)%sf(j,k,l) = tensorb(5) btensor(5)%sf(j,k,l) = tensorb(6) btensor(6)%sf(j,k,l) = tensorb(9) - !print *, 'I got here A8' + !print *, 'I got here A8' !! store the determinant at the last entry of the btensor sf btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) end do diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 311207d55b..12165f2f91 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -1217,7 +1217,7 @@ contains l = 0 ! Computing/Sharing necessary state variables - if (elasticity) then + if (hypoelasticity) then call s_convert_to_mixture_variables(q_cons_vf, j - 2, k, l, & rho, gamma, pi_inf, qv, & Re, G, fluid_pp(:)%G) @@ -1231,7 +1231,7 @@ contains dyn_p = 0.5d0*rho*dot_product(vel, vel) - if (elasticity) then + if (hypoelasticity) then call s_compute_pressure( & q_cons_vf(1)%sf(j - 2, k, l), & @@ -1248,7 +1248,7 @@ contains if (model_eqns == 4) then lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 - else if (elasticity) then + else if (hypoelasticity) then tau_e(1) = q_cons_vf(stress_idx%end)%sf(j - 2, k, l)/rho end if @@ -1332,7 +1332,7 @@ contains dyn_p = 0.5d0*rho*dot_product(vel, vel) - if (elasticity) then + if (hypoelasticity) then call s_compute_pressure( & q_cons_vf(1)%sf(j - 2, k - 2, l), & q_cons_vf(alf_idx)%sf(j - 2, k - 2, l), & @@ -1347,7 +1347,7 @@ contains if (model_eqns == 4) then lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 - else if (elasticity) then + else if (hypoelasticity) then do s = 1, 3 tau_e(s) = q_cons_vf(s)%sf(j - 2, k - 2, l)/rho end do @@ -1413,7 +1413,7 @@ contains dyn_p = 0.5d0*rho*dot_product(vel, vel) - if (elasticity) then + if (hypoelasticity) then call s_compute_pressure( & q_cons_vf(1)%sf(j - 2, k - 2, l - 2), & q_cons_vf(alf_idx)%sf(j - 2, k - 2, l - 2), & @@ -1460,7 +1460,7 @@ contains end if end if - if (elasticity) then + if (hypoelasticity) then do s = 1, (num_dims*(num_dims + 1))/2 tmp = tau_e(s) call s_mpi_allreduce_sum(tmp, tau_e(s)) @@ -1553,7 +1553,7 @@ contains nRdot(1), & R(1), & Rdot(1) - else if (elasticity) then + else if (hypoelasticity) then write (i + 30, '(6X,F12.12,F24.8,F24.8,F24.8,F24.8,'// & 'F24.8,F24.8,F24.8)') & nondim_time, & diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 6c57a8a109..2644da807a 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -831,10 +831,10 @@ contains end if if (hypoelasticity .or. hyperelasticity) then - elasticity = .true. - end if + elasticity = .true. + end if - if (elasticity) then + if (elasticity) then stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D @@ -847,7 +847,7 @@ contains ! storing the jacobian in the last entry tensor_size = num_dims**2 + 1 xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims + xi_idx%end = sys_size + num_dims ! adding three more equations for the \xi field and the elastic energy sys_size = xi_idx%end + 1 end if diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 68d950bbc3..d8ee007f3e 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -786,7 +786,7 @@ contains end do end do end if - print *, "I got here A" + !print *, "I got here A" call nvtxStartRange("RHS-CONVERT") call s_convert_conservative_to_primitive_variables( & q_cons_qp%vf, & @@ -795,7 +795,7 @@ contains ix, iy, iz, & q_btensor%vf) call nvtxEndRange - print *, "I got here B" + !print *, "I got here B" call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") !if ( hyperelasticity ) then @@ -806,7 +806,7 @@ contains call nvtxStartRange("RHS-MPI") call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) call nvtxEndRange - print *, "I got here c" + !print *, "I got here c" if (t_step == t_step_stop) return ! ================================================================== @@ -920,7 +920,7 @@ contains end if ix%end = m; iy%end = n; iz%end = p ! =============================================================== - print *, "I got here d" + !print *, "I got here d" ! Computing Riemann Solver Flux and Source Flux ================= call nvtxStartRange("RHS_riemann_solver") @@ -940,7 +940,7 @@ contains flux_gsrc_n(id)%vf, & id, ix, iy, iz) call nvtxEndRange - print *, "I got here e" + !print *, "I got here e" ! =============================================================== ! Additional physics and source terms =========================== From bc066766f437d19fdaa32bb79591ab85c83a8413 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 27 Jun 2024 21:03:44 -0400 Subject: [PATCH 181/380] small change --- src/common/m_variables_conversion.fpp | 32 +++++++++++++-------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 46461d8e9b..95647b9232 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1031,13 +1031,13 @@ contains end do end if - if ( hyperelasticity ) then - !$acc loop seq - do i = xibeg, xiend - ! qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K - !print *, 'i ::',i,',j,k,l ::',j,k,l,', qprim ::',qK_prim_vf(i)%sf(j,k,l) - end do - end if + !if ( hyperelasticity ) then + ! !$acc loop seq + ! do i = xibeg, xiend + ! ! qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K + ! !print *, 'i ::',i,',j,k,l ::',j,k,l,', qprim ::',qK_prim_vf(i)%sf(j,k,l) + ! end do + !end if !$acc loop seq do i = advxb, advxe qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) @@ -1069,9 +1069,9 @@ contains alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) end do ! If in simulation, use acc mixture subroutines - call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & - alpha_rho_K, Re_K, j, k, l, G_K, Gs) - rho_K = max(rho_K, sgm_eps) + !call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & + ! alpha_rho_K, Re_K, j, k, l, G_K, Gs) + !rho_K = max(rho_K, sgm_eps) !if (G_K > 1d-3) then ! qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & !G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K @@ -1099,12 +1099,12 @@ contains alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) end do ! If pre-processing, use non acc mixture subroutines - call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & - rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) - if ( G_K > 1000 ) then - !qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) ! - & - !G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K - end if + !call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & + ! rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) + !if ( G_K > 1000 ) then + ! !qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) ! - & + ! !G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K + !end if end do end do end do From e90802ac7792422f0f7f91688a6963962f73daff Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 28 Jun 2024 01:04:17 -0400 Subject: [PATCH 182/380] fixed issue in inline Riemann function, compiles and passes tests --- src/common/include/inline_conversions.fpp | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/src/common/include/inline_conversions.fpp b/src/common/include/inline_conversions.fpp index ef66ae5079..2a18bf6d93 100644 --- a/src/common/include/inline_conversions.fpp +++ b/src/common/include/inline_conversions.fpp @@ -20,21 +20,16 @@ c = 0d0 !$acc loop seq do i = 1, num_fluids - ! if (hypoelasticity) then - blkmod(i) = ((gammas(i) + 1d0)*pres + & - pi_infs(i))/gammas(i)+4/3*G(i) - ! else + ! if (hypoelasticity) then ! blkmod(i) = ((gammas(i) + 1d0)*pres + & - ! pi_infs(i))/gammas(i) + ! pi_infs(i))/gammas(i)+4/3*G(i) + ! else + blkmod(i) = ((gammas(i) + 1d0)*pres + & + pi_infs(i))/gammas(i) ! end if c = c + adv(i)/blkmod(i) end do c = 1d0/(rho*c) -! blkmod1 = ((gammas(1) + 1d0)*pres + & -! pi_infs(1))/gammas(1) -! blkmod2 = ((gammas(2) + 1d0)*pres + & -! pi_infs(2))/gammas(2) -! c = (1d0/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2))) elseif (model_eqns == 3) then c = 0d0 !$acc loop seq From 8607cc943cf9182f8e612eacae793a5e3740d5fc Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Fri, 28 Jun 2024 08:54:03 -0500 Subject: [PATCH 183/380] Removed G contribution to speed of sound, needs debugging --- src/common/include/inline_conversions.fpp | 30 +++++++---------------- 1 file changed, 9 insertions(+), 21 deletions(-) diff --git a/src/common/include/inline_conversions.fpp b/src/common/include/inline_conversions.fpp index 2d74f4aaa6..3c11fafb62 100644 --- a/src/common/include/inline_conversions.fpp +++ b/src/common/include/inline_conversions.fpp @@ -10,32 +10,19 @@ real(kind(0d0)), intent(IN) :: H real(kind(0d0)), dimension(num_fluids), intent(IN) :: adv real(kind(0d0)), intent(IN) :: vel_sum + real(kind(0d0)), optional, dimension(num_fluids), intent(IN) :: G real(kind(0d0)), intent(OUT) :: c - real(kind(0d0)), dimension(num_fluids), intent(IN), optional :: G - real(kind(0d0)), dimension(num_fluids) :: blkmod + real(kind(0d0)) :: blkmod1, blkmod2, blkmod3 - integer :: q, i + integer :: q if (alt_soundspeed) then - c = 0d0 - !$acc loop seq - do i = 1, num_fluids - ! if (hypoelasticity) then - blkmod(i) = ((gammas(i) + 1d0)*pres + & - pi_infs(i))/gammas(i)+4/3*G(i) - ! else - ! blkmod(i) = ((gammas(i) + 1d0)*pres + & - ! pi_infs(i))/gammas(i) - ! end if - c = c + adv(i)/blkmod(i) - end do - c = 1d0/(rho*c) -! blkmod1 = ((gammas(1) + 1d0)*pres + & -! pi_infs(1))/gammas(1) -! blkmod2 = ((gammas(2) + 1d0)*pres + & -! pi_infs(2))/gammas(2) -! c = (1d0/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2))) + blkmod1 = ((gammas(1) + 1d0)*pres + & + pi_infs(1))/gammas(1) + blkmod2 = ((gammas(2) + 1d0)*pres + & + pi_infs(2))/gammas(2) + c = (1d0/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2))) elseif (model_eqns == 3) then c = 0d0 !$acc loop seq @@ -57,6 +44,7 @@ (pres + pi_inf/(gamma + 1d0))/ & (rho*(1d0 - adv(num_fluids))) end if + else c = ((H - 5d-1*vel_sum)/gamma) end if From 688be39422664b55f7cd8251088173a69ce2b3c0 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Fri, 28 Jun 2024 09:32:10 -0500 Subject: [PATCH 184/380] fixed compilation issue --- src/common/include/inline_conversions.fpp | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/common/include/inline_conversions.fpp b/src/common/include/inline_conversions.fpp index 555de788fb..c2f0263e69 100644 --- a/src/common/include/inline_conversions.fpp +++ b/src/common/include/inline_conversions.fpp @@ -12,8 +12,7 @@ real(kind(0d0)), intent(IN) :: vel_sum real(kind(0d0)), optional, dimension(num_fluids), intent(IN) :: G real(kind(0d0)), intent(OUT) :: c - real(kind(0d0)), dimension(num_fluids), intent(IN), optional :: G - real(kind(0d0)), dimension(num_fluids) :: blkmod + real(kind(0d0)) :: blkmod1, blkmod2 integer :: q From 2b74034aed05413ad1867d126e2919bf1e7d62ab Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 28 Jun 2024 11:23:52 -0500 Subject: [PATCH 185/380] made changes for GPUs, untested --- src/common/include/inline_conversions.fpp | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/src/common/include/inline_conversions.fpp b/src/common/include/inline_conversions.fpp index 2a18bf6d93..e1ac97f25d 100644 --- a/src/common/include/inline_conversions.fpp +++ b/src/common/include/inline_conversions.fpp @@ -14,24 +14,22 @@ real(kind(0d0)), dimension(num_fluids), intent(IN), optional :: G real(kind(0d0)), dimension(num_fluids) :: blkmod - integer :: q, i - + integer :: q + c = 0d0 if (alt_soundspeed) then - c = 0d0 !$acc loop seq - do i = 1, num_fluids + do q = 1, num_fluids ! if (hypoelasticity) then ! blkmod(i) = ((gammas(i) + 1d0)*pres + & ! pi_infs(i))/gammas(i)+4/3*G(i) ! else - blkmod(i) = ((gammas(i) + 1d0)*pres + & - pi_infs(i))/gammas(i) + blkmod(q) = ((gammas(q) + 1d0)*pres + & + pi_infs(q))/gammas(q) ! end if - c = c + adv(i)/blkmod(i) + c = c + adv(q)/blkmod(q) end do c = 1d0/(rho*c) elseif (model_eqns == 3) then - c = 0d0 !$acc loop seq do q = 1, num_fluids c = c + adv(q)*(1d0/gammas(q) + 1d0)* & From 01276829d74109874fbc926c1afa500bd7d09000 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 28 Jun 2024 15:19:35 -0500 Subject: [PATCH 186/380] code runs on Oscar CPUs and Delta GPUs --- src/common/include/inline_conversions.fpp | 27 ++++++++++++----------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/src/common/include/inline_conversions.fpp b/src/common/include/inline_conversions.fpp index f8d187a309..03ce3813ff 100644 --- a/src/common/include/inline_conversions.fpp +++ b/src/common/include/inline_conversions.fpp @@ -16,28 +16,29 @@ integer :: q - c = 0d0 if (alt_soundspeed) then - !$acc loop seq - do q = 1, num_fluids + !!acc loop seq + !c = 0d0 + !do q = 1, num_fluids ! if (hypoelasticity) then ! blkmod(i) = ((gammas(i) + 1d0)*pres + & ! pi_infs(i))/gammas(i)+4/3*G(i) ! else - blkmod(q) = ((gammas(q) + 1d0)*pres + & - pi_infs(q))/gammas(q) + ! blkmod(q) = ((gammas(q) + 1d0)*pres + & + ! pi_infs(q))/gammas(q) ! end if - c = c + adv(q)/blkmod(q) - end do - c = 1d0/(rho*c) + ! c = c + adv(q)/blkmod(q) + !end do + !c = 1d0/(rho*c) !if (alt_soundspeed) then - ! blkmod1 = ((gammas(1) + 1d0)*pres + & - ! pi_infs(1))/gammas(1) - ! blkmod2 = ((gammas(2) + 1d0)*pres + & - ! pi_infs(2))/gammas(2) - ! c = (1d0/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2))) + blkmod1 = ((gammas(1) + 1d0)*pres + & + pi_infs(1))/gammas(1) + blkmod2 = ((gammas(2) + 1d0)*pres + & + pi_infs(2))/gammas(2) + c = (1d0/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2))) elseif (model_eqns == 3) then + c = 0d0 !$acc loop seq do q = 1, num_fluids c = c + adv(q)*(1d0/gammas(q) + 1d0)* & From e9b7412f41dec590f4f2a8786e7752223c9cac14 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 29 Jun 2024 16:44:17 -0400 Subject: [PATCH 187/380] added input file and testing hyperelasticity --- examples/2D_phasechange_bubble/case.py | 286 +++++++++++++++++++++++ examples/3D_hyperelasticity/hyper_gel.py | 2 +- src/common/m_variables_conversion.fpp | 43 ++-- 3 files changed, 308 insertions(+), 23 deletions(-) create mode 100644 examples/2D_phasechange_bubble/case.py diff --git a/examples/2D_phasechange_bubble/case.py b/examples/2D_phasechange_bubble/case.py new file mode 100644 index 0000000000..5fbe5f83ac --- /dev/null +++ b/examples/2D_phasechange_bubble/case.py @@ -0,0 +1,286 @@ +#!/usr/bin/env python3 +import math, json + +## 1 FOR BACKGROUND, 2 FOR BUBBLE +# Pressure [Pa] +p01 = 5E6 +p02 = 3550 + +# Temperature [K] +T01 = 298.15 +T02 = 298.15 +#T02 = 7.914 + +#### FLUID PROPERTIES #### + +### liquid water ### +# pi infty +piwl = 1.0E+09 +# qv +qvwl = -1167000 +# qv' +qvpwl = 0.0E0 +# cv +cvwl = 1816 +# cp +cpwl = 4267 +# gamma +gamwl = cpwl / cvwl + +## FOR PATCHES 1 & 2 ## + +# density +rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) +rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) + +# speed of sound FOR +c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) +c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) + +# part for Gases - relations from IMR +Ru = 8.3144598 # Universal gas constant (J/mol-K) + +### Vapor water ### +Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) +# gamma +gamwv = 1.4 +# cp +cpwv = Rv * gamwv/(gamwv-1) +# cv +cvwv = cpwv/gamwv +# pi infinity +piwv = 0.0E0 +# qv +qvwv = 2030000 +# qv' +qvpwv = -23400 + +## FOR PATCHES 1 & 2 ## + +# density +rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) +rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) + +# speed of sound +c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) +c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) + +### Air ### + +Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) +# gamma +gama = 1.4 +# cp +cpa = Ra * gama/(gama-1) +# cv +cva = cpa/gama +# pi infinity +pia = 0.0E0 +# qv +qva = 0.0E0 +# qv' +qvpa = 0.0E0 + +## FOR PATCHES 1 & 2 ## + +# density +rho0a1 = (p01 + pia)/((gama-1)*cva*T01) +rho0a2 = (p02 + pia)/((gama-1)*cva*T02) + +# Speed of sound +c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) +c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) + +## SHOCK RELATIONS +p02Op01 = p02 / p01 + +# Mach number of the shocked region - this should agree with Min, if everything is correct +Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) + +# shock speed +ss = Ms * c_a1 + +### volume fractions for each of the patches ### +C0 = 0.25 # vapor concentration for IMR + +# water liquid +awl1 = 1.00E00-2.00E-12 +awl2 = 1.00E-12 +# water vapor +awv1 = 1.00E-12 +awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) +# air +aa1 = 1.0 - awl1 - awv1 +aa2 = 1.0 - awl2 - awv2 + +## SIMULATION PARAMETERS + +# CFL +cfl = 0.50 + +# Bubble Initial Radius +R0 = 30E-06 + +# number of elements +Nx0 = 400 +Nx = 1600 +Ny = 1600 +Nz = 1600 + +# domain boundaries +xb = 0.00 +xe = 120E-6 + +yb = 0.00 +ye = 120E-6 + +zb = 0.00 +ze = 120E-6 + +# typical cell size +dx = ( xe - xb ) / Nx +dy = ( ye - yb ) / Ny +dz = ( ze - zb ) / Nz + +# time step + +# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) +SF = 200 + +# Critical time-step +tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) + +# making Nt divisible by SF +# tendA = 1.5 * tc +tend = 1.2 * tc + +# 1 - ensure NtA is sufficient to go a little beyond tendA +# NtA = int( tendA // dt + 1 ) + +# Array of saves. it is the same as Nt/Sf = t_step_save +# AS = int( NtA // SF + 1 ) + +# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) +# Nt = AS * SF +Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) + +dt = tend / Nt + +AS = int( Nt//SF ) + +# Total physical time +# tend = Nt * dt + +# Configuring case dictionary ================================================== +print(json.dumps({ + # Logistics ================================================ + 'run_time_info': 'T', + # ========================================================== + # Computational Domain Parameters ========================== + 'x_domain%beg' : xb, + 'x_domain%end' : xe, + 'y_domain%beg' : yb, + 'y_domain%end' : ye, + 'stretch_x' : 'T', + 'loops_x' : 3, + 'a_x' : 4.0E0, + 'x_a' : -2.0*R0, + 'x_b' : 2.0*R0, + 'stretch_y' : 'T', + 'loops_y' : 3, + 'a_y' : 4.0E0, + 'y_a' : -2.0*R0, + 'y_b' : 2.0*R0, + 'cyl_coord' : 'T', + 'm' : Nx, + 'n' : Ny, + 'p' : 0, + 'dt' : dt, + 't_step_start' : 0, + 't_step_stop' : Nt, + 't_step_save' : AS, + # ========================================================== + # Simulation Algorithm Parameters ========================== + 'num_patches' : 2, + 'model_eqns' : 3, + 'num_fluids' : 3, + 'adv_alphan' : 'T', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'relax' : 'T', + 'relax_model' : 6, + 'palpha_eps' : 1.0E-8, + 'ptgalpha_eps' : 1.0E-2, + 'time_stepper' : 3, + 'weno_order' : 3, + 'weno_eps' : 1.0E-16, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'F', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -2, + 'bc_x%end' : -6, + 'bc_y%beg' : -2, + 'bc_y%end' : -6, + # ========================================================== + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt':'T', + 'parallel_io' :'T', + # ========================================================== + # Patch 1: High pressured water ============================ + # Specify the cubic water background grid geometry + 'patch_icpp(1)%geometry' : 3, + 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, + 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, + 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, + 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, + 'patch_icpp(1)%vel(1)' : 0.0E+00, + 'patch_icpp(1)%vel(2)' : 0.0E+00, + 'patch_icpp(1)%pres' : p01, + 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, + 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, + 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, + 'patch_icpp(1)%alpha(1)' : awl1, + 'patch_icpp(1)%alpha(2)' : awv1, + 'patch_icpp(1)%alpha(3)' : aa1, + # ========================================================== + # Patch 2: (Vapor) Bubble ================================== + 'patch_icpp(2)%geometry' : 2, + 'patch_icpp(2)%x_centroid' : xb, + 'patch_icpp(2)%y_centroid' : yb, + 'patch_icpp(2)%radius' : R0, + 'patch_icpp(2)%vel(1)' : 0.0E+00, + 'patch_icpp(2)%vel(2)' : 0.0E+00, + 'patch_icpp(2)%pres' : p02, + 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, + 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, + 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, + 'patch_icpp(2)%alpha(1)' : awl2, + 'patch_icpp(2)%alpha(2)' : awv2, + 'patch_icpp(2)%alpha(3)' : aa2, + 'patch_icpp(2)%alter_patch(1)' : 'T', + # ========================================================== + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), + 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), + 'fluid_pp(1)%cv' : cvwl, + 'fluid_pp(1)%qv' : qvwl, + 'fluid_pp(1)%qvp' : qvpwl, + 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), + 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), + 'fluid_pp(2)%cv' : cvwv, + 'fluid_pp(2)%qv' : qvwv, + 'fluid_pp(2)%qvp' : qvpwv, + 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), + 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), + 'fluid_pp(3)%cv' : cva, + 'fluid_pp(3)%qv' : qva, + 'fluid_pp(3)%qvp' : qvpa, + # ========================================================== +})) diff --git a/examples/3D_hyperelasticity/hyper_gel.py b/examples/3D_hyperelasticity/hyper_gel.py index bd153ee797..09782de488 100644 --- a/examples/3D_hyperelasticity/hyper_gel.py +++ b/examples/3D_hyperelasticity/hyper_gel.py @@ -170,7 +170,7 @@ 'alt_soundspeed' : 'F', 'num_fluids' : 3, 'adv_alphan' : 'T', - 'mpp_lim' : 'T', + 'mpp_lim' : 'F', 'mixture_err' : 'T', 'time_stepper' : 3, 'weno_order' : 5, diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index e11c735fb9..2d698e3df0 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1011,7 +1011,7 @@ contains end if end if - if ( hypoelasticity ) then + if (hypoelasticity) then !$acc loop seq do i = strxb, strxe qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & @@ -1055,19 +1055,18 @@ contains !print *, 'I got here AA' #ifdef MFC_SIMULATION - if ( hyperelasticity ) then - ! MAURO HERE + if (hyperelasticity) then !call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf, 0, m, 0, n, 0, p) !print *, 'I got here AAA' !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe - !$acc loop seq - do i = 1, num_fluids - alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) - alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) - end do + !do l = izb, ize + ! do k = iyb, iye + ! do j = ixb, ixe + !!$acc loop seq + !do i = 1, num_fluids + ! alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) + ! alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) + !end do ! If in simulation, use acc mixture subroutines !call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & ! alpha_rho_K, Re_K, j, k, l, G_K, Gs) @@ -1077,9 +1076,9 @@ contains !G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) !end if - end do - end do - end do + ! end do + ! end do + !end do !$acc end parallel loop end if #endif @@ -1090,7 +1089,7 @@ contains end do if (hyperelasticity) then - !call s_calculate_btensor(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) + call s_calculate_btensor(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) do l = 0, p do k = 0, n do j = 0, m @@ -1150,7 +1149,7 @@ contains ! going through hyperelasticity again due to the btensor calculation ! s_calculate_btensor has its own triple nested for loop, with openacc - if ( hyperelasticity ) then + if (hyperelasticity) then !call s_calculate_btensor(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) end if @@ -1263,16 +1262,16 @@ contains end if ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 - if ( hyperelasticity ) then + !if (hyperelasticity) then ! adding the elastic contribution - do i = xibeg, xiend + !do i = xibeg, xiend !q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) - end do - if (G > 1000) then + !end do + !if (G > 1000) then !q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & ! G*f_elastic_energy(q_btensor, j, k, l) - end if - end if + !end if + !end if if (sigma /= dflt_real) then q_cons_vf(c_idx)%sf(j, k, l) = q_prim_vf(c_idx)%sf(j, k, l) From cce7fc7ff67f34aec0396f236cd1f003401ab2e7 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 29 Jun 2024 16:28:42 -0500 Subject: [PATCH 188/380] code works and is tested on Delta GPUs --- src/common/m_variables_conversion.fpp | 4 ++-- toolchain/bootstrap/docker.sh | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 2d698e3df0..237a2ac594 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1058,7 +1058,7 @@ contains if (hyperelasticity) then !call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf, 0, m, 0, n, 0, p) !print *, 'I got here AAA' - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) + !!$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) !do l = izb, ize ! do k = iyb, iye ! do j = ixb, ixe @@ -1079,7 +1079,7 @@ contains ! end do ! end do !end do - !$acc end parallel loop + !!$acc end parallel loop end if #endif diff --git a/toolchain/bootstrap/docker.sh b/toolchain/bootstrap/docker.sh index 73e61372df..ddb2207237 100644 --- a/toolchain/bootstrap/docker.sh +++ b/toolchain/bootstrap/docker.sh @@ -15,7 +15,7 @@ fi __docker_run() { docker run $dockerintopts --rm --workdir /home/me/MFC \ --mount type=bind,source="$(pwd)",target=/home/me/MFC \ - sbryngelson/mfc:latest $@ + #sbryngelson/mfc:latest $@ } __docker_run sudo chown -R me:me /home/me/MFC @@ -30,4 +30,4 @@ if (($?)); then error "Error running Docker container with $@." exit 1 -fi \ No newline at end of file +fi From 9afec0f4e3da4f8b95cfb0115732caf24aa43cb9 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 29 Jun 2024 16:38:19 -0500 Subject: [PATCH 189/380] reverting some changes to the workflow --- toolchain/bootstrap/docker.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/toolchain/bootstrap/docker.sh b/toolchain/bootstrap/docker.sh index ddb2207237..60e34d9284 100644 --- a/toolchain/bootstrap/docker.sh +++ b/toolchain/bootstrap/docker.sh @@ -15,7 +15,7 @@ fi __docker_run() { docker run $dockerintopts --rm --workdir /home/me/MFC \ --mount type=bind,source="$(pwd)",target=/home/me/MFC \ - #sbryngelson/mfc:latest $@ + sbryngelson/mfc:latest $@ } __docker_run sudo chown -R me:me /home/me/MFC From 09d21720c4d71629995c0b1ff77efeb80a6a58de Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 29 Jun 2024 18:06:55 -0500 Subject: [PATCH 190/380] lowered relative error in the phase change routines, added examples for 2D and 3D --- examples/2D_phasechange_bubble/case.py | 286 ++++++++++++++++++++ examples/3D_phasechange_bubble/casefile.py | 300 +++++++++++++++++++++ src/common/m_phase_change.fpp | 6 +- 3 files changed, 589 insertions(+), 3 deletions(-) create mode 100644 examples/2D_phasechange_bubble/case.py create mode 100644 examples/3D_phasechange_bubble/casefile.py diff --git a/examples/2D_phasechange_bubble/case.py b/examples/2D_phasechange_bubble/case.py new file mode 100644 index 0000000000..5fbe5f83ac --- /dev/null +++ b/examples/2D_phasechange_bubble/case.py @@ -0,0 +1,286 @@ +#!/usr/bin/env python3 +import math, json + +## 1 FOR BACKGROUND, 2 FOR BUBBLE +# Pressure [Pa] +p01 = 5E6 +p02 = 3550 + +# Temperature [K] +T01 = 298.15 +T02 = 298.15 +#T02 = 7.914 + +#### FLUID PROPERTIES #### + +### liquid water ### +# pi infty +piwl = 1.0E+09 +# qv +qvwl = -1167000 +# qv' +qvpwl = 0.0E0 +# cv +cvwl = 1816 +# cp +cpwl = 4267 +# gamma +gamwl = cpwl / cvwl + +## FOR PATCHES 1 & 2 ## + +# density +rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) +rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) + +# speed of sound FOR +c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) +c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) + +# part for Gases - relations from IMR +Ru = 8.3144598 # Universal gas constant (J/mol-K) + +### Vapor water ### +Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) +# gamma +gamwv = 1.4 +# cp +cpwv = Rv * gamwv/(gamwv-1) +# cv +cvwv = cpwv/gamwv +# pi infinity +piwv = 0.0E0 +# qv +qvwv = 2030000 +# qv' +qvpwv = -23400 + +## FOR PATCHES 1 & 2 ## + +# density +rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) +rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) + +# speed of sound +c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) +c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) + +### Air ### + +Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) +# gamma +gama = 1.4 +# cp +cpa = Ra * gama/(gama-1) +# cv +cva = cpa/gama +# pi infinity +pia = 0.0E0 +# qv +qva = 0.0E0 +# qv' +qvpa = 0.0E0 + +## FOR PATCHES 1 & 2 ## + +# density +rho0a1 = (p01 + pia)/((gama-1)*cva*T01) +rho0a2 = (p02 + pia)/((gama-1)*cva*T02) + +# Speed of sound +c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) +c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) + +## SHOCK RELATIONS +p02Op01 = p02 / p01 + +# Mach number of the shocked region - this should agree with Min, if everything is correct +Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) + +# shock speed +ss = Ms * c_a1 + +### volume fractions for each of the patches ### +C0 = 0.25 # vapor concentration for IMR + +# water liquid +awl1 = 1.00E00-2.00E-12 +awl2 = 1.00E-12 +# water vapor +awv1 = 1.00E-12 +awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) +# air +aa1 = 1.0 - awl1 - awv1 +aa2 = 1.0 - awl2 - awv2 + +## SIMULATION PARAMETERS + +# CFL +cfl = 0.50 + +# Bubble Initial Radius +R0 = 30E-06 + +# number of elements +Nx0 = 400 +Nx = 1600 +Ny = 1600 +Nz = 1600 + +# domain boundaries +xb = 0.00 +xe = 120E-6 + +yb = 0.00 +ye = 120E-6 + +zb = 0.00 +ze = 120E-6 + +# typical cell size +dx = ( xe - xb ) / Nx +dy = ( ye - yb ) / Ny +dz = ( ze - zb ) / Nz + +# time step + +# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) +SF = 200 + +# Critical time-step +tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) + +# making Nt divisible by SF +# tendA = 1.5 * tc +tend = 1.2 * tc + +# 1 - ensure NtA is sufficient to go a little beyond tendA +# NtA = int( tendA // dt + 1 ) + +# Array of saves. it is the same as Nt/Sf = t_step_save +# AS = int( NtA // SF + 1 ) + +# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) +# Nt = AS * SF +Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) + +dt = tend / Nt + +AS = int( Nt//SF ) + +# Total physical time +# tend = Nt * dt + +# Configuring case dictionary ================================================== +print(json.dumps({ + # Logistics ================================================ + 'run_time_info': 'T', + # ========================================================== + # Computational Domain Parameters ========================== + 'x_domain%beg' : xb, + 'x_domain%end' : xe, + 'y_domain%beg' : yb, + 'y_domain%end' : ye, + 'stretch_x' : 'T', + 'loops_x' : 3, + 'a_x' : 4.0E0, + 'x_a' : -2.0*R0, + 'x_b' : 2.0*R0, + 'stretch_y' : 'T', + 'loops_y' : 3, + 'a_y' : 4.0E0, + 'y_a' : -2.0*R0, + 'y_b' : 2.0*R0, + 'cyl_coord' : 'T', + 'm' : Nx, + 'n' : Ny, + 'p' : 0, + 'dt' : dt, + 't_step_start' : 0, + 't_step_stop' : Nt, + 't_step_save' : AS, + # ========================================================== + # Simulation Algorithm Parameters ========================== + 'num_patches' : 2, + 'model_eqns' : 3, + 'num_fluids' : 3, + 'adv_alphan' : 'T', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'relax' : 'T', + 'relax_model' : 6, + 'palpha_eps' : 1.0E-8, + 'ptgalpha_eps' : 1.0E-2, + 'time_stepper' : 3, + 'weno_order' : 3, + 'weno_eps' : 1.0E-16, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'F', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -2, + 'bc_x%end' : -6, + 'bc_y%beg' : -2, + 'bc_y%end' : -6, + # ========================================================== + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt':'T', + 'parallel_io' :'T', + # ========================================================== + # Patch 1: High pressured water ============================ + # Specify the cubic water background grid geometry + 'patch_icpp(1)%geometry' : 3, + 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, + 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, + 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, + 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, + 'patch_icpp(1)%vel(1)' : 0.0E+00, + 'patch_icpp(1)%vel(2)' : 0.0E+00, + 'patch_icpp(1)%pres' : p01, + 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, + 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, + 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, + 'patch_icpp(1)%alpha(1)' : awl1, + 'patch_icpp(1)%alpha(2)' : awv1, + 'patch_icpp(1)%alpha(3)' : aa1, + # ========================================================== + # Patch 2: (Vapor) Bubble ================================== + 'patch_icpp(2)%geometry' : 2, + 'patch_icpp(2)%x_centroid' : xb, + 'patch_icpp(2)%y_centroid' : yb, + 'patch_icpp(2)%radius' : R0, + 'patch_icpp(2)%vel(1)' : 0.0E+00, + 'patch_icpp(2)%vel(2)' : 0.0E+00, + 'patch_icpp(2)%pres' : p02, + 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, + 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, + 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, + 'patch_icpp(2)%alpha(1)' : awl2, + 'patch_icpp(2)%alpha(2)' : awv2, + 'patch_icpp(2)%alpha(3)' : aa2, + 'patch_icpp(2)%alter_patch(1)' : 'T', + # ========================================================== + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), + 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), + 'fluid_pp(1)%cv' : cvwl, + 'fluid_pp(1)%qv' : qvwl, + 'fluid_pp(1)%qvp' : qvpwl, + 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), + 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), + 'fluid_pp(2)%cv' : cvwv, + 'fluid_pp(2)%qv' : qvwv, + 'fluid_pp(2)%qvp' : qvpwv, + 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), + 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), + 'fluid_pp(3)%cv' : cva, + 'fluid_pp(3)%qv' : qva, + 'fluid_pp(3)%qvp' : qvpa, + # ========================================================== +})) diff --git a/examples/3D_phasechange_bubble/casefile.py b/examples/3D_phasechange_bubble/casefile.py new file mode 100644 index 0000000000..047c8655af --- /dev/null +++ b/examples/3D_phasechange_bubble/casefile.py @@ -0,0 +1,300 @@ +#!/usr/bin/env python3 +import math, json + +## 1 FOR BACKGROUND, 2 FOR BUBBLE +# Pressure [Pa] +p01 = 5E6 +p02 = 3550 + +# Temperature [K] +T01 = 298.15 +T02 = 298.15 +#T02 = 7.914 + +#### FLUID PROPERTIES #### + +### liquid water ### +# pi infty +piwl = 1.0E+09 +# qv +qvwl = -1167000 +# qv' +qvpwl = 0.0E0 +# cv +cvwl = 1816 +# cp +cpwl = 4267 +# gamma +gamwl = cpwl / cvwl + +## FOR PATCHES 1 & 2 ## + +# density +rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) +rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) + +# speed of sound FOR +c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) +c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) + +# part for Gases - relations from IMR +Ru = 8.3144598 # Universal gas constant (J/mol-K) + +### Vapor water ### +Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) +# gamma +gamwv = 1.4 +# cp +cpwv = Rv * gamwv/(gamwv-1) +# cv +cvwv = cpwv/gamwv +# pi infinity +piwv = 0.0E0 +# qv +qvwv = 2030000 +# qv' +qvpwv = -23400 + +## FOR PATCHES 1 & 2 ## + +# density +rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) +rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) + +# speed of sound +c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) +c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) + +### Air ### + +Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) +# gamma +gama = 1.4 +# cp +cpa = Ra * gama/(gama-1) +# cv +cva = cpa/gama +# pi infinity +pia = 0.0E0 +# qv +qva = 0.0E0 +# qv' +qvpa = 0.0E0 + +## FOR PATCHES 1 & 2 ## + +# density +rho0a1 = (p01 + pia)/((gama-1)*cva*T01) +rho0a2 = (p02 + pia)/((gama-1)*cva*T02) + +# Speed of sound +c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) +c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) + +## SHOCK RELATIONS +p02Op01 = p02 / p01 + +# Mach number of the shocked region - this should agree with Min, if everything is correct +Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) + +# shock speed +ss = Ms * c_a1 + +### volume fractions for each of the patches ### +C0 = 0.25 # vapor concentration for IMR + +# water liquid +awl1 = 1.00E00-2.00E-12 +awl2 = 1.00E-12 +# water vapor +awv1 = 1.00E-12 +awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) +# air +aa1 = 1.0 - awl1 - awv1 +aa2 = 1.0 - awl2 - awv2 + +## SIMULATION PARAMETERS + +# CFL +cfl = 0.50 + +# Bubble Initial Radius +R0 = 30E-06 + +# number of elements +Nx0 = 400 +Nx = 199 +Ny = 199 +Nz = 199 + +# domain boundaries +xb = 0.00 +xe = 120E-6 + +yb = 0.00 +ye = 120E-6 + +zb = 0.00 +ze = 120E-6 + +# typical cell size +dx = ( xe - xb ) / Nx +dy = ( ye - yb ) / Ny +dz = ( ze - zb ) / Nz + +# time step + +# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) +SF = 200 + +# Critical time-step +tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) + +# making Nt divisible by SF +# tendA = 1.5 * tc +tend = 1.2 * tc + +# 1 - ensure NtA is sufficient to go a little beyond tendA +# NtA = int( tendA // dt + 1 ) + +# Array of saves. it is the same as Nt/Sf = t_step_save +# AS = int( NtA // SF + 1 ) + +# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) +# Nt = AS * SF +Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) + +dt = tend / Nt + +AS = int( Nt//SF ) + +# Total physical time +# tend = Nt * dt + +# Configuring case dictionary ================================================== +print(json.dumps({ + # Logistics ================================================ + 'run_time_info': 'T', + # ========================================================== + # Computational Domain Parameters ========================== + 'x_domain%beg' : xb, + 'x_domain%end' : xe, + 'y_domain%beg' : yb, + 'y_domain%end' : ye, + 'z_domain%beg' : zb, + 'z_domain%end' : ze, + 'stretch_x' : 'T', + 'loops_x' : 3, + 'a_x' : 4.0E0, + 'x_a' : -2.0*R0, + 'x_b' : 2.0*R0, + 'stretch_y' : 'T', + 'loops_y' : 3, + 'a_y' : 4.0E0, + 'y_a' : -2.0*R0, + 'y_b' : 2.0*R0, + 'stretch_z' : 'T', + 'loops_z' : 3, + 'a_z' : 4.0E0, + 'z_a' : -2.0*R0, + 'z_b' : 2.0*R0, + 'cyl_coord' : 'F', + 'm' : Nx, + 'n' : Ny, + 'p' : Nz, + 'dt' : dt, + 't_step_start' : 0, + 't_step_stop' : Nt, + 't_step_save' : AS, + # ========================================================== + # Simulation Algorithm Parameters ========================== + 'num_patches' : 2, + 'model_eqns' : 3, + 'num_fluids' : 3, + 'adv_alphan' : 'T', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'relax' : 'T', + 'relax_model' : 6, + 'palpha_eps' : 1.0E-6, + 'ptgalpha_eps' : 1.0E-2, + 'time_stepper' : 3, + 'weno_order' : 3, + 'weno_eps' : 1.0E-32, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'F', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -2, + 'bc_x%end' : -6, + 'bc_y%beg' : -2, + 'bc_y%end' : -6, + 'bc_z%beg' : -2, + 'bc_z%end' : -6, + # ========================================================== + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt':'T', + 'parallel_io' :'T', + # ========================================================== + # Patch 1: High pressured water ============================ + # Specify the cubic water background grid geometry + 'patch_icpp(1)%geometry' : 9, + 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, + 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, + 'patch_icpp(1)%z_centroid' : ( ze + zb ) * 500000 / 100, + 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, + 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, + 'patch_icpp(1)%length_z' : ( ze - zb ) * 1000000 / 100, + 'patch_icpp(1)%vel(1)' : 0.0E+00, + 'patch_icpp(1)%vel(2)' : 0.0E+00, + 'patch_icpp(1)%vel(3)' : 0.0E+00, + 'patch_icpp(1)%pres' : p01, + 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, + 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, + 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, + 'patch_icpp(1)%alpha(1)' : awl1, + 'patch_icpp(1)%alpha(2)' : awv1, + 'patch_icpp(1)%alpha(3)' : aa1, + # ========================================================== + # Patch 2: (Vapor) Bubble ================================== + 'patch_icpp(2)%geometry' : 8, + 'patch_icpp(2)%x_centroid' : xb, + 'patch_icpp(2)%y_centroid' : yb, + 'patch_icpp(2)%z_centroid' : zb, + 'patch_icpp(2)%radius' : R0, + 'patch_icpp(2)%vel(1)' : 0.0E+00, + 'patch_icpp(2)%vel(2)' : 0.0E+00, + 'patch_icpp(2)%vel(3)' : 0.0E+00, + 'patch_icpp(2)%pres' : p02, + 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, + 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, + 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, + 'patch_icpp(2)%alpha(1)' : awl2, + 'patch_icpp(2)%alpha(2)' : awv2, + 'patch_icpp(2)%alpha(3)' : aa2, + 'patch_icpp(2)%alter_patch(1)' : 'T', + # ========================================================== + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), + 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), + 'fluid_pp(1)%cv' : cvwl, + 'fluid_pp(1)%qv' : qvwl, + 'fluid_pp(1)%qvp' : qvpwl, + 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), + 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), + 'fluid_pp(2)%cv' : cvwv, + 'fluid_pp(2)%qv' : qvwv, + 'fluid_pp(2)%qvp' : qvpwv, + 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), + 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), + 'fluid_pp(3)%cv' : cva, + 'fluid_pp(3)%qv' : qva, + 'fluid_pp(3)%qvp' : qvpa, + # ========================================================== +})) diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index f637232288..51fd2c0d37 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -356,8 +356,8 @@ contains ! Newton Solver for the pT-equilibrium ns = 0 - ! change this relative error metric. 1E4 is just arbitrary - do while ((DABS(pS - pO) > palpha_eps) .and. (DABS((pS - pO)/pO) > palpha_eps/1e4) .or. (ns == 0)) + ! change this relative error metric. 1E4 is arbitrary + do while ((DABS(pS - pO) > palpha_eps) .and. (DABS((pS - pO)/pO) > palpha_eps/1d2) .or. (ns == 0)) ! increasing counter ns = ns + 1 @@ -447,7 +447,7 @@ contains R2D(1) = 0.0d0; R2D(2) = 0.0d0 DeltamP(1) = 0.0d0; DeltamP(2) = 0.0d0 do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & - .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) & + .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d2))) & .or. (ns == 0)) ! Updating counter for the iterative procedure From 6ccb9f4960c35d35e6ca630ccf347c72acb9b9da Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 29 Jun 2024 18:09:53 -0500 Subject: [PATCH 191/380] added changes for phase change --- examples/3D_phasechange_bubble/casefile.py | 300 +++++++++++++++++++++ src/common/m_phase_change.fpp | 6 +- submit_hyper.sh | 7 +- 3 files changed, 308 insertions(+), 5 deletions(-) create mode 100644 examples/3D_phasechange_bubble/casefile.py diff --git a/examples/3D_phasechange_bubble/casefile.py b/examples/3D_phasechange_bubble/casefile.py new file mode 100644 index 0000000000..047c8655af --- /dev/null +++ b/examples/3D_phasechange_bubble/casefile.py @@ -0,0 +1,300 @@ +#!/usr/bin/env python3 +import math, json + +## 1 FOR BACKGROUND, 2 FOR BUBBLE +# Pressure [Pa] +p01 = 5E6 +p02 = 3550 + +# Temperature [K] +T01 = 298.15 +T02 = 298.15 +#T02 = 7.914 + +#### FLUID PROPERTIES #### + +### liquid water ### +# pi infty +piwl = 1.0E+09 +# qv +qvwl = -1167000 +# qv' +qvpwl = 0.0E0 +# cv +cvwl = 1816 +# cp +cpwl = 4267 +# gamma +gamwl = cpwl / cvwl + +## FOR PATCHES 1 & 2 ## + +# density +rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) +rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) + +# speed of sound FOR +c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) +c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) + +# part for Gases - relations from IMR +Ru = 8.3144598 # Universal gas constant (J/mol-K) + +### Vapor water ### +Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) +# gamma +gamwv = 1.4 +# cp +cpwv = Rv * gamwv/(gamwv-1) +# cv +cvwv = cpwv/gamwv +# pi infinity +piwv = 0.0E0 +# qv +qvwv = 2030000 +# qv' +qvpwv = -23400 + +## FOR PATCHES 1 & 2 ## + +# density +rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) +rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) + +# speed of sound +c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) +c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) + +### Air ### + +Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) +# gamma +gama = 1.4 +# cp +cpa = Ra * gama/(gama-1) +# cv +cva = cpa/gama +# pi infinity +pia = 0.0E0 +# qv +qva = 0.0E0 +# qv' +qvpa = 0.0E0 + +## FOR PATCHES 1 & 2 ## + +# density +rho0a1 = (p01 + pia)/((gama-1)*cva*T01) +rho0a2 = (p02 + pia)/((gama-1)*cva*T02) + +# Speed of sound +c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) +c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) + +## SHOCK RELATIONS +p02Op01 = p02 / p01 + +# Mach number of the shocked region - this should agree with Min, if everything is correct +Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) + +# shock speed +ss = Ms * c_a1 + +### volume fractions for each of the patches ### +C0 = 0.25 # vapor concentration for IMR + +# water liquid +awl1 = 1.00E00-2.00E-12 +awl2 = 1.00E-12 +# water vapor +awv1 = 1.00E-12 +awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) +# air +aa1 = 1.0 - awl1 - awv1 +aa2 = 1.0 - awl2 - awv2 + +## SIMULATION PARAMETERS + +# CFL +cfl = 0.50 + +# Bubble Initial Radius +R0 = 30E-06 + +# number of elements +Nx0 = 400 +Nx = 199 +Ny = 199 +Nz = 199 + +# domain boundaries +xb = 0.00 +xe = 120E-6 + +yb = 0.00 +ye = 120E-6 + +zb = 0.00 +ze = 120E-6 + +# typical cell size +dx = ( xe - xb ) / Nx +dy = ( ye - yb ) / Ny +dz = ( ze - zb ) / Nz + +# time step + +# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) +SF = 200 + +# Critical time-step +tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) + +# making Nt divisible by SF +# tendA = 1.5 * tc +tend = 1.2 * tc + +# 1 - ensure NtA is sufficient to go a little beyond tendA +# NtA = int( tendA // dt + 1 ) + +# Array of saves. it is the same as Nt/Sf = t_step_save +# AS = int( NtA // SF + 1 ) + +# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) +# Nt = AS * SF +Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) + +dt = tend / Nt + +AS = int( Nt//SF ) + +# Total physical time +# tend = Nt * dt + +# Configuring case dictionary ================================================== +print(json.dumps({ + # Logistics ================================================ + 'run_time_info': 'T', + # ========================================================== + # Computational Domain Parameters ========================== + 'x_domain%beg' : xb, + 'x_domain%end' : xe, + 'y_domain%beg' : yb, + 'y_domain%end' : ye, + 'z_domain%beg' : zb, + 'z_domain%end' : ze, + 'stretch_x' : 'T', + 'loops_x' : 3, + 'a_x' : 4.0E0, + 'x_a' : -2.0*R0, + 'x_b' : 2.0*R0, + 'stretch_y' : 'T', + 'loops_y' : 3, + 'a_y' : 4.0E0, + 'y_a' : -2.0*R0, + 'y_b' : 2.0*R0, + 'stretch_z' : 'T', + 'loops_z' : 3, + 'a_z' : 4.0E0, + 'z_a' : -2.0*R0, + 'z_b' : 2.0*R0, + 'cyl_coord' : 'F', + 'm' : Nx, + 'n' : Ny, + 'p' : Nz, + 'dt' : dt, + 't_step_start' : 0, + 't_step_stop' : Nt, + 't_step_save' : AS, + # ========================================================== + # Simulation Algorithm Parameters ========================== + 'num_patches' : 2, + 'model_eqns' : 3, + 'num_fluids' : 3, + 'adv_alphan' : 'T', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'relax' : 'T', + 'relax_model' : 6, + 'palpha_eps' : 1.0E-6, + 'ptgalpha_eps' : 1.0E-2, + 'time_stepper' : 3, + 'weno_order' : 3, + 'weno_eps' : 1.0E-32, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'F', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -2, + 'bc_x%end' : -6, + 'bc_y%beg' : -2, + 'bc_y%end' : -6, + 'bc_z%beg' : -2, + 'bc_z%end' : -6, + # ========================================================== + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt':'T', + 'parallel_io' :'T', + # ========================================================== + # Patch 1: High pressured water ============================ + # Specify the cubic water background grid geometry + 'patch_icpp(1)%geometry' : 9, + 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, + 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, + 'patch_icpp(1)%z_centroid' : ( ze + zb ) * 500000 / 100, + 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, + 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, + 'patch_icpp(1)%length_z' : ( ze - zb ) * 1000000 / 100, + 'patch_icpp(1)%vel(1)' : 0.0E+00, + 'patch_icpp(1)%vel(2)' : 0.0E+00, + 'patch_icpp(1)%vel(3)' : 0.0E+00, + 'patch_icpp(1)%pres' : p01, + 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, + 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, + 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, + 'patch_icpp(1)%alpha(1)' : awl1, + 'patch_icpp(1)%alpha(2)' : awv1, + 'patch_icpp(1)%alpha(3)' : aa1, + # ========================================================== + # Patch 2: (Vapor) Bubble ================================== + 'patch_icpp(2)%geometry' : 8, + 'patch_icpp(2)%x_centroid' : xb, + 'patch_icpp(2)%y_centroid' : yb, + 'patch_icpp(2)%z_centroid' : zb, + 'patch_icpp(2)%radius' : R0, + 'patch_icpp(2)%vel(1)' : 0.0E+00, + 'patch_icpp(2)%vel(2)' : 0.0E+00, + 'patch_icpp(2)%vel(3)' : 0.0E+00, + 'patch_icpp(2)%pres' : p02, + 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, + 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, + 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, + 'patch_icpp(2)%alpha(1)' : awl2, + 'patch_icpp(2)%alpha(2)' : awv2, + 'patch_icpp(2)%alpha(3)' : aa2, + 'patch_icpp(2)%alter_patch(1)' : 'T', + # ========================================================== + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), + 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), + 'fluid_pp(1)%cv' : cvwl, + 'fluid_pp(1)%qv' : qvwl, + 'fluid_pp(1)%qvp' : qvpwl, + 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), + 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), + 'fluid_pp(2)%cv' : cvwv, + 'fluid_pp(2)%qv' : qvwv, + 'fluid_pp(2)%qvp' : qvpwv, + 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), + 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), + 'fluid_pp(3)%cv' : cva, + 'fluid_pp(3)%qv' : qva, + 'fluid_pp(3)%qvp' : qvpa, + # ========================================================== +})) diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index f637232288..51fd2c0d37 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -356,8 +356,8 @@ contains ! Newton Solver for the pT-equilibrium ns = 0 - ! change this relative error metric. 1E4 is just arbitrary - do while ((DABS(pS - pO) > palpha_eps) .and. (DABS((pS - pO)/pO) > palpha_eps/1e4) .or. (ns == 0)) + ! change this relative error metric. 1E4 is arbitrary + do while ((DABS(pS - pO) > palpha_eps) .and. (DABS((pS - pO)/pO) > palpha_eps/1d2) .or. (ns == 0)) ! increasing counter ns = ns + 1 @@ -447,7 +447,7 @@ contains R2D(1) = 0.0d0; R2D(2) = 0.0d0 DeltamP(1) = 0.0d0; DeltamP(2) = 0.0d0 do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & - .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) & + .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d2))) & .or. (ns == 0)) ! Updating counter for the iterative procedure diff --git a/submit_hyper.sh b/submit_hyper.sh index 1bc47245cd..e45b98dbc4 100755 --- a/submit_hyper.sh +++ b/submit_hyper.sh @@ -1,6 +1,9 @@ #!/bin/bash -./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar +#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta +./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t simulation -c delta + From 79e22a8575a11fe24a46aeab3928f763496a8fa3 Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Sat, 29 Jun 2024 18:14:51 -0500 Subject: [PATCH 192/380] commented hypo + model-eqs checker in preprocess to test hypo with 6-eq model --- src/pre_process/m_checker.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/pre_process/m_checker.f90 b/src/pre_process/m_checker.f90 index bcbb862dc3..7fcb90ae48 100644 --- a/src/pre_process/m_checker.f90 +++ b/src/pre_process/m_checker.f90 @@ -98,10 +98,10 @@ subroutine s_check_inputs call s_mpi_abort('R0 type must be set if using Polydisperse. Exiting ...') end if - if (hypoelasticity .and. (model_eqns /= 2)) then - call s_mpi_abort('hypoelasticity requires model_eqns = 2'// & - 'exiting ...') - end if + !if (hypoelasticity .and. (model_eqns /= 2)) then + ! call s_mpi_abort('hypoelasticity requires model_eqns = 2'// & + ! 'exiting ...') + !end if ! phase change checkers. if (relax) then if (model_eqns /= 3) then From 283a209fd8e07cc8f79599580a463fe95d55cb91 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 30 Jun 2024 12:36:47 -0400 Subject: [PATCH 193/380] still debugging hyperelasticity branch --- examples/2D_phasechange_bubble/casefile.py | 300 +++++++++++++++++++++ src/common/m_variables_conversion.fpp | 41 +-- src/pre_process/m_assign_variables.f90 | 10 +- src/pre_process/m_global_parameters.fpp | 16 +- src/simulation/m_data_output.fpp | 17 +- src/simulation/m_global_parameters.fpp | 6 +- src/simulation/m_ibm.fpp | 2 +- src/simulation/m_rhs.fpp | 19 +- src/simulation/m_riemann_solvers.fpp | 9 +- src/simulation/m_start_up.fpp | 6 +- src/simulation/m_surface_tension.fpp | 2 +- src/simulation/m_time_steppers.fpp | 28 +- submit_hyper.sh | 6 +- submit_pc.sh | 9 + 14 files changed, 382 insertions(+), 89 deletions(-) create mode 100644 examples/2D_phasechange_bubble/casefile.py create mode 100755 submit_pc.sh diff --git a/examples/2D_phasechange_bubble/casefile.py b/examples/2D_phasechange_bubble/casefile.py new file mode 100644 index 0000000000..722d004914 --- /dev/null +++ b/examples/2D_phasechange_bubble/casefile.py @@ -0,0 +1,300 @@ +#!/usr/bin/env python3 +import math, json + +## 1 FOR BACKGROUND, 2 FOR BUBBLE +# Pressure [Pa] +p01 = 5E6 +p02 = 3550 + +# Temperature [K] +T01 = 298.15 +T02 = 298.15 +#T02 = 7.914 + +#### FLUID PROPERTIES #### + +### liquid water ### +# pi infty +piwl = 1.0E+09 +# qv +qvwl = -1167000 +# qv' +qvpwl = 0.0E0 +# cv +cvwl = 1816 +# cp +cpwl = 4267 +# gamma +gamwl = cpwl / cvwl + +## FOR PATCHES 1 & 2 ## + +# density +rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) +rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) + +# speed of sound FOR +c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) +c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) + +# part for Gases - relations from IMR +Ru = 8.3144598 # Universal gas constant (J/mol-K) + +### Vapor water ### +Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) +# gamma +gamwv = 1.4 +# cp +cpwv = Rv * gamwv/(gamwv-1) +# cv +cvwv = cpwv/gamwv +# pi infinity +piwv = 0.0E0 +# qv +qvwv = 2030000 +# qv' +qvpwv = -23400 + +## FOR PATCHES 1 & 2 ## + +# density +rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) +rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) + +# speed of sound +c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) +c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) + +### Air ### + +Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) +# gamma +gama = 1.4 +# cp +cpa = Ra * gama/(gama-1) +# cv +cva = cpa/gama +# pi infinity +pia = 0.0E0 +# qv +qva = 0.0E0 +# qv' +qvpa = 0.0E0 + +## FOR PATCHES 1 & 2 ## + +# density +rho0a1 = (p01 + pia)/((gama-1)*cva*T01) +rho0a2 = (p02 + pia)/((gama-1)*cva*T02) + +# Speed of sound +c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) +c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) + +## SHOCK RELATIONS +p02Op01 = p02 / p01 + +# Mach number of the shocked region - this should agree with Min, if everything is correct +Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) + +# shock speed +ss = Ms * c_a1 + +### volume fractions for each of the patches ### +C0 = 0.25 # vapor concentration for IMR + +# water liquid +awl1 = 1.00E00-2.00E-12 +awl2 = 1.00E-12 +# water vapor +awv1 = 1.00E-12 +awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) +# air +aa1 = 1.0 - awl1 - awv1 +aa2 = 1.0 - awl2 - awv2 + +## SIMULATION PARAMETERS + +# CFL +cfl = 0.50 + +# Bubble Initial Radius +R0 = 30E-06 + +# number of elements +Nx0 = 400 +Nx = 100 +Ny = 100 +Nz = 100 + +# domain boundaries +xb = 0.00 +xe = 120E-6 + +yb = 0.00 +ye = 120E-6 + +zb = 0.00 +ze = 120E-6 + +# typical cell size +dx = ( xe - xb ) / Nx +dy = ( ye - yb ) / Ny +dz = ( ze - zb ) / Nz + +# time step + +# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) +SF = 200 + +# Critical time-step +tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) + +# making Nt divisible by SF +# tendA = 1.5 * tc +tend = 1.2 * tc + +# 1 - ensure NtA is sufficient to go a little beyond tendA +# NtA = int( tendA // dt + 1 ) + +# Array of saves. it is the same as Nt/Sf = t_step_save +# AS = int( NtA // SF + 1 ) + +# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) +# Nt = AS * SF +Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) + +dt = tend / Nt + +AS = int( Nt//SF ) + +# Total physical time +# tend = Nt * dt + +# Configuring case dictionary ================================================== +print(json.dumps({ + # Logistics ================================================ + 'run_time_info': 'T', + # ========================================================== + # Computational Domain Parameters ========================== + 'x_domain%beg' : xb, + 'x_domain%end' : xe, + 'y_domain%beg' : yb, + 'y_domain%end' : ye, + 'z_domain%beg' : zb, + 'z_domain%end' : ze, + 'stretch_x' : 'T', + 'loops_x' : 3, + 'a_x' : 4.0E0, + 'x_a' : -2.0*R0, + 'x_b' : 2.0*R0, + 'stretch_y' : 'T', + 'loops_y' : 3, + 'a_y' : 4.0E0, + 'y_a' : -2.0*R0, + 'y_b' : 2.0*R0, + 'stretch_z' : 'T', + 'loops_z' : 3, + 'a_z' : 4.0E0, + 'z_a' : -2.0*R0, + 'z_b' : 2.0*R0, + 'cyl_coord' : 'F', + 'm' : Nx, + 'n' : Ny, + 'p' : Nz, + 'dt' : dt, + 't_step_start' : 0, + 't_step_stop' : Nt, + 't_step_save' : AS, + # ========================================================== + # Simulation Algorithm Parameters ========================== + 'num_patches' : 2, + 'model_eqns' : 3, + 'num_fluids' : 3, + 'adv_alphan' : 'T', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'relax' : 'T', + 'relax_model' : 6, + 'palpha_eps' : 1.0E-6, + 'ptgalpha_eps' : 1.0E-2, + 'time_stepper' : 3, + 'weno_order' : 3, + 'weno_eps' : 1.0E-32, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'F', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -2, + 'bc_x%end' : -6, + 'bc_y%beg' : -2, + 'bc_y%end' : -6, + 'bc_z%beg' : -2, + 'bc_z%end' : -6, + # ========================================================== + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt':'T', + 'parallel_io' :'T', + # ========================================================== + # Patch 1: High pressured water ============================ + # Specify the cubic water background grid geometry + 'patch_icpp(1)%geometry' : 9, + 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, + 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, + 'patch_icpp(1)%z_centroid' : ( ze + zb ) * 500000 / 100, + 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, + 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, + 'patch_icpp(1)%length_z' : ( ze - zb ) * 1000000 / 100, + 'patch_icpp(1)%vel(1)' : 0.0E+00, + 'patch_icpp(1)%vel(2)' : 0.0E+00, + 'patch_icpp(1)%vel(3)' : 0.0E+00, + 'patch_icpp(1)%pres' : p01, + 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, + 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, + 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, + 'patch_icpp(1)%alpha(1)' : awl1, + 'patch_icpp(1)%alpha(2)' : awv1, + 'patch_icpp(1)%alpha(3)' : aa1, + # ========================================================== + # Patch 2: (Vapor) Bubble ================================== + 'patch_icpp(2)%geometry' : 8, + 'patch_icpp(2)%x_centroid' : xb, + 'patch_icpp(2)%y_centroid' : yb, + 'patch_icpp(2)%z_centroid' : zb, + 'patch_icpp(2)%radius' : R0, + 'patch_icpp(2)%vel(1)' : 0.0E+00, + 'patch_icpp(2)%vel(2)' : 0.0E+00, + 'patch_icpp(2)%vel(3)' : 0.0E+00, + 'patch_icpp(2)%pres' : p02, + 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, + 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, + 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, + 'patch_icpp(2)%alpha(1)' : awl2, + 'patch_icpp(2)%alpha(2)' : awv2, + 'patch_icpp(2)%alpha(3)' : aa2, + 'patch_icpp(2)%alter_patch(1)' : 'T', + # ========================================================== + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), + 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), + 'fluid_pp(1)%cv' : cvwl, + 'fluid_pp(1)%qv' : qvwl, + 'fluid_pp(1)%qvp' : qvpwl, + 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), + 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), + 'fluid_pp(2)%cv' : cvwv, + 'fluid_pp(2)%qv' : qvwv, + 'fluid_pp(2)%qvp' : qvpwv, + 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), + 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), + 'fluid_pp(3)%cv' : cva, + 'fluid_pp(3)%qv' : qva, + 'fluid_pp(3)%qvp' : qvpa, + # ========================================================== +})) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 237a2ac594..f13fcc0e76 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -145,8 +145,8 @@ contains else pres = (pref + pi_inf)* & (energy/ & - (rhoref*(1 - alf)) & - )**(1/gamma + 1) - pi_inf + (rhoref*(1.d0 - alf)) & + )**(1.d0/gamma + 1.d0) - pi_inf end if if ( hypoelasticity .and. present(G)) then @@ -169,27 +169,12 @@ contains end if - !if (hyperelasticity .and. present(G)) then - ! ! calculate elastic contribution to Energy - ! E_e = 0d0 - ! do s = stress_idx%beg, stress_idx%end - ! if (G > 0) then - ! E_e = E_e + ((stress/rho)**2d0)/(4d0*G) - ! ! Additional terms in 2D and 3D - ! if ((s == stress_idx%beg + 1) .or. & - ! (s == stress_idx%beg + 3) .or. & - ! (s == stress_idx%beg + 4)) then - ! E_e = E_e + ((stress/rho)**2d0)/(4d0*G) - ! end if - ! end if - ! end do - ! - ! pres = ( & - ! energy - & - ! 0.5d0*(mom**2.d0)/rho - & - ! pi_inf - qv - E_e & - ! )/gamma - !end if + if (hyperelasticity .and. present(G)) then + ! calculate elastic contribution to Energy + E_e = 0d0 + pres = (energy - 0.5d0*(mom**2.d0)/rho - pi_inf - qv - E_e )/gamma + + end if end subroutine s_compute_pressure @@ -1143,15 +1128,15 @@ contains integer :: i, j, k, l, q !< Generic loop iterators #ifndef MFC_SIMULATION - do l = 1, b_size - @:ALLOCATE(q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) - end do + !do l = 1, b_size + ! @:ALLOCATE(q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) + !end do ! going through hyperelasticity again due to the btensor calculation ! s_calculate_btensor has its own triple nested for loop, with openacc - if (hyperelasticity) then + !if (hyperelasticity) then !call s_calculate_btensor(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) - end if + !end if ! Converting the primitive variables to the conservative variables do l = 0, p diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 index ff17a222f3..828d6d5c23 100644 --- a/src/pre_process/m_assign_variables.f90 +++ b/src/pre_process/m_assign_variables.f90 @@ -447,7 +447,7 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & end do ! Elastic Shear Stress - if (hypoelasticity) then + if (elasticity) then do i = 1, (stress_idx%end - stress_idx%beg) + 1 q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = & (eta*patch_icpp(patch_id)%tau_e(i) & @@ -473,10 +473,10 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & xi_cart(3) = z_cc(l) end if - do i = 1, num_dims - q_prim_vf(i+xibeg-1)%sf(j,k,l) = eta*xi_cart(i) + & - (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1) - end do + !do i = 1, num_dims + ! q_prim_vf(i+xibeg-1)%sf(j,k,l) = eta*xi_cart(i) + & + ! (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1) + !end do end if diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 0c71331be4..ff12c2f07c 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -600,9 +600,6 @@ contains if (hypoelasticity .or. hyperelasticity) then elasticity = .true. - end if - - if (elasticity) then stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D @@ -610,13 +607,16 @@ contains end if if (hyperelasticity) then - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims + elasticity = .false. + hypoelasticity = .false. + hyperelasticity = .false. + !xi_idx%beg = sys_size + 1 + !xi_idx%end = sys_size + num_dims ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 + !sys_size = xi_idx%end + 1 ! number of entries in the symmetric btensor plus the jacobian - b_size = (num_dims*(num_dims + 1))/2 + 1 - tensor_size = num_dims**2 + 1 + !b_size = (num_dims*(num_dims + 1))/2 + 1 + !tensor_size = num_dims**2 + 1 end if if (sigma /= dflt_real) then diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 12165f2f91..a0dba3a6f4 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -332,7 +332,6 @@ contains H = (E + pres)/rho - ! Compute mixture sound speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c) @@ -1217,7 +1216,7 @@ contains l = 0 ! Computing/Sharing necessary state variables - if (hypoelasticity) then + if (elasticity) then call s_convert_to_mixture_variables(q_cons_vf, j - 2, k, l, & rho, gamma, pi_inf, qv, & Re, G, fluid_pp(:)%G) @@ -1231,7 +1230,7 @@ contains dyn_p = 0.5d0*rho*dot_product(vel, vel) - if (hypoelasticity) then + if (elasticity) then call s_compute_pressure( & q_cons_vf(1)%sf(j - 2, k, l), & @@ -1248,7 +1247,7 @@ contains if (model_eqns == 4) then lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 - else if (hypoelasticity) then + else if (elasticity) then tau_e(1) = q_cons_vf(stress_idx%end)%sf(j - 2, k, l)/rho end if @@ -1332,7 +1331,7 @@ contains dyn_p = 0.5d0*rho*dot_product(vel, vel) - if (hypoelasticity) then + if (elasticity) then call s_compute_pressure( & q_cons_vf(1)%sf(j - 2, k - 2, l), & q_cons_vf(alf_idx)%sf(j - 2, k - 2, l), & @@ -1347,7 +1346,7 @@ contains if (model_eqns == 4) then lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 - else if (hypoelasticity) then + else if (elasticity) then do s = 1, 3 tau_e(s) = q_cons_vf(s)%sf(j - 2, k - 2, l)/rho end do @@ -1413,7 +1412,7 @@ contains dyn_p = 0.5d0*rho*dot_product(vel, vel) - if (hypoelasticity) then + if (elasticity) then call s_compute_pressure( & q_cons_vf(1)%sf(j - 2, k - 2, l - 2), & q_cons_vf(alf_idx)%sf(j - 2, k - 2, l - 2), & @@ -1460,7 +1459,7 @@ contains end if end if - if (hypoelasticity) then + if (elasticity) then do s = 1, (num_dims*(num_dims + 1))/2 tmp = tau_e(s) call s_mpi_allreduce_sum(tmp, tau_e(s)) @@ -1553,7 +1552,7 @@ contains nRdot(1), & R(1), & Rdot(1) - else if (hypoelasticity) then + else if (elasticity) then write (i + 30, '(6X,F12.12,F24.8,F24.8,F24.8,F24.8,'// & 'F24.8,F24.8,F24.8)') & nondim_time, & diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 2644da807a..b86a81819e 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -832,13 +832,11 @@ contains if (hypoelasticity .or. hyperelasticity) then elasticity = .true. - end if - - if (elasticity) then stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D sys_size = stress_idx%end + !print *, 'I was here yeah',proc_rank end if if (hyperelasticity) then @@ -849,7 +847,7 @@ contains xi_idx%beg = sys_size + 1 xi_idx%end = sys_size + num_dims ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 + !sys_size = xi_idx%end + 1 end if if (sigma /= dflt_real) then diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 8b5ed59145..3b9b4c232d 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -206,7 +206,7 @@ contains if (model_eqns /= 4) then ! If in simulation, use acc mixture subroutines - if (hypoelasticity) then + if (elasticity) then call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv_K, alpha_IP, & alpha_rho_IP, Re_K, j, k, l, G_K, Gs) else if (bubbles) then diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index d8ee007f3e..cbdc5057c6 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -254,7 +254,7 @@ contains @:ALLOCATE(q_cons_qp%vf(1:sys_size)) @:ALLOCATE(q_prim_qp%vf(1:sys_size)) - @:ALLOCATE(q_btensor%vf(1:b_size)) + !@:ALLOCATE(q_btensor%vf(1:b_size)) do l = 1, sys_size @:ALLOCATE(q_cons_qp%vf(l)%sf(ix%beg:ix%end, iy%beg:iy%end, iz%beg:iz%end)) @@ -278,9 +278,9 @@ contains end if - do l = 1, b_size - @:ALLOCATE(q_btensor%vf(l)%sf(ix%beg:ix%end, iy%beg:iy%end, iz%beg:iz%end)) - end do + !do l = 1, b_size + ! @:ALLOCATE(q_btensor%vf(l)%sf(ix%beg:ix%end, iy%beg:iy%end, iz%beg:iz%end)) + !end do @:ACC_SETUP_VFs(q_cons_qp, q_prim_qp, q_btensor) @@ -797,11 +797,11 @@ contains call nvtxEndRange !print *, "I got here B" - call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") + !call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") !if ( hyperelasticity ) then ! call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) !end if - call nvtxEndRange + !call nvtxEndRange call nvtxStartRange("RHS-MPI") call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) @@ -920,7 +920,7 @@ contains end if ix%end = m; iy%end = n; iz%end = p ! =============================================================== - !print *, "I got here d" + !print *, "I got here d" ! Computing Riemann Solver Flux and Source Flux ================= call nvtxStartRange("RHS_riemann_solver") @@ -940,7 +940,7 @@ contains flux_gsrc_n(id)%vf, & id, ix, iy, iz) call nvtxEndRange - !print *, "I got here e" + !print *, "I got here e" ! =============================================================== ! Additional physics and source terms =========================== @@ -959,6 +959,7 @@ contains q_prim_qp%vf, & rhs_vf) call nvtxEndRange + !print *, "I got here f" ! RHS additions for viscosity call nvtxStartRange("RHS_add_phys") @@ -1031,6 +1032,7 @@ contains rhs_vf) call nvtxEndRange ! END: Additional pphysics and source terms ============================ + !print *, "I got here g" if (run_time_info .or. probe_wrt .or. ib) then @@ -1058,6 +1060,7 @@ contains time_avg = 0d0 end if ! ================================================================== + !print *, "I got here h" end subroutine s_compute_rhs diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index e3eb994e56..f035227d6c 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -474,7 +474,8 @@ contains E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R ! elastic energy update - if (hypoelasticity) then + ! MAURO HERE IS THE ISSUE + if ( hypoelasticity ) then !$acc loop seq do i = 1, strxe - strxb + 1 tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) @@ -506,7 +507,7 @@ contains end if ! elastic energy update - !if ( hyperelasticity ) then + if ( hyperelasticity ) then ! G_L = 0d0 ! G_R = 0d0 ! @@ -530,9 +531,9 @@ contains ! xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) ! end do ! end if - !end if + end if - ! moving this down to account for the elasticity + ! moving this down H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index e7157a1cdd..115c1a548d 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -355,7 +355,7 @@ contains end if end do - if ((bubbles .eqv. .true.) .or. (hypoelasticity .eqv. .true.)) then + if ((bubbles .eqv. .true.) .or. (elasticity .eqv. .true.)) then ! Read pb and mv for non-polytropic qbmm if (qbmm .and. .not. polytropic) then do i = 1, nb @@ -1269,7 +1269,7 @@ contains call acc_present_dump() #endif - if (hypoelasticity) call s_initialize_hypoelastic_module() + if (elasticity) call s_initialize_hypoelastic_module() if (relax) call s_initialize_phasechange_module() call s_initialize_data_output_module() call s_initialize_derived_variables_module() @@ -1420,7 +1420,7 @@ contains s_write_data_files => null() call s_finalize_time_steppers_module() - if (hypoelasticity) call s_finalize_hypoelastic_module() + if (elasticity) call s_finalize_hypoelastic_module() call s_finalize_derived_variables_module() call s_finalize_data_output_module() call s_finalize_rhs_module() diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp index 2e9ca8fedf..b5faba05be 100644 --- a/src/simulation/m_surface_tension.fpp +++ b/src/simulation/m_surface_tension.fpp @@ -1,7 +1,7 @@ #:include 'macros.fpp' #:include 'inline_capillary.fpp' -!> @brief This module is used to compute source terms for hypoelastic model +!> @brief This module is used to compute source terms for surface tension model module m_surface_tension ! Dependencies ============================================================= diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 8fab76310f..508e53e32a 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -190,14 +190,14 @@ contains end do end if - if (hyperelasticity) then - do i = xibeg, xiend + 1 - @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & - iy_t%beg:iy_t%end, & - iz_t%beg:iz_t%end)) - @:ACC_SETUP_SFs(q_prim_vf(i)) - end do - end if + !if (hyperelasticity) then + !do i = xibeg, xiend + 1 + ! @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & + ! iy_t%beg:iy_t%end, & + ! iz_t%beg:iz_t%end)) + ! @:ACC_SETUP_SFs(q_prim_vf(i)) + !end do + !end if if (model_eqns == 3) then do i = internalEnergies_idx%beg, internalEnergies_idx%end @@ -862,7 +862,6 @@ contains time = time + (finish - start) end if ! ================================================================== - end subroutine s_3rd_order_tvd_rk !> Strang splitting scheme with 3rd order TVD RK time-stepping algorithm for @@ -990,6 +989,7 @@ contains end if end subroutine s_time_step_cycling + !> Module deallocation and/or disassociation procedures subroutine s_finalize_time_steppers_module @@ -1030,11 +1030,11 @@ contains end do end if - if (hyperelasticity) then - do i = xibeg, xiend + 1 - @:DEALLOCATE(q_prim_vf(i)%sf) - end do - end if + !if (hyperelasticity) then + ! do i = xibeg, xiend + 1 + ! @:DEALLOCATE(q_prim_vf(i)%sf) + ! end do + !end if if (bubbles) then do i = bub_idx%beg, bub_idx%end diff --git a/submit_hyper.sh b/submit_hyper.sh index e45b98dbc4..ba197a9987 100755 --- a/submit_hyper.sh +++ b/submit_hyper.sh @@ -1,9 +1,7 @@ #!/bin/bash -#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar +./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t simulation -c delta diff --git a/submit_pc.sh b/submit_pc.sh new file mode 100755 index 0000000000..e45b98dbc4 --- /dev/null +++ b/submit_pc.sh @@ -0,0 +1,9 @@ +#!/bin/bash + +#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar +#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta + +./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t simulation -c delta + From f2c55b3a0b9932e89ce3bcbc5945673772aeb641 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 1 Jul 2024 14:46:20 -0400 Subject: [PATCH 194/380] fixed Oscar module issue, rebuilding hyper back into MFC, compiles --- src/common/m_phase_change.fpp | 10 ++-- src/common/m_variables_conversion.fpp | 20 ++++---- src/pre_process/m_assign_variables.f90 | 11 +++-- src/pre_process/m_global_parameters.fpp | 15 +++--- src/simulation/m_global_parameters.fpp | 43 ++++++++++++----- src/simulation/m_riemann_solvers.fpp | 63 ++++++++++++++++--------- src/simulation/m_time_steppers.fpp | 26 +++++----- toolchain/modules | 2 +- 8 files changed, 115 insertions(+), 75 deletions(-) diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 51fd2c0d37..920d31b5e8 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -357,7 +357,9 @@ contains ! Newton Solver for the pT-equilibrium ns = 0 ! change this relative error metric. 1E4 is arbitrary - do while ((DABS(pS - pO) > palpha_eps) .and. (DABS((pS - pO)/pO) > palpha_eps/1d2) .or. (ns == 0)) + do while ((DABS(pS - pO) > palpha_eps) .and. & + (DABS((pS - pO)/pO) > palpha_eps/1d4) .or. & + (ns == 0)) ! increasing counter ns = ns + 1 @@ -446,9 +448,9 @@ contains ! improve this initial condition R2D(1) = 0.0d0; R2D(2) = 0.0d0 DeltamP(1) = 0.0d0; DeltamP(2) = 0.0d0 - do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & - .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d2))) & - .or. (ns == 0)) + do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) .and. & + ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) .or. & + (ns == 0)) ! Updating counter for the iterative procedure ns = ns + 1 diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index f13fcc0e76..c2abd1d72b 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -155,12 +155,12 @@ contains E_e = 0d0 do s = stress_idx%beg, stress_idx%end if (G > 1d-3) then - E_e = E_e + ((stress/rho)**2d0)/(4d0*G) + !E_e = E_e + ((stress/rho)**2d0)/(4d0*G) ! Additional terms in 2D and 3D if ((s == stress_idx%beg + 1) .or. & (s == stress_idx%beg + 3) .or. & (s == stress_idx%beg + 4)) then - E_e = E_e + ((stress/rho)**2d0)/(4d0*G) + ! E_e = E_e + ((stress/rho)**2d0)/(4d0*G) end if end if end do @@ -1003,14 +1003,14 @@ contains /rho_K ! subtracting elastic contribution for pressure calculation if (G_K > 1000) then !TODO: check if stable for >0 - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K + !qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + ! ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K ! extra terms in 2 and 3D if ((i == strxb + 1) .or. & (i == strxb + 3) .or. & (i == strxb + 4)) then - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K + ! qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + ! ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K end if end if end do @@ -1233,14 +1233,14 @@ contains q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) ! adding elastic contribution if (G > 1000) then - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) + ! q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & + ! (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) ! extra terms in 2 and 3D if ((i == stress_idx%beg + 1) .or. & (i == stress_idx%beg + 3) .or. & (i == stress_idx%beg + 4)) then - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) + ! q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & + ! (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) end if end if end do diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 index 828d6d5c23..0e0994fff3 100644 --- a/src/pre_process/m_assign_variables.f90 +++ b/src/pre_process/m_assign_variables.f90 @@ -472,11 +472,12 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & xi_cart(2) = y_cc(k) xi_cart(3) = z_cc(l) end if - - !do i = 1, num_dims - ! q_prim_vf(i+xibeg-1)%sf(j,k,l) = eta*xi_cart(i) + & - ! (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1) - !end do + + ! assigning the reference map to the q_prim vector field + do i = 1, num_dims + q_prim_vf(i+xibeg-1)%sf(j,k,l) = eta*xi_cart(i) + & + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1) + end do end if diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index ff12c2f07c..7dbcd0d480 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -607,16 +607,13 @@ contains end if if (hyperelasticity) then - elasticity = .false. - hypoelasticity = .false. - hyperelasticity = .false. - !xi_idx%beg = sys_size + 1 - !xi_idx%end = sys_size + num_dims - ! adding three more equations for the \xi field and the elastic energy - !sys_size = xi_idx%end + 1 ! number of entries in the symmetric btensor plus the jacobian - !b_size = (num_dims*(num_dims + 1))/2 + 1 - !tensor_size = num_dims**2 + 1 + b_size = (num_dims*(num_dims + 1))/2 + 1 + tensor_size = num_dims**2 + 1 + xi_idx%beg = sys_size + 1 + xi_idx%end = sys_size + num_dims + ! adding three more equations for the \xi field and the elastic energy + sys_size = xi_idx%end + 1 end if if (sigma /= dflt_real) then diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 3430505da9..a958aee980 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -166,7 +166,8 @@ module m_global_parameters !$acc declare create(num_dims, weno_polyn, weno_order, num_fluids, wenojs, mapped_weno, wenoz, teno) #:endif - !$acc declare create(mpp_lim, model_eqns,mixture_err,alt_soundspeed, avg_state, mp_weno, weno_eps, teno_CT, hypoelasticity, hyperelasticity, elasticity) + !$acc declare create(mpp_lim, model_eqns,mixture_err,alt_soundspeed, & + !$acc avg_state, mp_weno, weno_eps, teno_CT, hypoelasticity, hyperelasticity, elasticity) logical :: relax !< activate phase change integer :: relax_model !< Relaxation model @@ -278,7 +279,8 @@ module m_global_parameters integer :: startx, starty, startz - !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx, b_size, tensor_size, xi_idx) + !$acc declare create(sys_size, buff_size, startx, starty, startz, & + !$acc E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx, b_size, tensor_size) ! END: Simulation Algorithm Parameters ===================================== @@ -387,7 +389,9 @@ module m_global_parameters !$acc declare create(nb) #:endif -!$acc declare create(R0ref, Ca, Web, Re_inv, bubbles, polytropic, polydisperse, qbmm, nmomsp, nmomtot, R0_type, bubble_model, thermal, poly_sigma, adv_n, adap_dt, pi_fac) + !$acc declare create(R0ref, Ca, Web, Re_inv, bubbles, polytropic, & + !$acc polydisperse, qbmm, nmomsp, nmomtot, R0_type, bubble_model, & + !$acc thermal, poly_sigma, adv_n, adap_dt, pi_fac) #ifdef CRAY_ACC_WAR @:CRAY_DECLARE_GLOBAL(type(scalar_field), dimension(:), mom_sp) @@ -403,7 +407,7 @@ module m_global_parameters !> @name Physical bubble parameters (see Ando 2010, Preston 2007) !> @{ real(kind(0d0)) :: R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v -!$acc declare create(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v) + !$acc declare create(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v) #ifdef CRAY_ACC_WAR @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), k_n, k_v, pb0, mass_n0, mass_v0, Pe_T) @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN) @@ -441,8 +445,9 @@ module m_global_parameters integer :: bubxb, bubxe integer :: strxb, strxe integer :: xibeg, xiend -!$acc declare create(momxb, momxe, advxb, advxe, contxb, contxe, intxb, intxe, bubxb, bubxe, strxb, strxe) -!$acc declare create(xibeg,xiend) + !$acc declare create(momxb, momxe, advxb, advxe, contxb, & + !$acc contxe, intxb, intxe, bubxb, bubxe, strxb, strxe) + !$acc declare create(xibeg,xiend) #ifdef CRAY_ACC_WAR @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps) @@ -847,7 +852,7 @@ contains xi_idx%beg = sys_size + 1 xi_idx%end = sys_size + num_dims ! adding three more equations for the \xi field and the elastic energy - !sys_size = xi_idx%end + 1 + sys_size = xi_idx%end + 1 end if if (sigma /= dflt_real) then @@ -1065,18 +1070,34 @@ contains xibeg = xi_idx%beg xiend = xi_idx%end - !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe, b_size, xibeg, xiend, tensor_size) + !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe,& + !$acc bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, & + !$acc alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe, & + !$acc b_size, xibeg, xiend, tensor_size) !$acc update device(m, n, p) !$acc update device(alt_soundspeed, monopole, num_mono) - !$acc update device(dt, sys_size, buff_size, pref, rhoref,gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim,bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids,model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord,mp_weno, weno_eps, teno_CT, hyperelasticity, elasticity, xi_idx) + + !$acc update device(dt, sys_size, buff_size, pref, rhoref, & + !$acc gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, & + !$acc mpp_lim,bubbles, hypoelasticity, alt_soundspeed, & + !$acc avg_state, num_fluids,model_eqns, num_dims, mixture_err, & + !$acc grid_geometry, cyl_coord,mp_weno, weno_eps, teno_CT, & + !$acc hyperelasticity, elasticity, xi_idx) #:if not MFC_CASE_OPTIMIZATION !$acc update device(wenojs, mapped_weno, wenoz, teno) #:endif - !$acc enter data copyin(nb, R0ref, Ca, Web, Re_inv, weight, R0, V0, bubbles, polytropic, polydisperse, qbmm, R0_type, ptil, bubble_model, thermal, poly_sigma) - !$acc enter data copyin(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v, k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN , mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam) + !$acc enter data copyin(nb, R0ref, Ca, Web, Re_inv, weight, & + !$acc R0, V0, bubbles, polytropic, polydisperse, qbmm, & + !$acc R0_type, ptil, bubble_model, thermal, poly_sigma) + + !$acc enter data copyin(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, & + !$acc pv, M_n, M_v, k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, & + !$acc Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN, & + !$acc mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam) + !$acc enter data copyin(dir_idx, dir_flg, dir_idx_tau) !$acc enter data copyin(relax, relax_model, palpha_eps,ptgalpha_eps) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index f035227d6c..30b1e002de 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -357,8 +357,12 @@ contains #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] if (norm_dir == ${NORM_DIR}$) then - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, & - !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, xi_field_L, xi_field_R) + !$acc parallel loop collapse(3) gang vector & + !$acc default(present) private(alpha_rho_L, alpha_rho_R, & + !$acc vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L,& + !$acc tau_e_R, G_L, G_R, Re_L, Re_R, & + !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, & + !$acc xi_field_L, xi_field_R) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -474,7 +478,6 @@ contains E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R ! elastic energy update - ! MAURO HERE IS THE ISSUE if ( hypoelasticity ) then !$acc loop seq do i = 1, strxe - strxb + 1 @@ -507,7 +510,7 @@ contains end if ! elastic energy update - if ( hyperelasticity ) then + !if ( hyperelasticity ) then ! G_L = 0d0 ! G_R = 0d0 ! @@ -526,14 +529,19 @@ contains ! tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ! end do ! !$acc loop seq + ! do i = 1, b_size-1 + ! tau_e_L(i) = 0d0 + ! tau_e_R(i) = 0d0 + ! end do + ! !$acc loop seq ! do i = 1, num_dims ! xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) ! xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) ! end do ! end if - end if + !end if - ! moving this down + ! Enthalpy with elastic energy H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -559,7 +567,7 @@ contains end if if (wave_speeds == 1) then - if ( elasticity ) then + if ( hypoelasticity ) then s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & (((4d0*G_L)/3d0) + & tau_e_L(dir_idx_tau(1)))/rho_L) & @@ -572,11 +580,11 @@ contains , vel_L(dir_idx(1)) + sqrt(c_L*c_L + & (((4d0*G_L)/3d0) + & tau_e_L(dir_idx_tau(1)))/rho_L)) - !elseif ( hyperelasticity ) then - ! s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L ) & - ! , vel_R(dir_idx(1)) - sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R )) - ! s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R ) & - ! , vel_L(dir_idx(1)) + sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L )) + else if ( hyperelasticity ) then + s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L ) & + , vel_R(dir_idx(1)) - sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R )) + s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R ) & + , vel_L(dir_idx(1)) + sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L )) else s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) @@ -645,7 +653,7 @@ contains - rho_R*vel_R(dir_idx(i)))) & /(s_M - s_P) end do - else if ( elasticity ) then + else if ( hypoelasticity ) then !$acc loop seq do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & @@ -684,7 +692,7 @@ contains - s_P*vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) & + s_M*s_P*(E_L - E_R)) & /(s_M - s_P) - else if ( elasticity ) then + else if ( hypoelasticity ) then !TODO: simplify this so it's not split into 3 if (num_dims == 1) then flux_rs${XYZ}$_vf(j, k, l, E_idx) = & @@ -961,8 +969,10 @@ contains if (model_eqns == 3) then !ME3 - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & - !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R) + !$acc parallel loop collapse(3) gang vector & + !$acc default(present) private(vel_L, vel_R, Re_L, Re_R, & + !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, & + !$acc vel_avg_rms, alpha_L, alpha_R) do l = is3%beg, is3%end do k = is2%beg, is2%end @@ -1311,8 +1321,11 @@ contains end do elseif (model_eqns == 4) then !ME4 - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, & - !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) + !$acc parallel loop collapse(3) gang vector & + !$acc default(present) private(alpha_rho_L, & + !$acc alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, & + !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, & + !$acc vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -1560,8 +1573,12 @@ contains end do elseif (model_eqns == 2 .and. bubbles) then - !$acc parallel loop collapse(3) gang vector default(present) private(R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, & - !$acc rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, s_L, s_R, s_S, nbub_L, nbub_R, ptilde_L, ptilde_R, vel_avg_rms, Re_L, Re_R) + !$acc parallel loop collapse(3) gang vector & + !$acc default(present) private(R0_L, R0_R, V0_L, & + !$acc V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, & + !$acc rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, & + !$acc s_L, s_R, s_S, nbub_L, nbub_R, ptilde_L, & + !$acc ptilde_R, vel_avg_rms, Re_L, Re_R) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -2015,8 +2032,10 @@ contains end do !$acc end parallel loop else - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & - !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms) copyin(is1,is2,is3) + !$acc parallel loop collapse(3) gang vector & + !$acc default(present) private(vel_L, vel_R, Re_L, Re_R, & + !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, & + !$acc s_L, s_R, s_S, vel_avg_rms) copyin(is1,is2,is3) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 508e53e32a..a6abf8867a 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -190,14 +190,14 @@ contains end do end if - !if (hyperelasticity) then - !do i = xibeg, xiend + 1 - ! @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & - ! iy_t%beg:iy_t%end, & - ! iz_t%beg:iz_t%end)) - ! @:ACC_SETUP_SFs(q_prim_vf(i)) - !end do - !end if + if (hyperelasticity) then + do i = xibeg, xiend + 1 + @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & + iy_t%beg:iy_t%end, & + iz_t%beg:iz_t%end)) + @:ACC_SETUP_SFs(q_prim_vf(i)) + end do + end if if (model_eqns == 3) then do i = internalEnergies_idx%beg, internalEnergies_idx%end @@ -1030,11 +1030,11 @@ contains end do end if - !if (hyperelasticity) then - ! do i = xibeg, xiend + 1 - ! @:DEALLOCATE(q_prim_vf(i)%sf) - ! end do - !end if + if (hyperelasticity) then + do i = xibeg, xiend + 1 + @:DEALLOCATE(q_prim_vf(i)%sf) + end do + end if if (bubbles) then do i = bub_idx%beg, bub_idx%end diff --git a/toolchain/modules b/toolchain/modules index 3fa848e83f..a261d42b07 100644 --- a/toolchain/modules +++ b/toolchain/modules @@ -62,7 +62,7 @@ d-gpu CC=nvc CXX=nvc++ FC=nvfortran o Brown Oscar o-all python -o-cpu openmpi/4.1.4s +o-cpu hpcx-mpi o-gpu nvhpc cuda/12.3.0 cmake/3.26.3 o-gpu CC=nvc CXX=nvc++ FC=nvfortran From bb80b5a26ea0c8be44b0f030974fa2731c14dfcf Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 1 Jul 2024 16:20:04 -0400 Subject: [PATCH 195/380] preparing for merger with hllc_hypo, code compiles, passes tests and hyper input file --- src/simulation/m_checker.fpp | 4 ++-- src/simulation/m_global_parameters.fpp | 5 ++--- src/simulation/m_rhs.fpp | 4 ++-- src/simulation/m_riemann_solvers.fpp | 5 +++-- 4 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index 95a65a2ed7..807c568691 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -161,9 +161,9 @@ contains !> Checks constraints on hypoelasticity parameters subroutine s_check_inputs_hypoelasticity - if (riemann_solver /= 1) then + if (riemann_solver /= 1 .or. riemann_solver /= 2) then call s_mpi_abort('hypoelasticity requires HLL Riemann solver '// & - '(riemann_solver = 1). Exiting ...') + '(riemann_solver = 1 or 2). Exiting ...') end if end subroutine diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index a958aee980..a0f3f35e22 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -166,7 +166,7 @@ module m_global_parameters !$acc declare create(num_dims, weno_polyn, weno_order, num_fluids, wenojs, mapped_weno, wenoz, teno) #:endif - !$acc declare create(mpp_lim, model_eqns,mixture_err,alt_soundspeed, & + !$acc declare create(mpp_lim, model_eqns, mixture_err, alt_soundspeed, & !$acc avg_state, mp_weno, weno_eps, teno_CT, hypoelasticity, hyperelasticity, elasticity) logical :: relax !< activate phase change @@ -841,7 +841,6 @@ contains stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D sys_size = stress_idx%end - !print *, 'I was here yeah',proc_rank end if if (hyperelasticity) then @@ -1009,7 +1008,7 @@ contains ! the next one if (any(Re_size > 0)) then buff_size = 2*weno_polyn + 2 -! else if (hypoelasticity) then !TODO: check if necessary +! else if (elasticity) then !TODO: check if necessary ! buff_size = 2*weno_polyn + 2 else buff_size = weno_polyn + 2 diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index cbdc5057c6..fbb3e8a476 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -797,11 +797,11 @@ contains call nvtxEndRange !print *, "I got here B" - !call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") + call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") !if ( hyperelasticity ) then ! call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) !end if - !call nvtxEndRange + call nvtxEndRange call nvtxStartRange("RHS-MPI") call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 30b1e002de..a9cbaaa00b 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -876,9 +876,9 @@ contains flux_gsrc_vf, & norm_dir, ix, iy, iz) - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf + real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, & + qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf type(scalar_field), & @@ -908,6 +908,7 @@ contains real(kind(0d0)) :: qv_L, qv_R real(kind(0d0)) :: c_L, c_R real(kind(0d0)), dimension(2) :: Re_L, Re_R + real(kind(0d0)), dimension(3) :: xi_field_L, xi_field_R real(kind(0d0)) :: rho_avg real(kind(0d0)), dimension(num_dims) :: vel_avg From b4b88ef03fcc5fae9e2705221343b23aaeb3ce5c Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 1 Jul 2024 17:02:04 -0400 Subject: [PATCH 196/380] passes test suite --- src/common/m_phase_change.fpp | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 51fd2c0d37..4aa452fee8 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -357,7 +357,8 @@ contains ! Newton Solver for the pT-equilibrium ns = 0 ! change this relative error metric. 1E4 is arbitrary - do while ((DABS(pS - pO) > palpha_eps) .and. (DABS((pS - pO)/pO) > palpha_eps/1d2) .or. (ns == 0)) + do while ((DABS(pS - pO) > palpha_eps) .and. & + (DABS((pS - pO)/pO) > palpha_eps/1d4) .or. (ns == 0)) ! increasing counter ns = ns + 1 @@ -447,7 +448,8 @@ contains R2D(1) = 0.0d0; R2D(2) = 0.0d0 DeltamP(1) = 0.0d0; DeltamP(2) = 0.0d0 do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & - .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d2))) & + .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) & + > (ptgalpha_eps/1d6))) & .or. (ns == 0)) ! Updating counter for the iterative procedure From dd87c40abe1111282083a7d05ab02fc3196f4694 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 1 Jul 2024 17:12:31 -0400 Subject: [PATCH 197/380] removed unnecessary variables --- src/simulation/m_data_output.fpp | 1 - 1 file changed, 1 deletion(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 60a4512078..bb2b2a25af 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -280,7 +280,6 @@ contains real(kind(0d0)) :: vel_sum !< Cell-avg. velocity sum real(kind(0d0)) :: pres !< Cell-avg. pressure real(kind(0d0)), dimension(num_fluids) :: alpha !< Cell-avg. volume fraction - real(kind(0d0)), dimension(num_fluids) :: G_K real(kind(0d0)) :: gamma !< Cell-avg. sp. heat ratio real(kind(0d0)) :: pi_inf !< Cell-avg. liquid stiffness function real(kind(0d0)) :: qv !< Cell-avg. fluid reference energy From cff59ea38c762c1d84492fadb57a96a2f1403c49 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 1 Jul 2024 17:47:02 -0400 Subject: [PATCH 198/380] passed test suite, debugging RMT --- src/common/m_variables_conversion.fpp | 31 ++++++++++++--------------- src/simulation/m_riemann_solvers.fpp | 11 +++++----- 2 files changed, 19 insertions(+), 23 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index c2abd1d72b..1b6c7ea1cf 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -150,17 +150,16 @@ contains end if if ( hypoelasticity .and. present(G)) then - !if ( hypoelasticity .and. present(G)) then ! calculate elastic contribution to Energy E_e = 0d0 do s = stress_idx%beg, stress_idx%end - if (G > 1d-3) then - !E_e = E_e + ((stress/rho)**2d0)/(4d0*G) + if (G > 0) then + E_e = E_e + ((stress/rho)**2d0)/(4d0*G) ! Additional terms in 2D and 3D if ((s == stress_idx%beg + 1) .or. & (s == stress_idx%beg + 3) .or. & (s == stress_idx%beg + 4)) then - ! E_e = E_e + ((stress/rho)**2d0)/(4d0*G) + E_e = E_e + ((stress/rho)**2d0)/(4d0*G) end if end if end do @@ -893,8 +892,9 @@ contains end if #:endif - - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) + !$acc parallel loop collapse(3) gang vector default(present) + !$acc private(alpha_K, alpha_rho_K, Re_K, nRtmp, + !$acc rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) do l = izb, ize do k = iyb, iye do j = ixb, ixe @@ -1003,14 +1003,14 @@ contains /rho_K ! subtracting elastic contribution for pressure calculation if (G_K > 1000) then !TODO: check if stable for >0 - !qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - ! ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K ! extra terms in 2 and 3D if ((i == strxb + 1) .or. & (i == strxb + 3) .or. & (i == strxb + 4)) then - ! qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - ! ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K end if end if end do @@ -1233,14 +1233,14 @@ contains q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) ! adding elastic contribution if (G > 1000) then - ! q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - ! (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) + q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & + (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) ! extra terms in 2 and 3D if ((i == stress_idx%beg + 1) .or. & (i == stress_idx%beg + 3) .or. & (i == stress_idx%beg + 4)) then - ! q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - ! (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) + q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & + (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) end if end if end do @@ -1509,9 +1509,6 @@ contains do l = zb, ze do k = yb, ye do j = xb, xe - !print *, j,k,l - !print *,xibeg - !print *,xiend ! STEP 1: computing the grad_xi tensor ! grad_xi definition / organization ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 7227526190..79021d3034 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -477,12 +477,8 @@ contains E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R - ! Enthalpy with elastic energy - H_L = (E_L + pres_L)/rho_L - H_R = (E_R + pres_R)/rho_R - ! elastic energy update - if ( hypoelasticity ) then + if (hypoelasticity) then !$acc loop seq do i = 1, strxe - strxb + 1 tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) @@ -544,7 +540,10 @@ contains ! end do ! end if !end if - + + ! Enthalpy with elastic energy + H_L = (E_L + pres_L)/rho_L + H_R = (E_R + pres_R)/rho_R @:compute_average_state() From e3e4276477d3c9ecb6024df22b7361a3e2070976 Mon Sep 17 00:00:00 2001 From: mcarcana Date: Mon, 1 Jul 2024 18:06:45 -0400 Subject: [PATCH 199/380] altered checkers for hypo, allowing hllc and 6-eq model combos, and added hypo to 6-eq model in m_global_params for pre,sim,post_process to expand sys_size --- src/common/m_checker_common.fpp | 8 +++++--- src/post_process/m_global_parameters.fpp | 6 ++++++ src/pre_process/m_global_parameters.fpp | 7 +++++++ src/simulation/m_checker.fpp | 8 +++++--- src/simulation/m_global_parameters.fpp | 7 +++++++ 5 files changed, 30 insertions(+), 6 deletions(-) diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index df7bd13ef1..0e3faaff99 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -171,9 +171,11 @@ contains !> Checks constraints on the hypoelasticity parameters. !! Called by s_check_inputs_common for pre-processing and simulation subroutine s_check_inputs_hypoelasticity - if (model_eqns /= 2) then - call s_mpi_abort('hypoelasticity requires 5-equation model'// & - '(model_eqns = 2). Exiting ...') + !if ((model_eqns /= 2) .or. (model_eqns /= 3)) then + if ((model_eqns == 1) .or. (model_eqns == 4)) then + call s_mpi_abort('hypoelasticity requires either '// & + '5-equation (model_eqns = 2) or '// & + '6-equation model (model_eqns = 3). Exiting ...') end if end subroutine s_check_inputs_hypoelasticity diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 4b893effdc..5b7a4ec349 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -516,6 +516,12 @@ contains internalEnergies_idx%end = adv_idx%end + num_fluids sys_size = internalEnergies_idx%end alf_idx = 1 ! dummy, cannot actually have a void fraction + + if (hypoelasticity) then + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + sys_size = stress_idx%end + end if if (sigma /= dflt_real) then c_idx = sys_size + 1 diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 9b166cfc8c..6efe25ce7a 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -618,6 +618,13 @@ contains internalEnergies_idx%end = adv_idx%end + num_fluids sys_size = internalEnergies_idx%end + if (hypoelasticity) then + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end + end if + if (sigma /= dflt_real) then c_idx = sys_size + 1 sys_size = c_idx diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index 95a65a2ed7..fa1b6480ac 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -161,9 +161,11 @@ contains !> Checks constraints on hypoelasticity parameters subroutine s_check_inputs_hypoelasticity - if (riemann_solver /= 1) then - call s_mpi_abort('hypoelasticity requires HLL Riemann solver '// & - '(riemann_solver = 1). Exiting ...') + if (riemann_solver == 3) then + call s_mpi_abort('hypoelasticity requires HLL '// & + '(riemann_solver = 1) or HLLC '// & + '(riemann_solver = 2) Riemann solver. '// & + 'Exiting ...') end if end subroutine diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index ae9693e692..adcfce3dcf 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -845,6 +845,13 @@ contains internalEnergies_idx%beg = adv_idx%end + 1 internalEnergies_idx%end = adv_idx%end + num_fluids sys_size = internalEnergies_idx%end + + if (hypoelasticity) then + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end + end if if (sigma /= dflt_real) then c_idx = sys_size + 1 From cec56f7d18f435ab0cb7feda501a49478bfe95d3 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 2 Jul 2024 16:51:33 -0500 Subject: [PATCH 200/380] added changes to compile on GPUs for m_variables_conversion --- src/common/m_variables_conversion.fpp | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 1b6c7ea1cf..48f0da553e 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -892,9 +892,8 @@ contains end if #:endif - !$acc parallel loop collapse(3) gang vector default(present) - !$acc private(alpha_K, alpha_rho_K, Re_K, nRtmp, - !$acc rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) + !$acc parallel loop collapse(3) gang vector default(present) & + !$acc private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) do l = izb, ize do k = iyb, iye do j = ixb, ixe From c3656d6ca0eb6f84cf26233582804d3862911a7e Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 2 Jul 2024 18:20:24 -0500 Subject: [PATCH 201/380] reverted phase change to pass test suite --- src/common/m_phase_change.fpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 51fd2c0d37..4fe7d8be02 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -357,7 +357,7 @@ contains ! Newton Solver for the pT-equilibrium ns = 0 ! change this relative error metric. 1E4 is arbitrary - do while ((DABS(pS - pO) > palpha_eps) .and. (DABS((pS - pO)/pO) > palpha_eps/1d2) .or. (ns == 0)) + do while ((DABS(pS - pO) > palpha_eps) .and. (DABS((pS - pO)/pO) > palpha_eps/1d4) .or. (ns == 0)) ! increasing counter ns = ns + 1 @@ -447,7 +447,7 @@ contains R2D(1) = 0.0d0; R2D(2) = 0.0d0 DeltamP(1) = 0.0d0; DeltamP(2) = 0.0d0 do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & - .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d2))) & + .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) & .or. (ns == 0)) ! Updating counter for the iterative procedure From a4fe571592821b08cac3aa0de1d4df11b1ade541 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 2 Jul 2024 20:14:39 -0400 Subject: [PATCH 202/380] merged with master, test suite works on CPUs --- batch_mfc.sh | 14 + examples/3D_hyperelasticity/hyper_gel.py | 312 +++++++++++++++++++++++ submit_hyper.sh | 7 + submit_pc.sh | 9 + 4 files changed, 342 insertions(+) create mode 100755 batch_mfc.sh create mode 100644 examples/3D_hyperelasticity/hyper_gel.py create mode 100755 submit_hyper.sh create mode 100755 submit_pc.sh diff --git a/batch_mfc.sh b/batch_mfc.sh new file mode 100755 index 0000000000..41df3c3473 --- /dev/null +++ b/batch_mfc.sh @@ -0,0 +1,14 @@ +#!/bin/bash + +./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar + +./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar + +./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar +./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar + diff --git a/examples/3D_hyperelasticity/hyper_gel.py b/examples/3D_hyperelasticity/hyper_gel.py new file mode 100644 index 0000000000..22ff210a1d --- /dev/null +++ b/examples/3D_hyperelasticity/hyper_gel.py @@ -0,0 +1,312 @@ +import math +import json +#need quadrant and collapse near hypoelastic wall + +## Define characteristic values for the sim +Ri = 230.4E-6 +# temperature +T = (10*101325+1.0E+09)/(1000*(2.35-1)*1816) +# print("T :: ",T) +rhog = 1 +Pb = 3550 #Pb = 101325 +Pl = 101325 #Pl = 20*101325 +Po = Pl +Pi_inf_l = 1.0E+09 +Pi_inf_b = 0.0E+00 +Pi_inf_o = 1.1754E+09 + +## fluid properties +# liquid +nl = 2.35E+00 +cv_l = 1816 +rhol = (Pl+Pi_inf_l)/((nl-1)*cv_l*T) +# object +obj_rhol = rhol +cv_o = cv_l +rhoo = 1060 +no = 2.35 +#no = 1.19E+00 +muo = 0.060E+00 +# gas +ng = 1.47E+00 + +# alpha seeding fractions +bub_wl = 1.0E-12 +bub_wo = 1.0E-12 +bub_wg = 1 - bub_wl - bub_wo +liq_wo = 1.0E-12 +liq_wg = 1.0E-12 +liq_wl = 1 - liq_wo - liq_wg +obj_wl = 1.0E-12 +obj_wg = 1.0E-12 +obj_wo = 1 - obj_wl - obj_wg + +Gl = 0. +Gg = 0. +Go = 0.57E+03 #1.0933E+04 + +## mixture values in the liquid +#rhoml = (alpha1-alph_eps)*rhol+alph_eps*rhog +#pi_inf_m = (alpha1-alph_eps)*Pi_inf_l +#nml = (alpha1-alph_eps)*nl+alph_eps*ng +cl = (nl*(Pl+Pi_inf_l)/rhol)**(0.5) +rhoml = liq_wl*rhol + liq_wg*rhog + liq_wo*rhoo + +## Defining Characteristic Values +Rc = Ri +rhoc = rhol +uc = (Pl/rhol)**(0.5E+00) +ucc = (Pl/rhoml)**(0.5E+00) +# characteristic collapse time, change later to prevent horrific confusion +tc = Ri/uc +Pc = rhoc*uc**(2.0E+00) + +## Non-Dimensionalizing values using characteristic values +Rin = Ri/Rc +rholn = rhol/rhoc +rhogn = rhog/rhoc +rhoon = rhoo/rhoc +Pln = Pl/Pc +Pbn = Pb/Pc +Pon = Po/Pc +tcn = tc/tc +Pi_inf_ln = Pi_inf_l/Pc +clc = cl/uc +sod_nd = 2.17 +#clmc = clm/ucc +Pi_inf_on = Pi_inf_o/Pc + +# Un comment if dimensional +#Rin = Ri +#rholn = rhol +#rhogn = rhog +#rhoon = rhoo +#Pln = Pl +#Pbn = Pb/rhoo +#Pon = Po +#tcn = tc +#Pi_inf_ln = Pi_inf_l +#leng = domain_length +#clc = cl +#sod_nd = sod + +## Non-Dimensional Numbers +#Rel = rhol*uc*2*Rin/mulc +#Reb = rhog*uc*2*Rin/mubc +Rel = 0 +Reb = 0 +Reo = rhoo*uc*2/muo +Ma = uc/cl +Co = Pl/Go +iCo = 1/Co + +## GEOMETRY:: Grid Specifications +lengx = 8.0E+00 +lengy = 3.0E+00 +lengz = 3.0E+00 +CFL = 0.3 +PPBR = 16 #92 +x_beg = -5.0E+00 +x_end = 3.0E+00 +y_beg = 0.0E+00 +y_end = lengy +z_beg = 0.0E+00 +z_end = lengz +Nx = PPBR*lengx +Ny = PPBR*lengy +Nz = PPBR*lengz +delta_x = lengx/Nx +delta_t = CFL*delta_x/clc + +#print("NX :: ",Nx,", NY :: ",Ny,", NZ :: ",Nz) + +#delta_t_c = 0.185*delta_x/clmc +#print(delta_t_c) + +Nt = int(1.7*tcn/delta_t) +# liquid centroid, patch 1 +x_centroidl = x_beg/(2.0E+00) +y_centroidl = (y_end+y_beg)/(2.0E+00) +z_centroidl = (z_end+z_beg)/(2.0E+00) +# bubble centroid, patch 2 +x_centroidb = -sod_nd +y_centroidb = 0.0 +z_centroidb = 0.0 +# objective centroid, patch 3 +x_centroido = x_end/2 +y_centroido = (y_end+y_beg)/(2.0E+00) +z_centroido = (z_end+z_beg)/(2.0E+00) + +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================ + 'run_time_info' : 'T', + 'sim_data' : 'T', + # ========================================================== + + # Computational Domain Parameters ========================== + 'x_domain%beg' : x_beg, + 'x_domain%end' : x_end, + 'y_domain%beg' : y_beg, + 'y_domain%end' : y_end, + 'z_domain%beg' : z_beg, + 'z_domain%end' : z_end, + 'm' : int(Nx), + 'n' : int(Ny), + 'p' : int(Nz), + 'cyl_coord' : 'F', + 'dt' : delta_t, + 't_step_start' : 0, + 't_step_stop' : Nt, + 't_step_save' : int(5),#int(Nt/150), +# ========================================================== + + # Simulation Algorithm Parameters ========================== + 'num_patches' : 3, + 'model_eqns' : 2, + 'hypoelasticity' : 'T', + #'hyperelasticity' : 'F', + #'pre_stress' : 'F', + 'alt_soundspeed' : 'F', + 'num_fluids' : 3, + 'adv_alphan' : 'T', + 'mpp_lim' : 'F', + 'mixture_err' : 'T', + 'time_stepper' : 3, + 'weno_order' : 5, + 'weno_eps' : 1.E-16, + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'T', + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'riemann_solver' : 1, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -6, #-16,#-2 + 'bc_x%end' : -6, + 'bc_y%beg' : -2, + 'bc_y%end' : -6, + 'bc_z%beg' : -2, + 'bc_z%end' : -6, + 'stretch_x' : 'F', + 'stretch_y' : 'F', + 'stretch_z' : 'F', + 'a_x' : 4.0E+00, + 'x_a' : -1.5E+00-sod_nd, + 'x_b' : 2.5E+00, + #'loops_x' : 0, + 'a_y' : 4.0E+00, + 'y_a' : -1.5E+00, + 'y_b' : 1.5E+00, + #'loops_y' : 0, + 'a_z' : 4.0E+00, + 'z_a' : -1.5E+00, + 'z_b' : 1.5E+00, + #'loops_z' : 0, + # ========================================================== + + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'T', + 'probe_wrt' :'T', + 'fd_order' : 1, + 'num_probes' : 1, + 'probe(1)%x' : 0., + 'probe(1)%y' : 0., + 'probe(1)%z' : 0., + # ========================================================== + + # Patch 1: Background ============================ + 'patch_icpp(1)%geometry' : 9,# for 3D + 'patch_icpp(1)%x_centroid' : x_centroidl, #100*x_centroidl, + 'patch_icpp(1)%y_centroid' : y_centroidl, #100*y_centroidl, + 'patch_icpp(1)%z_centroid' : z_centroidl, #100*z_centroidl, + 'patch_icpp(1)%length_x' : lengx, #200*lengx, + 'patch_icpp(1)%length_y' : lengy, #200*lengy, + 'patch_icpp(1)%length_z' : lengz, #200*lengz, + 'patch_icpp(1)%vel(1)' : 0.E+00, + 'patch_icpp(1)%vel(2)' : 0.E+00, + 'patch_icpp(1)%vel(3)' : 0.E+00, + 'patch_icpp(1)%pres' : Pln, + 'patch_icpp(1)%alpha_rho(1)' : liq_wl*rholn, + 'patch_icpp(1)%alpha_rho(2)' : liq_wg*rhogn, + 'patch_icpp(1)%alpha_rho(3)' : liq_wo*rhoon, + 'patch_icpp(1)%alpha(1)' : liq_wl, + 'patch_icpp(1)%alpha(2)' : liq_wg, + 'patch_icpp(1)%alpha(3)' : liq_wo, + # ========================================================== + # Patch 2: Bubble ====================================== + # Specify the spherical gas bubble grid geometry + 'patch_icpp(2)%geometry' : 8,# for 3D + 'patch_icpp(2)%smoothen' : 'T', + 'patch_icpp(2)%smooth_patch_id' : 1, + 'patch_icpp(2)%smooth_coeff' : 4.0E+00, + 'patch_icpp(2)%x_centroid' : x_centroidb, + 'patch_icpp(2)%y_centroid' : y_centroidb, + 'patch_icpp(2)%z_centroid' : z_centroidb, + 'patch_icpp(2)%radius' : Rin, + 'patch_icpp(2)%alter_patch(1)' : 'T', + # Specify the patch primitive variables + 'patch_icpp(2)%vel(1)' : 0.E+00, + 'patch_icpp(2)%vel(2)' : 0.E+00, + 'patch_icpp(2)%vel(3)' : 0.E+00, + 'patch_icpp(2)%pres' : Pbn, + 'patch_icpp(2)%alpha_rho(1)' : bub_wl*rholn, + 'patch_icpp(2)%alpha_rho(2)' : bub_wg*rhogn, + 'patch_icpp(2)%alpha_rho(3)' : bub_wo*rhoon, + 'patch_icpp(2)%alpha(1)' : bub_wl, + 'patch_icpp(2)%alpha(2)' : bub_wg, + 'patch_icpp(2)%alpha(3)' : bub_wo, + # ========================================================== + # Patch 3: Gel =========================================== + # Specify the gel grid geometry + 'patch_icpp(3)%geometry' : 9,# for 3D + 'patch_icpp(3)%x_centroid' : x_centroido, #100*x_centroido, + 'patch_icpp(3)%y_centroid' : y_centroido, #100*y_centroido, + 'patch_icpp(3)%z_centroid' : z_centroido, #100*z_centroido, + 'patch_icpp(3)%length_x' : 3.0E+00, #100*lengx, + 'patch_icpp(3)%length_y' : lengy, #200*lengy, + 'patch_icpp(3)%length_z' : lengz, #200*lengz, + 'patch_icpp(3)%alter_patch(1)' : 'T', + # Specify the patch primitive variables + 'patch_icpp(3)%vel(1)' : 0.E+00, + 'patch_icpp(3)%vel(2)' : 0.E+00, + 'patch_icpp(3)%vel(3)' : 0.E+00, + 'patch_icpp(3)%pres' : Pon, + 'patch_icpp(3)%alpha_rho(1)' : obj_wl*rholn, + 'patch_icpp(3)%alpha_rho(2)' : obj_wg*rhogn, + 'patch_icpp(3)%alpha_rho(3)' : obj_wo*rhoon, + 'patch_icpp(3)%alpha(1)' : obj_wl, + 'patch_icpp(3)%alpha(2)' : obj_wg, + 'patch_icpp(3)%alpha(3)' : obj_wo, + # ========================================================== + + + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1./(nl-1.), + 'fluid_pp(1)%pi_inf' : nl*Pi_inf_ln/(nl-1.), + 'fluid_pp(1)%G' : Gl, + 'fluid_pp(2)%gamma' : 1./(ng-1.), + 'fluid_pp(2)%pi_inf' : 0.0E+00, + 'fluid_pp(2)%G' : Gg, + 'fluid_pp(3)%gamma' : 1./(no-1.), + 'fluid_pp(3)%pi_inf' : no*Pi_inf_on/(no-1.), + 'fluid_pp(3)%G' : iCo, + 'fluid_pp(1)%qv' : 0.0E+00, + 'fluid_pp(1)%qvp' : 0.0E+00, + 'fluid_pp(2)%qv' : 0.0E+00, + 'fluid_pp(2)%qvp' : 0.0E+00, + 'fluid_pp(3)%qv' : 0.0E+00, + 'fluid_pp(3)%qvp' : 0.0E+00, +# 'fluid_pp(1)%Re(1)' : Rel, +# 'fluid_pp(2)%Re(1)' : Reb, +# 'fluid_pp(3)%Re(1)' : Reo, + # ===========++============================================= +})) + +# ============================================================================== + + diff --git a/submit_hyper.sh b/submit_hyper.sh new file mode 100755 index 0000000000..ba197a9987 --- /dev/null +++ b/submit_hyper.sh @@ -0,0 +1,7 @@ +#!/bin/bash + +./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar +#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta + + diff --git a/submit_pc.sh b/submit_pc.sh new file mode 100755 index 0000000000..e45b98dbc4 --- /dev/null +++ b/submit_pc.sh @@ -0,0 +1,9 @@ +#!/bin/bash + +#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar +#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta + +./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t simulation -c delta + From 49906ec707d5f510dacba59ad7c419a41535906d Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 2 Jul 2024 20:42:43 -0500 Subject: [PATCH 203/380] modified GPU code back to the direct OpenACC --- src/simulation/m_global_parameters.fpp | 34 ++++++------------------ src/simulation/m_riemann_solvers.fpp | 36 +++++--------------------- 2 files changed, 15 insertions(+), 55 deletions(-) diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 5be8305a95..1ed86abb39 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -168,8 +168,7 @@ module m_global_parameters !$acc declare create(num_dims, weno_polyn, weno_order, num_fluids, wenojs, mapped_weno, wenoz, teno) #:endif - !$acc declare create(mpp_lim, model_eqns, mixture_err, alt_soundspeed, & - !$acc avg_state, mp_weno, weno_eps, teno_CT, hypoelasticity, hyperelasticity, elasticity) + !$acc declare create(mpp_lim, model_eqns, mixture_err, alt_soundspeed, avg_state, mp_weno, weno_eps, teno_CT, hypoelasticity, hyperelasticity, elasticity) logical :: relax !< activate phase change integer :: relax_model !< Relaxation model @@ -281,8 +280,7 @@ module m_global_parameters integer :: startx, starty, startz - !$acc declare create(sys_size, buff_size, startx, starty, startz, & - !$acc E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx, b_size, tensor_size) + !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx, b_size, tensor_size) ! END: Simulation Algorithm Parameters ===================================== @@ -391,9 +389,7 @@ module m_global_parameters !$acc declare create(nb) #:endif - !$acc declare create(R0ref, Ca, Web, Re_inv, bubbles, polytropic, & - !$acc polydisperse, qbmm, nmomsp, nmomtot, R0_type, bubble_model, & - !$acc thermal, poly_sigma, adv_n, adap_dt, pi_fac) + !$acc declare create(R0ref, Ca, Web, Re_inv, bubbles, polytropic, polydisperse, qbmm, nmomsp, nmomtot, R0_type, bubble_model, thermal, poly_sigma, adv_n, adap_dt, pi_fac) #ifdef CRAY_ACC_WAR @:CRAY_DECLARE_GLOBAL(type(scalar_field), dimension(:), mom_sp) @@ -447,8 +443,7 @@ module m_global_parameters integer :: bubxb, bubxe integer :: strxb, strxe integer :: xibeg, xiend - !$acc declare create(momxb, momxe, advxb, advxe, contxb, & - !$acc contxe, intxb, intxe, bubxb, bubxe, strxb, strxe) + !$acc declare create(momxb, momxe, advxb, advxe, contxb, contxe, intxb, intxe, bubxb, bubxe, strxb, strxe) !$acc declare create(xibeg,xiend) #ifdef CRAY_ACC_WAR @@ -1078,33 +1073,20 @@ contains xibeg = xi_idx%beg xiend = xi_idx%end - !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe,& - !$acc bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, & - !$acc alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe, & - !$acc b_size, xibeg, xiend, tensor_size) + !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe, b_size, xibeg, xiend, tensor_size) !$acc update device(m, n, p) !$acc update device(alt_soundspeed, monopole, num_mono) - !$acc update device(dt, sys_size, buff_size, pref, rhoref, & - !$acc gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, & - !$acc mpp_lim,bubbles, hypoelasticity, alt_soundspeed, & - !$acc avg_state, num_fluids,model_eqns, num_dims, mixture_err, & - !$acc grid_geometry, cyl_coord,mp_weno, weno_eps, teno_CT, & - !$acc hyperelasticity, elasticity, xi_idx) + !$acc update device(dt, sys_size, buff_size, pref, rhoref, gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim,bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids,model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord,mp_weno, weno_eps, teno_CT, hyperelasticity, elasticity, xi_idx) #:if not MFC_CASE_OPTIMIZATION !$acc update device(wenojs, mapped_weno, wenoz, teno) #:endif - !$acc enter data copyin(nb, R0ref, Ca, Web, Re_inv, weight, & - !$acc R0, V0, bubbles, polytropic, polydisperse, qbmm, & - !$acc R0_type, ptil, bubble_model, thermal, poly_sigma) + !$acc enter data copyin(nb, R0ref, Ca, Web, Re_inv, weight, R0, V0, bubbles, polytropic, polydisperse, qbmm, R0_type, ptil, bubble_model, thermal, poly_sigma) - !$acc enter data copyin(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, & - !$acc pv, M_n, M_v, k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, & - !$acc Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN, & - !$acc mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam) + !$acc enter data copyin(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v, k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN, mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam) !$acc enter data copyin(dir_idx, dir_flg, dir_idx_tau) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index ac10755af0..4639c4bcf1 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -162,14 +162,12 @@ module m_riemann_solvers @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsx_vf, flux_src_rsx_vf) @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsy_vf, flux_src_rsy_vf) @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsz_vf, flux_src_rsz_vf) - !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & - !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) + !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) #else real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsx_vf, flux_src_rsx_vf real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsy_vf, flux_src_rsy_vf real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsz_vf, flux_src_rsz_vf - !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & - !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) + !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf) #endif !> @} @@ -357,12 +355,7 @@ contains #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] if (norm_dir == ${NORM_DIR}$) then - !$acc parallel loop collapse(3) gang vector & - !$acc default(present) private(alpha_rho_L, alpha_rho_R, & - !$acc vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L,& - !$acc tau_e_R, G_L, G_R, Re_L, Re_R, & - !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, & - !$acc xi_field_L, xi_field_R) + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, xi_field_L, xi_field_R) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -975,10 +968,7 @@ contains if (model_eqns == 3) then !ME3 - !$acc parallel loop collapse(3) gang vector & - !$acc default(present) private(vel_L, vel_R, Re_L, Re_R, & - !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, & - !$acc vel_avg_rms, alpha_L, alpha_R) + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -1326,11 +1316,7 @@ contains end do elseif (model_eqns == 4) then !ME4 - !$acc parallel loop collapse(3) gang vector & - !$acc default(present) private(alpha_rho_L, & - !$acc alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, & - !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, & - !$acc vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -1578,12 +1564,7 @@ contains end do elseif (model_eqns == 2 .and. bubbles) then - !$acc parallel loop collapse(3) gang vector & - !$acc default(present) private(R0_L, R0_R, V0_L, & - !$acc V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, & - !$acc rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, & - !$acc s_L, s_R, s_S, nbub_L, nbub_R, ptilde_L, & - !$acc ptilde_R, vel_avg_rms, Re_L, Re_R) + !$acc parallel loop collapse(3) gang vector default(present) private(R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, s_L, s_R, s_S, nbub_L, nbub_R, ptilde_L, ptilde_R, vel_avg_rms, Re_L, Re_R) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -2038,10 +2019,7 @@ contains !$acc end parallel loop else - !$acc parallel loop collapse(3) gang vector & - !$acc default(present) private(vel_L, vel_R, Re_L, Re_R, & - !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, & - !$acc s_L, s_R, s_S, vel_avg_rms) copyin(is1,is2,is3) + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms) copyin(is1,is2,is3) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end From a4e6da23e2db2a373fb7aca46b3c5bba08b748bf Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 3 Jul 2024 00:08:55 -0500 Subject: [PATCH 204/380] cleaned up differences between master, testing on Delta GPUs, compiles --- src/common/m_phase_change.fpp | 4 ++-- src/common/m_variables_conversion.fpp | 3 +-- src/post_process/m_data_input.f90 | 4 ++-- src/post_process/m_global_parameters.fpp | 3 --- src/pre_process/m_global_parameters.fpp | 3 ++- src/simulation/m_start_up.fpp | 4 ++-- 6 files changed, 9 insertions(+), 12 deletions(-) diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 8a6a069362..a5ca52b76c 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -358,8 +358,8 @@ contains ns = 0 ! change this relative error metric. 1E4 is arbitrary do while ((DABS(pS - pO) > palpha_eps) .and. & - (DABS((pS - pO)/pO) > palpha_eps/1d4) .or. & - (ns == 0)) + (DABS((pS - pO)/pO) > palpha_eps/1d4) .or. & + (ns == 0)) ! increasing counter ns = ns + 1 diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index e0b41ee9d6..c5c4ff9fe1 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -894,8 +894,7 @@ contains end if #:endif - !$acc parallel loop collapse(3) gang vector default(present) & - !$acc private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) do l = izb, ize do k = iyb, iye do j = ixb, ixe diff --git a/src/post_process/m_data_input.f90 b/src/post_process/m_data_input.f90 index 123efa0b6d..bbd063df6c 100644 --- a/src/post_process/m_data_input.f90 +++ b/src/post_process/m_data_input.f90 @@ -370,7 +370,7 @@ subroutine s_read_parallel_data_files(t_step) NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) ! Read the data for each variable - if (bubbles .or. hypoelasticity .or. hyperelasticity) then + if (bubbles .or. elasticity) then do i = 1, sys_size var_MOK = int(i, MPI_OFFSET_KIND) @@ -444,7 +444,7 @@ subroutine s_read_parallel_data_files(t_step) NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) ! Read the data for each variable - if (bubbles .or. hypoelasticity .or. hyperelasticity) then + if (bubbles .or. elasticity) then do i = 1, sys_size var_MOK = int(i, MPI_OFFSET_KIND) diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 35e46f0a97..1fd09dcd1b 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -501,9 +501,6 @@ contains if (hypoelasticity .or. hyperelasticity) then elasticity = .true. - end if - - if (elasticity) then stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 22ac80867e..d709bf3140 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -641,7 +641,8 @@ contains internalEnergies_idx%end = adv_idx%end + num_fluids sys_size = internalEnergies_idx%end - if (hypoelasticity) then + if (hypoelasticity .or. hyperelasticity) then + elasticity = .true. stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 152315f48f..1d96ce8d2e 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -142,7 +142,7 @@ contains x_a, y_a, z_a, x_b, y_b, z_b, & x_domain, y_domain, z_domain, & hypoelasticity, & - ib, num_ibs, hyperelasticity, patch_ib, & + ib, num_ibs, patch_ib, & fluid_pp, probe_wrt, prim_vars_wrt, & fd_order, probe, num_probes, t_step_old, & alt_soundspeed, mixture_err, weno_Re_flux, & @@ -162,7 +162,7 @@ contains R0_type, file_per_process, sigma, & pi_fac, adv_n, adap_dt, bf_x, bf_y, bf_z, & k_x, k_y, k_z, w_x, w_y, w_z, p_x, p_y, p_z, & - g_x, g_y, g_z, R0ref + g_x, g_y, g_z, hyperelasticity, R0ref ! Checking that an input file has been provided by the user. If it ! has, then the input file is read in, otherwise, simulation exits. From f8711329f0e3bf29f9c178b4d1d24b402d6bd469 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 3 Jul 2024 00:30:49 -0500 Subject: [PATCH 205/380] removed excess code in inline conversions --- src/common/include/inline_conversions.fpp | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/src/common/include/inline_conversions.fpp b/src/common/include/inline_conversions.fpp index 03ce3813ff..c2f0263e69 100644 --- a/src/common/include/inline_conversions.fpp +++ b/src/common/include/inline_conversions.fpp @@ -17,20 +17,6 @@ integer :: q if (alt_soundspeed) then - !!acc loop seq - !c = 0d0 - !do q = 1, num_fluids - ! if (hypoelasticity) then - ! blkmod(i) = ((gammas(i) + 1d0)*pres + & - ! pi_infs(i))/gammas(i)+4/3*G(i) - ! else - ! blkmod(q) = ((gammas(q) + 1d0)*pres + & - ! pi_infs(q))/gammas(q) - ! end if - ! c = c + adv(q)/blkmod(q) - !end do - !c = 1d0/(rho*c) - !if (alt_soundspeed) then blkmod1 = ((gammas(1) + 1d0)*pres + & pi_infs(1))/gammas(1) blkmod2 = ((gammas(2) + 1d0)*pres + & From 12bb983f490ac4e2e3710bf6eaae5e3ae265cfe4 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 3 Jul 2024 12:04:00 -0500 Subject: [PATCH 206/380] code compiles and passes test suite on Delta GPUs --- src/simulation/m_global_parameters.fpp | 2 +- src/simulation/m_rhs.fpp | 4 ++-- src/simulation/m_riemann_solvers.fpp | 10 +++------- submit_test.sh | 7 +++++++ 4 files changed, 13 insertions(+), 10 deletions(-) create mode 100755 submit_test.sh diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 1ed86abb39..ddb4068f32 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -280,7 +280,7 @@ module m_global_parameters integer :: startx, starty, startz - !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx, b_size, tensor_size) + !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx,b_size, tensor_size, xi_idx) ! END: Simulation Algorithm Parameters ===================================== diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index b4f82a9d07..1a339b20f1 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -797,11 +797,11 @@ contains call nvtxEndRange !print *, "I got here B" - call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") + !call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") !if ( hyperelasticity ) then ! call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) !end if - call nvtxEndRange + !call nvtxEndRange call nvtxStartRange("RHS-MPI") call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 4639c4bcf1..4eff556294 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -871,8 +871,7 @@ contains flux_gsrc_vf, & norm_dir, ix, iy, iz) - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, & - qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf + real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf @@ -968,7 +967,7 @@ contains if (model_eqns == 3) then !ME3 - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R) + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -1075,7 +1074,6 @@ contains end if E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R H_L = (E_L + pres_L)/rho_L @@ -1681,7 +1679,6 @@ contains end if E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms H_L = (E_L + pres_L)/rho_L @@ -2019,7 +2016,7 @@ contains !$acc end parallel loop else - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms) copyin(is1,is2,is3) + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, tau_e_L, tau_e_R, G_L, G_R) copyin(is1,is2,is3) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -2132,7 +2129,6 @@ contains end if E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R H_L = (E_L + pres_L)/rho_L diff --git a/submit_test.sh b/submit_test.sh new file mode 100755 index 0000000000..a80f79f755 --- /dev/null +++ b/submit_test.sh @@ -0,0 +1,7 @@ +#!/bin/bash + +./mfc.sh run ./tests/C5B79059/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run ./tests/C5B79059/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta + + From 927b3c5d1c7ab5d9c1def705c71f501571ea8ac5 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 3 Jul 2024 13:42:29 -0500 Subject: [PATCH 207/380] added OpenACC commands in model_eqns=3 for hllc in preparation for hypo/hyper --- src/simulation/m_riemann_solvers.fpp | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 4eff556294..eab03bae33 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -964,10 +964,12 @@ contains #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] if (norm_dir == ${NORM_DIR}$) then + + ! 6-EQUATION MODEL WITH HLLC if (model_eqns == 3) then !ME3 - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R) + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R) copyin(is1,is2,is3) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -1100,6 +1102,7 @@ contains end do end if + ! COMPUTING THE DIRECT WAVE SPEEDS if (wave_speeds == 1) then s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) @@ -1132,6 +1135,7 @@ contains (rho_avg*c_avg)) end if + ! COMPUTING FLUXES if (s_L >= 0d0) then p_Star = pres_L ! Only useful to recalculate the radial momentum geometric source flux !$acc loop seq @@ -1909,7 +1913,6 @@ contains (s_R - vel_R(dir_idx(1))))) - E_R)) ! Volume fraction flux - !$acc loop seq do i = advxb, advxe flux_rs${XYZ}$_vf(j, k, l, i) = & @@ -2014,7 +2017,8 @@ contains end do end do !$acc end parallel loop - else + else + ! 5-EQUATION MODEL WITH HLLC, INTERFACE CAPTURING ONLY !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, tau_e_L, tau_e_R, G_L, G_R) copyin(is1,is2,is3) do l = is3%beg, is3%end From bfd3fc1437bc826b5a74274cba937f45cf61bad2 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 3 Jul 2024 13:55:18 -0500 Subject: [PATCH 208/380] added elastic energy to hllc for 6-equation model --- src/simulation/m_riemann_solvers.fpp | 42 ++++++++++++++++++++++------ 1 file changed, 34 insertions(+), 8 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index eab03bae33..c7d2a8942f 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -1077,6 +1077,35 @@ contains E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R + + ! ADJUSTMENTS FOR ELASTIC ENERGY + if (hypoelasticity) then + !$acc loop seq + do i = 1, strxe - strxb + 1 + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + end do + G_L = 0d0 + G_R = 0d0 + !$acc loop seq + do i = 1, num_fluids + G_L = G_L + alpha_L(i)*Gs(i) + G_R = G_R + alpha_R(i)*Gs(i) + end do + + do i = 1, strxe - strxb + 1 + ! Elastic contribution to energy if G large enough + if ((G_L > verysmall) .and. (G_R > verysmall)) then + E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) + E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) + ! Additional terms in 2D and 3D + if ((i == 2) .or. (i == 4) .or. (i == 5)) then + E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) + E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) + end if + end if + end do + end if H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -1799,7 +1828,6 @@ contains call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & vel_L_rms, c_L) - call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & vel_R_rms, c_R) @@ -2135,9 +2163,6 @@ contains E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R - H_L = (E_L + pres_L)/rho_L - H_R = (E_R + pres_R)/rho_R - if (hypoelasticity) then !$acc loop seq do i = 1, strxe - strxb + 1 @@ -2156,8 +2181,7 @@ contains do i = 1, strxe - strxb + 1 ! Elastic contribution to energy if G large enough - !TODO take out if statement if stable without - if ((G_L > 1000) .and. (G_R > 1000)) then + if ((G_L > verysmall) .and. (G_R > verysmall)) then E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) ! Additional terms in 2D and 3D @@ -2168,8 +2192,10 @@ contains end if end do end if - !SGR Added exact code from hll here - + + H_L = (E_L + pres_L)/rho_L + H_R = (E_R + pres_R)/rho_R + @:compute_average_state() call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & From 3b34a182bff033632dff44ac6a9602101b561dd8 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 3 Jul 2024 15:14:40 -0500 Subject: [PATCH 209/380] added more detail for the HLLC Riemann solver with 6-equation model --- src/simulation/m_rhs.fpp | 8 +++---- src/simulation/m_riemann_solvers.fpp | 34 +++++++++++++++++++--------- 2 files changed, 27 insertions(+), 15 deletions(-) diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 1a339b20f1..9d2af70e81 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -797,11 +797,11 @@ contains call nvtxEndRange !print *, "I got here B" - !call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") - !if ( hyperelasticity ) then + call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") + if ( hyperelasticity ) then ! call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) - !end if - !call nvtxEndRange + end if + call nvtxEndRange call nvtxStartRange("RHS-MPI") call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index c7d2a8942f..dff331356a 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -1085,8 +1085,10 @@ contains tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do + G_L = 0d0 G_R = 0d0 + !$acc loop seq do i = 1, num_fluids G_L = G_L + alpha_L(i)*Gs(i) @@ -1114,13 +1116,11 @@ contains call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & vel_L_rms, c_L) - call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & vel_R_rms, c_R) !> The computation of c_avg does not require all the variables, and therefore the non '_avg' ! variables are placeholders to call the subroutine. - call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & vel_avg_rms, c_avg) @@ -1133,15 +1133,27 @@ contains ! COMPUTING THE DIRECT WAVE SPEEDS if (wave_speeds == 1) then - s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) - s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) + if (hypoelasticity) then + s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) + s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) - s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & - (s_L - vel_L(dir_idx(1))) - & - rho_R*vel_R(dir_idx(1))* & - (s_R - vel_R(dir_idx(1)))) & - /(rho_L*(s_L - vel_L(dir_idx(1))) - & - rho_R*(s_R - vel_R(dir_idx(1)))) + s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & + tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & + rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & + rho_R*(s_R - vel_R(idx1))) + else + s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) + s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) + + s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))*& + (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & + /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) + + end if elseif (wave_speeds == 2) then pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(dir_idx(1)) - & @@ -1716,6 +1728,7 @@ contains H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R + if (avg_state == 2) then !$acc loop seq do i = 1, nb @@ -1833,7 +1846,6 @@ contains !> The computation of c_avg does not require all the variables, and therefore the non '_avg' ! variables are placeholders to call the subroutine. - call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & vel_avg_rms, c_avg) From 262019b95f998f39a47081c5ec6c8694432e210c Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 3 Jul 2024 16:14:38 -0500 Subject: [PATCH 210/380] ported the mass and volume fraction equations in Riemann HLLC for 6-equations --- src/simulation/m_riemann_solvers.fpp | 73 ++++++++++++++++------------ 1 file changed, 42 insertions(+), 31 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index dff331356a..23f80a6154 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -1118,7 +1118,6 @@ contains vel_L_rms, c_L) call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & vel_R_rms, c_R) - !> The computation of c_avg does not require all the variables, and therefore the non '_avg' ! variables are placeholders to call the subroutine. call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & @@ -1176,17 +1175,46 @@ contains (rho_avg*c_avg)) end if + ! follows Einfeldt et al. + ! s_M/P = min/max(0.,s_L/R) + s_M = min(0d0, s_L); s_P = max(0d0, s_R) + + ! goes with q_star_L/R = xi_L/R * (variable) + ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) ) + xi_L = (s_L - vel_L(dir_idx(1)))/(s_L - s_S) + xi_R = (s_R - vel_R(dir_idx(1)))/(s_R - s_S) + + ! goes with numerical velocity in x/y/z directions + ! xi_P/M = 0.5 +/m sgn(0.5,s_star) + xi_M = (5d-1 + sign(5d-1, s_S)) + xi_P = (5d-1 - sign(5d-1, s_S)) + ! COMPUTING FLUXES + + ! MASS. + !$acc loop seq + do i = 1, contxe + flux_rs${XYZ}$_vf(j, k, l, i) = & + xi_M*alpha_rho_L(i) & + *(vel_L(dir_idx(1)) + s_M*(xi_L - 1d0)) & + + xi_P*alpha_rho_R(i) & + *(vel_R(dir_idx(1)) + s_P*(xi_R - 1d0)) + end do + + ! Volume fraction flux + !$acc loop seq + do i = advxb, advxe + flux_rs${XYZ}$_vf(j, k, l, i) = & + xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & + *(vel_L(idx1) + s_M*(xi_L - 1d0)) & + + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & + *(vel_R(idx1) + s_P*(xi_R - 1d0)) + end do + if (s_L >= 0d0) then p_Star = pres_L ! Only useful to recalculate the radial momentum geometric source flux !$acc loop seq do i = 1, num_fluids - flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & - qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)*s_S - - flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & - qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)*vel_L(dir_idx(1)) - flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & (gammas(i)*pres_L + pi_infs(i)) + & @@ -1215,12 +1243,6 @@ contains ! Only useful to recalculate the radial momentum geometric source flux !$acc loop seq do i = 1, num_fluids - flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & - qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)*s_S - - flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & - qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)*vel_R(dir_idx(1)) - flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & (qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)* & (gammas(i)*pres_R + pi_infs(i)) + & @@ -1255,12 +1277,6 @@ contains p_K_Star = (pres_L + pi_infs(i)/(1d0 + gammas(i)))* & xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & - qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)*s_S - - flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & - qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)*xi_L*s_S - flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & (gammas(i)*p_K_Star + pi_infs(i)) + & @@ -1299,12 +1315,6 @@ contains p_K_Star = (pres_R + pi_infs(i)/(1d0 + gammas(i)))* & xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & - qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)*s_S - - flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & - qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)*xi_R*s_S - flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & (qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)* & (gammas(i)*p_K_Star + pi_infs(i)) + & @@ -1314,11 +1324,11 @@ contains !$acc loop seq do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = rho_Star*s_S* & - (s_S*dir_flg(dir_idx(i)) + vel_R(dir_idx(i))*(1d0 - dir_flg(dir_idx(i)))) + & + (s_S*dir_flg(dir_idx(i)) + vel_R(dir_idx(i))*(1d0 - dir_flg(dir_idx(i)))) + & dir_flg(dir_idx(i))*p_Star vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & - dir_flg(dir_idx(i))*(s_S*xi_R - vel_R(dir_idx(i))) + dir_flg(dir_idx(i))*(s_S*xi_R - vel_R(dir_idx(i))) ! Compute the star velocities for the non-conservative terms end do @@ -1357,6 +1367,7 @@ contains end do end do end do + elseif (model_eqns == 4) then !ME4 !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) @@ -2300,6 +2311,7 @@ contains xi_M = (5d-1 + sign(5d-1, s_S)) xi_P = (5d-1 - sign(5d-1, s_S)) + ! COMPUTING THE HLLC FLUXES !$acc loop seq do i = 1, contxe flux_rs${XYZ}$_vf(j, k, l, i) = & @@ -2316,8 +2328,7 @@ contains idxi = dir_idx(i) if (hypoelasticity) then flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & - xi_M*(rho_L*(vel_L(idx1)* & - vel_L(idxi) + & + xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi) + & s_M*(xi_L*(dir_flg(idxi)*s_S + & (1d0 - dir_flg(idxi))* & vel_L(idxi)) - vel_L(idxi))) + & @@ -2328,7 +2339,7 @@ contains (1d0 - dir_flg(idxi))* & vel_R(idxi)) - vel_R(idxi))) + & dir_flg(idxi)*(pres_R) - tau_e_R(dir_idx_tau(i))) - else !SGR added this if statement for hypo + else flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & xi_M*(rho_L*(vel_L(idx1)* & vel_L(idxi) + & @@ -2343,7 +2354,6 @@ contains vel_R(idxi)) - vel_R(idxi)))+ & dir_flg(idxi)*(pres_R)) end if - ! if (j==0) print*, 'flux_rs_vf', flux_rs_vf(cont_idx%end+dir_idx(i))%sf(j,k,l) end do ! Energy flux. @@ -2377,6 +2387,7 @@ contains (rho_R*s_S + pres_R/ & (s_R - vel_R(idx1)))) - E_R)) end if + ! Volume fraction flux !$acc loop seq do i = advxb, advxe From 65538ebbf60b2c61bd5d4d4e1fec9be4d9758388 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 3 Jul 2024 16:27:56 -0500 Subject: [PATCH 211/380] added the momentum flux from HLLC 5-equations to HLLC 6-equations, moving to energy --- src/simulation/m_riemann_solvers.fpp | 55 ++++++++++++++++++++-------- 1 file changed, 39 insertions(+), 16 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 23f80a6154..07df931082 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -1201,7 +1201,42 @@ contains *(vel_R(dir_idx(1)) + s_P*(xi_R - 1d0)) end do - ! Volume fraction flux + ! MOMENTUM FLUX. + ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w) + !$acc loop seq + do i = 1, num_dims + idxi = dir_idx(i) + if (hypoelasticity) then + flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & + xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi) + & + s_M*(xi_L*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))* & + vel_L(idxi)) - vel_L(idxi))) + & + dir_flg(idxi)*(pres_L) - tau_e_L(dir_idx_tau(i))) & + + xi_P*(rho_R*(vel_R(idx1)* & + vel_R(idxi) + & + s_P*(xi_R*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))* & + vel_R(idxi)) - vel_R(idxi))) + & + dir_flg(idxi)*(pres_R) - tau_e_R(dir_idx_tau(i))) + else + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & + xi_M*(rho_L*(vel_L(idx1)* & + vel_L(idxi) + & + s_M*(xi_L*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))* & + vel_L(idxi)) - vel_L(idxi))) + & + dir_flg(idxi)*(pres_L)) & + + xi_P*(rho_R*(vel_R(idx1)* & + vel_R(idxi) + & + s_P*(xi_R*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))* & + vel_R(idxi)) - vel_R(idxi)))+ & + dir_flg(idxi)*(pres_R)) + end if + end do + + ! VOLUME FRACTION. !$acc loop seq do i = advxb, advxe flux_rs${XYZ}$_vf(j, k, l, i) = & @@ -1223,9 +1258,6 @@ contains end do !$acc loop seq do i = 1, num_dims - flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & - rho_L*vel_L(dir_idx(1))*vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*pres_L - vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & dir_flg(dir_idx(i))*(s_S - vel_L(dir_idx(i))) ! Compute the star velocities for the non-conservative terms @@ -1251,9 +1283,6 @@ contains end do !$acc loop seq do i = 1, num_dims - flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & - rho_R*vel_R(dir_idx(1))*vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*pres_R - vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & dir_flg(dir_idx(i))*(s_S - vel_R(dir_idx(i))) ! Compute the star velocities for the non-conservative terms @@ -1285,10 +1314,6 @@ contains end do !$acc loop seq do i = 1, num_dims - flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & - rho_Star*s_S*(s_S*dir_flg(dir_idx(i)) + vel_L(dir_idx(i))* & - (1d0 - dir_flg(dir_idx(i)))) + dir_flg(dir_idx(i))*p_Star - vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & dir_flg(dir_idx(i))*(s_S*xi_L - vel_L(dir_idx(i))) ! Compute the star velocities for the non-conservative terms @@ -1323,10 +1348,6 @@ contains end do !$acc loop seq do i = 1, num_dims - flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = rho_Star*s_S* & - (s_S*dir_flg(dir_idx(i)) + vel_R(dir_idx(i))*(1d0 - dir_flg(dir_idx(i)))) + & - dir_flg(dir_idx(i))*p_Star - vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & dir_flg(dir_idx(i))*(s_S*xi_R - vel_R(dir_idx(i))) ! Compute the star velocities for the non-conservative terms @@ -2069,7 +2090,7 @@ contains end do !$acc end parallel loop else - ! 5-EQUATION MODEL WITH HLLC, INTERFACE CAPTURING ONLY + ! TODO 5-EQUATION MODEL WITH HLLC, INTERFACE CAPTURING ONLY !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, tau_e_L, tau_e_R, G_L, G_R) copyin(is1,is2,is3) do l = is3%beg, is3%end @@ -2312,6 +2333,8 @@ contains xi_P = (5d-1 - sign(5d-1, s_S)) ! COMPUTING THE HLLC FLUXES + + ! Mass flux. !$acc loop seq do i = 1, contxe flux_rs${XYZ}$_vf(j, k, l, i) = & From a5899e0ec203416394c5ed1a3c5f45d4dbd7a0e4 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 3 Jul 2024 17:08:34 -0500 Subject: [PATCH 212/380] modified the energy flux for the HLLC 5-equation model including hypo --- src/simulation/m_riemann_solvers.fpp | 77 ++++++++++++---------------- 1 file changed, 33 insertions(+), 44 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 07df931082..79434a9634 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -1236,7 +1236,17 @@ contains end if end do - ! VOLUME FRACTION. + ! ENERGY FLUX. + ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) + flux_rs${XYZ}$_vf(j, k, l, E_idx) = & + xi_M*( vel_L(idx1)*(E_L + pres_L) + & + s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) + & + xi_P*(vel_R(idx1)*(E_R + pres_R) + & + s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) + + + + ! VOLUME FRACTION FLUX. !$acc loop seq do i = advxb, advxe flux_rs${XYZ}$_vf(j, k, l, i) = & @@ -1973,7 +1983,6 @@ contains ! Energy flux. ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) - flux_rs${XYZ}$_vf(j, k, l, E_idx) = & xi_M*(vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) + & s_M*(xi_L*(E_L + (s_S - vel_L(dir_idx(1)))* & @@ -2213,10 +2222,8 @@ contains tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do - G_L = 0d0 G_R = 0d0 - !$acc loop seq do i = 1, num_fluids G_L = G_L + alpha_L(i)*Gs(i) @@ -2263,19 +2270,15 @@ contains end if if (wave_speeds == 1) then if (hypoelasticity) then + s_L = min(vel_L(dir_idx(1)) - & + sqrt(c_L*c_L + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), & + vel_R(dir_idx(1)) - & + sqrt(c_R*c_R + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) + s_R = max(vel_R(dir_idx(1)) + & + sqrt(c_R*c_R + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), & + vel_L(dir_idx(1)) + & + sqrt(c_L*c_L + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) - s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + & - tau_e_L(dir_idx_tau(1)))/rho_L) & - , vel_R(dir_idx(1)) - sqrt(c_R*c_R + & - (((4d0*G_R)/3d0) + & - tau_e_R(dir_idx_tau(1)))/rho_R)) - s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & - (((4d0*G_R)/3d0) + & - tau_e_R(dir_idx_tau(1)))/rho_R) & - , vel_L(dir_idx(1)) + sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + & - tau_e_L(dir_idx_tau(1)))/rho_L)) s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)* & (s_L - vel_L(idx1)) - & @@ -2381,34 +2384,20 @@ contains ! Energy flux. ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) - if (hypoelasticity) then - flux_rs${XYZ}$_vf(j, k, l, E_idx) = & - xi_M*(vel_L(idx1)*(E_L + pres_L - tau_e_L(dir_idx_tau(1))) + & - s_M*(xi_L*(E_L + (s_S - vel_L(idx1))* & - (rho_L*s_S + (pres_L - tau_e_L(dir_idx_tau(1)))/ & - (s_L - vel_L(idx1)))) - E_L)) & - + xi_P*(vel_R(idx1)*(E_R + pres_R - tau_e_R(dir_idx_tau(1))) + & - s_P*(xi_R*(E_R + (s_S - vel_R(idx1))* & - (rho_R*s_S + (pres_R - tau_e_R(dir_idx_tau(1)))/ & - (s_R - vel_R(idx1)))) - E_R)) - if (num_dims > 1) then - !$acc loop seq - do i = 1, num_dims - 1 - flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + & - xi_M*(s_S/(s_L-s_S))*(tau_e_L(dir_idx_tau(i+1))*vel_L(dir_idx(i+1))) + & - xi_P*(s_S/(s_R-s_S))*(tau_e_R(dir_idx_tau(i+1))*vel_R(dir_idx(i+1))) - end do - end if - else ! SGR added Hypo statement to calc energy flux - flux_rs${XYZ}$_vf(j, k, l, E_idx) = & - xi_M*(vel_L(idx1)*(E_L + pres_L) + & - s_M*(xi_L*(E_L + (s_S - vel_L(idx1))* & - (rho_L*s_S + pres_L/ & - (s_L - vel_L(idx1)))) - E_L)) & - + xi_P*(vel_R(idx1)*(E_R + pres_R) + & - s_P*(xi_R*(E_R + (s_S - vel_R(idx1))* & - (rho_R*s_S + pres_R/ & - (s_R - vel_R(idx1)))) - E_R)) + flux_rs${XYZ}$_vf(j, k, l, E_idx) = & + xi_M*( vel_L(idx1)*(E_L + pres_L) + & + s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) + & + xi_P*(vel_R(idx1)*(E_R + pres_R) + & + s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) + ! Additional elastic shear stress terms for the energy flux. + if (hypoelasticity) then + do i = 1, num_dims + flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) - & + xi_M*( vel_L(idx1)*tau_e_L(dir_idx_tau(i)) + & + s_M*(xi_L*((s_S - vel_L(idx1))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(idx1)))) - E_L)) - & + xi_P*(vel_R(idx1)*tau_e_R(dir_idx_tau(i)) + & + s_P*(xi_R*((s_S - vel_R(idx1))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(idx1)))) - E_R)) + end do end if ! Volume fraction flux From e8de636e0a25760387b3279cf5072d2a794c38f8 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 3 Jul 2024 21:22:19 -0500 Subject: [PATCH 213/380] added the surface tension to HLLC 6-equation without the if statements --- src/simulation/m_riemann_solvers.fpp | 73 ++++++++++++---------------- 1 file changed, 31 insertions(+), 42 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 79434a9634..91257e3e47 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -974,6 +974,8 @@ contains do k = is2%beg, is2%end do j = is1%beg, is1%end + idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 + vel_L_rms = 0d0; vel_R_rms = 0d0 !$acc loop seq @@ -1190,8 +1192,7 @@ contains xi_P = (5d-1 - sign(5d-1, s_S)) ! COMPUTING FLUXES - - ! MASS. + ! MASS FLUX. !$acc loop seq do i = 1, contxe flux_rs${XYZ}$_vf(j, k, l, i) = & @@ -1206,7 +1207,7 @@ contains !$acc loop seq do i = 1, num_dims idxi = dir_idx(i) - if (hypoelasticity) then + if (elasticity) then flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi) + & s_M*(xi_L*(dir_flg(idxi)*s_S + & @@ -1240,11 +1241,20 @@ contains ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) flux_rs${XYZ}$_vf(j, k, l, E_idx) = & xi_M*( vel_L(idx1)*(E_L + pres_L) + & - s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) + & + s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) + & xi_P*(vel_R(idx1)*(E_R + pres_R) + & - s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) - - + s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) + ! Additional elastic shear stress terms for the energy flux + if (elasticity) then + !$acc loop seq + do i = 1, num_dims + flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) - & + xi_M*( vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & + s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & + xi_P*( vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & + s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) + end do + end if ! VOLUME FRACTION FLUX. !$acc loop seq @@ -1256,6 +1266,14 @@ contains *(vel_R(idx1) + s_P*(xi_R - 1d0)) end do + ! SURFACE TENSION FLUX. need to check + if (.not. f_is_default(sigma)) then + flux_rs${XYZ}$_vf(j, k, l, c_idx) = & + (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S + end if + + ! OLD SCHOOL HLLC if (s_L >= 0d0) then p_Star = pres_L ! Only useful to recalculate the radial momentum geometric source flux !$acc loop seq @@ -1272,12 +1290,6 @@ contains dir_flg(dir_idx(i))*(s_S - vel_L(dir_idx(i))) ! Compute the star velocities for the non-conservative terms end do - flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_L + pres_L)*vel_L(dir_idx(1)) - - if (.not. f_is_default(sigma)) then - flux_rs${XYZ}$_vf(j, k, l, c_idx) = & - qL_prim_rs${XYZ}$_vf(j, k, l, c_idx)*s_S - end if ! Compute right solution state else if (s_R <= 0d0) then @@ -1297,12 +1309,6 @@ contains dir_flg(dir_idx(i))*(s_S - vel_R(dir_idx(i))) ! Compute the star velocities for the non-conservative terms end do - flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_R + pres_R)*vel_R(dir_idx(1)) - - if (.not. f_is_default(sigma)) then - flux_rs${XYZ}$_vf(j, k, l, c_idx) = & - qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx)*s_S - end if ! Compute left star solution state else if (s_S >= 0d0) then @@ -1328,13 +1334,6 @@ contains dir_flg(dir_idx(i))*(s_S*xi_L - vel_L(dir_idx(i))) ! Compute the star velocities for the non-conservative terms end do - flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_Star + p_Star)*s_S - - if (.not. f_is_default(sigma)) then - flux_rs${XYZ}$_vf(j, k, l, c_idx) = & - qL_prim_rs${XYZ}$_vf(j, k, l, c_idx)*s_S - end if - ! Compute right star solution state else xi_R = (s_R - vel_R(dir_idx(1)))/(s_R - s_S) @@ -1362,15 +1361,7 @@ contains dir_flg(dir_idx(i))*(s_S*xi_R - vel_R(dir_idx(i))) ! Compute the star velocities for the non-conservative terms end do - - if (.not. f_is_default(sigma)) then - flux_rs${XYZ}$_vf(j, k, l, c_idx) = & - qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx)*s_S - end if - - flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_Star + p_Star)*s_S - - end if + end if flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) @@ -2352,7 +2343,7 @@ contains !$acc loop seq do i = 1, num_dims idxi = dir_idx(i) - if (hypoelasticity) then + if (elasticity) then flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi) + & s_M*(xi_L*(dir_flg(idxi)*s_S + & @@ -2393,10 +2384,10 @@ contains if (hypoelasticity) then do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) - & - xi_M*( vel_L(idx1)*tau_e_L(dir_idx_tau(i)) + & - s_M*(xi_L*((s_S - vel_L(idx1))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(idx1)))) - E_L)) - & - xi_P*(vel_R(idx1)*tau_e_R(dir_idx_tau(i)) + & - s_P*(xi_R*((s_S - vel_R(idx1))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(idx1)))) - E_R)) + xi_M*( vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & + s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & + xi_P*( vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & + s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) end do end if @@ -2435,11 +2426,9 @@ contains end do end if - flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) ! Geometrical source flux for cylindrical coordinates - #:if (NORM_DIR == 2) if (cyl_coord) then !Substituting the advective flux into the inviscid geometrical source flux From e823d6c2b3b34ace94fcaf11803f5ef2fe48eeef Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 3 Jul 2024 23:59:45 -0500 Subject: [PATCH 214/380] added the source terms fypp to HLLC 6-equations --- src/simulation/m_riemann_solvers.fpp | 127 ++++++++++++--------------- 1 file changed, 58 insertions(+), 69 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 91257e3e47..44b85755b0 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -961,21 +961,19 @@ contains flux_gsrc_vf, & norm_dir, ix, iy, iz) + idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 + #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] if (norm_dir == ${NORM_DIR}$) then - ! 6-EQUATION MODEL WITH HLLC if (model_eqns == 3) then !ME3 - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R) copyin(is1,is2,is3) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end - idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 - vel_L_rms = 0d0; vel_R_rms = 0d0 !$acc loop seq @@ -1183,8 +1181,8 @@ contains ! goes with q_star_L/R = xi_L/R * (variable) ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) ) - xi_L = (s_L - vel_L(dir_idx(1)))/(s_L - s_S) - xi_R = (s_R - vel_R(dir_idx(1)))/(s_R - s_S) + xi_L = (s_L - vel_L(idx1))/(s_L - s_S) + xi_R = (s_R - vel_R(idx1))/(s_R - s_S) ! goes with numerical velocity in x/y/z directions ! xi_P/M = 0.5 +/m sgn(0.5,s_star) @@ -1248,10 +1246,11 @@ contains if (elasticity) then !$acc loop seq do i = 1, num_dims + idxi = dir_idx(i) flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) - & - xi_M*( vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & + xi_M*( vel_L(idxi(i))*tau_e_L(dir_idx_tau(i)) + & s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & - xi_P*( vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & + xi_P*( vel_R(idxi(i))*tau_e_R(dir_idx_tau(i)) + & s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) end do end if @@ -1273,6 +1272,15 @@ contains xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S end if + ! Source for volume fraction advection equation + !$acc loop seq + do i = 1, num_dims + idxi = dir_idx(i) + vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & + xi_M*(vel_L(idxi) + dir_flg(idxi)*s_M*(xi_L - 1d0)) + & + xi_P*(vel_R(idxi) + dir_flg(idxi)*s_P*(xi_R - 1d0)) + end do + ! OLD SCHOOL HLLC if (s_L >= 0d0) then p_Star = pres_L ! Only useful to recalculate the radial momentum geometric source flux @@ -1284,13 +1292,6 @@ contains qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & qvs(i))*vel_L(dir_idx(1)) end do - !$acc loop seq - do i = 1, num_dims - vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & - dir_flg(dir_idx(i))*(s_S - vel_L(dir_idx(i))) - ! Compute the star velocities for the non-conservative terms - end do - ! Compute right solution state else if (s_R <= 0d0) then p_Star = pres_R @@ -1303,19 +1304,9 @@ contains qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)* & qvs(i))*vel_R(dir_idx(1)) end do - !$acc loop seq - do i = 1, num_dims - vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & - dir_flg(dir_idx(i))*(s_S - vel_R(dir_idx(i))) - ! Compute the star velocities for the non-conservative terms - end do - ! Compute left star solution state else if (s_S >= 0d0) then xi_L = (s_L - vel_L(dir_idx(1)))/(s_L - s_S) - rho_Star = rho_L*xi_L - E_Star = xi_L*(E_L + (s_S - vel_L(dir_idx(1)))* & - (rho_L*s_S + pres_L/(s_L - vel_L(dir_idx(1))))) p_Star = rho_L*(s_L - vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1))) + pres_L !$acc loop seq do i = 1, num_fluids @@ -1328,21 +1319,9 @@ contains qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & qvs(i))*s_S end do - !$acc loop seq - do i = 1, num_dims - vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & - dir_flg(dir_idx(i))*(s_S*xi_L - vel_L(dir_idx(i))) - ! Compute the star velocities for the non-conservative terms - end do ! Compute right star solution state else xi_R = (s_R - vel_R(dir_idx(1)))/(s_R - s_S) - - rho_Star = rho_R*xi_R - - E_Star = xi_R*(E_R + (s_S - vel_R(dir_idx(1)))* & - (rho_R*s_S + pres_R/(s_R - vel_R(dir_idx(1))))) - p_Star = rho_R*(s_R - vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1))) + pres_R !$acc loop seq do i = 1, num_fluids @@ -1355,36 +1334,49 @@ contains qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)* & qvs(i))*s_S end do - !$acc loop seq - do i = 1, num_dims - vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & - dir_flg(dir_idx(i))*(s_S*xi_R - vel_R(dir_idx(i))) - ! Compute the star velocities for the non-conservative terms - end do end if - flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) + flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) + + ! Geometrical source flux for cylindrical coordinates + #:if (NORM_DIR == 2) + if (cyl_coord) then + !Substituting the advective flux into the inviscid geometrical source flux + !$acc loop seq + do i = 1, E_idx + flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) + end do + !$acc loop seq + do i = intxb, intxe + flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) + end do + ! Recalculating the radial momentum geometric source flux (subtracting the pressure part) + flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + idx1) = & + flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + idx1) - p_Star + ! Geometrical source of the void fraction(s) is zero + !$acc loop seq + do i = advxb, advxe + flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 + end do + end if + #:endif - ! Geometrical source flux for cylindrical coordinates - if (cyl_coord .and. norm_dir == 2) then - ! Substituting the advective flux into the inviscid geometrical source flux - !$acc loop seq - do i = 1, E_idx - flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) - end do - !$acc loop seq - do i = intxb, intxe - flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) - end do - ! Recalculating the radial momentum geometric source flux (subtracting the pressure part) - flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & - flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star - ! Geometrical source of the void fraction(s) is zero - !$acc loop seq - do i = advxb, advxe - flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 - end do - end if + #:if (NORM_DIR == 3) + if (grid_geometry == 3) then + !$acc loop seq + do i = 1, sys_size + flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 + end do + flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb + 1) = & + -xi_M*(rho_L*(vel_L(idx1)*vel_L(idx1) + s_M*(xi_L*(dir_flg(idx1)*s_S + & + (1d0 - dir_flg(idx1))*vel_L(idx1)) - vel_L(idx1)))) & + -xi_P*(rho_R*(vel_R(idx1)*vel_R(idx1) + s_P*(xi_R*(dir_flg(idx1)*s_S + & + (1d0 - dir_flg(idx1))*vel_R(idx1)) - vel_R(idx1)))) + + flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) + + end if + #:endif end do end do @@ -2091,14 +2083,10 @@ contains !$acc end parallel loop else ! TODO 5-EQUATION MODEL WITH HLLC, INTERFACE CAPTURING ONLY - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, tau_e_L, tau_e_R, G_L, G_R) copyin(is1,is2,is3) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end - - idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 - !$acc loop seq do i = 1, num_fluids alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) @@ -2381,7 +2369,8 @@ contains xi_P*(vel_R(idx1)*(E_R + pres_R) + & s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) ! Additional elastic shear stress terms for the energy flux. - if (hypoelasticity) then + if (hypoelasticity) then + !$acc loop seq do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) - & xi_M*( vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & From f1039ac037a17d9c8dd14c8448e0d3c6d2b1d66b Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 4 Jul 2024 11:42:42 -0500 Subject: [PATCH 215/380] added the axisymmetric source term --- src/simulation/m_riemann_solvers.fpp | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 44b85755b0..46be022d96 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -1306,7 +1306,6 @@ contains end do ! Compute left star solution state else if (s_S >= 0d0) then - xi_L = (s_L - vel_L(dir_idx(1)))/(s_L - s_S) p_Star = rho_L*(s_L - vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1))) + pres_L !$acc loop seq do i = 1, num_fluids @@ -1321,7 +1320,6 @@ contains end do ! Compute right star solution state else - xi_R = (s_R - vel_R(dir_idx(1)))/(s_R - s_S) p_Star = rho_R*(s_R - vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1))) + pres_R !$acc loop seq do i = 1, num_fluids @@ -1336,7 +1334,7 @@ contains end do end if - flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) + flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) ! Geometrical source flux for cylindrical coordinates #:if (NORM_DIR == 2) @@ -1350,9 +1348,12 @@ contains do i = intxb, intxe flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) end do - ! Recalculating the radial momentum geometric source flux (subtracting the pressure part) + ! Recalculating the radial momentum geometric source flux flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + idx1) = & - flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + idx1) - p_Star + xi_M*(rho_L*(vel_L(idx1)*vel_L(idx1) + s_M*(xi_L*(dir_flg(idx1)*s_S + & + (1d0 - dir_flg(idx1))*vel_L(idx1)) - vel_L(idx1)))) + & + xi_P*(rho_R*(vel_R(idx1)*vel_R(idx1) + s_P*(xi_R*(dir_flg(idx1)*s_S + & + (1d0 - dir_flg(idx1))*vel_R(idx1)) - vel_R(idx1)))) ! Geometrical source of the void fraction(s) is zero !$acc loop seq do i = advxb, advxe From 95869b8dc079eaf535b45f40bc912d0a6d56db49 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 4 Jul 2024 14:03:13 -0500 Subject: [PATCH 216/380] added internal energies fluxes, finished HLLC 6-equation with hypo congruent with the HLLC 5-equation formulation --- src/simulation/m_riemann_solvers.fpp | 117 +++++++++------------------ 1 file changed, 37 insertions(+), 80 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 46be022d96..1fba9a6af5 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -913,6 +913,7 @@ contains real(kind(0d0)) :: s_L, s_R, s_M, s_P, s_S real(kind(0d0)) :: xi_L, xi_R !< Left and right wave speeds functions real(kind(0d0)) :: xi_M, xi_P + real(kind(0d0)) :: xi_MP, xi_PP real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R real(kind(0d0)) :: G_L, G_R @@ -933,7 +934,7 @@ contains real(kind(0d0)) :: vel_L_rms, vel_R_rms, vel_avg_rms real(kind(0d0)) :: blkmod1, blkmod2 - real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star + real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star, vel_K_Star real(kind(0d0)) :: pres_SL, pres_SR, Ms_L, Ms_R real(kind(0d0)) :: start, finish integer :: i, j, k, l, q !< Generic loop iterators @@ -1184,11 +1185,16 @@ contains xi_L = (s_L - vel_L(idx1))/(s_L - s_S) xi_R = (s_R - vel_R(idx1))/(s_R - s_S) - ! goes with numerical velocity in x/y/z directions + ! goes with numerical star velocity in x/y/z directions ! xi_P/M = 0.5 +/m sgn(0.5,s_star) xi_M = (5d-1 + sign(5d-1, s_S)) xi_P = (5d-1 - sign(5d-1, s_S)) + ! goes with the numerical velocity in x/y/z directions + ! xi_P/M (pressure) = min/max(0. sgn(1,sL/sR)) + xi_MP = max(0d0, sign(1d0, s_L)) + xi_PP = min(0d0, sign(1d0, s_R)) + ! COMPUTING FLUXES ! MASS FLUX. !$acc loop seq @@ -1207,31 +1213,20 @@ contains idxi = dir_idx(i) if (elasticity) then flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & - xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi) + & - s_M*(xi_L*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))* & - vel_L(idxi)) - vel_L(idxi))) + & - dir_flg(idxi)*(pres_L) - tau_e_L(dir_idx_tau(i))) & - + xi_P*(rho_R*(vel_R(idx1)* & - vel_R(idxi) + & - s_P*(xi_R*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))* & - vel_R(idxi)) - vel_R(idxi))) + & - dir_flg(idxi)*(pres_R) - tau_e_R(dir_idx_tau(i))) + xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi) + s_M*(xi_L*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))*vel_L(idxi)) - vel_L(idxi))) + & + dir_flg(idxi)*(pres_L) - tau_e_L(dir_idx_tau(i))) + & + xi_P*(rho_R*(vel_R(idx1)*vel_R(idxi) + s_P*(xi_R*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))*vel_R(idxi)) - vel_R(idxi))) + & + dir_flg(idxi)*(pres_R) - tau_e_R(dir_idx_tau(i))) else flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & - xi_M*(rho_L*(vel_L(idx1)* & - vel_L(idxi) + & - s_M*(xi_L*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))* & - vel_L(idxi)) - vel_L(idxi))) + & - dir_flg(idxi)*(pres_L)) & - + xi_P*(rho_R*(vel_R(idx1)* & - vel_R(idxi) + & - s_P*(xi_R*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))* & - vel_R(idxi)) - vel_R(idxi)))+ & - dir_flg(idxi)*(pres_R)) + xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi) + s_M*(xi_L*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))*vel_L(idxi)) - vel_L(idxi))) + & + dir_flg(idxi)*(pres_L)) + & + xi_P*(rho_R*(vel_R(idx1)*vel_R(idxi) + s_P*(xi_R*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))*vel_R(idxi)) - vel_R(idxi)))+ & + dir_flg(idxi)*(pres_R)) end if end do @@ -1272,7 +1267,7 @@ contains xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S end if - ! Source for volume fraction advection equation + ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. !$acc loop seq do i = 1, num_dims idxi = dir_idx(i) @@ -1281,58 +1276,22 @@ contains xi_P*(vel_R(idxi) + dir_flg(idxi)*s_P*(xi_R - 1d0)) end do - ! OLD SCHOOL HLLC - if (s_L >= 0d0) then - p_Star = pres_L ! Only useful to recalculate the radial momentum geometric source flux - !$acc loop seq - do i = 1, num_fluids - flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & - (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & - (gammas(i)*pres_L + pi_infs(i)) + & - qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & - qvs(i))*vel_L(dir_idx(1)) - end do - ! Compute right solution state - else if (s_R <= 0d0) then - p_Star = pres_R - ! Only useful to recalculate the radial momentum geometric source flux - !$acc loop seq - do i = 1, num_fluids - flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & - (qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)* & - (gammas(i)*pres_R + pi_infs(i)) + & - qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)* & - qvs(i))*vel_R(dir_idx(1)) - end do - ! Compute left star solution state - else if (s_S >= 0d0) then - p_Star = rho_L*(s_L - vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1))) + pres_L - !$acc loop seq - do i = 1, num_fluids - p_K_Star = (pres_L + pi_infs(i)/(1d0 + gammas(i)))* & - xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - - flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & - (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & - (gammas(i)*p_K_Star + pi_infs(i)) + & - qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & - qvs(i))*s_S - end do - ! Compute right star solution state - else - p_Star = rho_R*(s_R - vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1))) + pres_R - !$acc loop seq - do i = 1, num_fluids - p_K_Star = (pres_R + pi_infs(i)/(1d0 + gammas(i)))* & - xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - - flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & - (qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)* & - (gammas(i)*p_K_Star + pi_infs(i)) + & - qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)* & - qvs(i))*s_S - end do - end if + ! K-th pressure and velocity in preparation for the internal energy + p_K_Star = xi_M*(xi_MP*((pres_L + pi_infs(i)/(1d0 + gammas(i)))* & + xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i))-pres_L)+pres_L)+ & + xi_P*(xi_PP*((pres_R + pi_infs(i)/(1d0 + gammas(i)))* & + xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i))-pres_R)+pres_R) + vel_K_Star = xi_M*(xi_MP*(vel_L(dir_idx(1))-s_S) + s_S) + & + xi_R*(xi_PP*(vel_R(dir_idx(1))-s_S) + s_S) + ! INTERNAL ENERGIES ADVECTION FLUX. + !$acc loop seq + do i = 1, num_fluids + flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & + (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & + (gammas(i)*p_K_Star + pi_infs(i)) + & + qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & + qvs(i))*vel_K_Star + end do flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) @@ -1361,7 +1320,6 @@ contains end do end if #:endif - #:if (NORM_DIR == 3) if (grid_geometry == 3) then !$acc loop seq @@ -1375,7 +1333,6 @@ contains (1d0 - dir_flg(idx1))*vel_R(idx1)) - vel_R(idx1)))) flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) - end if #:endif From 05dd99039e24447dbc8f6a5af5cb5542870f3da5 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 4 Jul 2024 18:53:26 -0500 Subject: [PATCH 217/380] fixed OpenACC issues --- src/simulation/m_riemann_solvers.fpp | 12 ++++++------ submit_test.sh | 4 ++-- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 1fba9a6af5..b9efa46e73 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -1200,10 +1200,10 @@ contains !$acc loop seq do i = 1, contxe flux_rs${XYZ}$_vf(j, k, l, i) = & - xi_M*alpha_rho_L(i) & - *(vel_L(dir_idx(1)) + s_M*(xi_L - 1d0)) & - + xi_P*alpha_rho_R(i) & - *(vel_R(dir_idx(1)) + s_P*(xi_R - 1d0)) + xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & + *(vel_L(idx1) + s_M*(xi_L - 1d0)) & + + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & + *(vel_R(idx1) + s_P*(xi_R - 1d0)) end do ! MOMENTUM FLUX. @@ -1243,9 +1243,9 @@ contains do i = 1, num_dims idxi = dir_idx(i) flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) - & - xi_M*( vel_L(idxi(i))*tau_e_L(dir_idx_tau(i)) + & + xi_M*( vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & - xi_P*( vel_R(idxi(i))*tau_e_R(dir_idx_tau(i)) + & + xi_P*( vel_R(idxi)*tau_e_R(dir_idx_tau(i)) + & s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) end do end if diff --git a/submit_test.sh b/submit_test.sh index a80f79f755..4b291fb05c 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -1,7 +1,7 @@ #!/bin/bash -./mfc.sh run ./tests/C5B79059/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run ./tests/C5B79059/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +./mfc.sh run ./tests/2F35A1FE/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run ./tests/2F35A1FE/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta From 83d6eaf2b9548b666e3aace36ebbf27ee8ea9817 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 5 Jul 2024 00:42:53 -0500 Subject: [PATCH 218/380] testing more existing test cases using submit script --- submit_test.sh | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/submit_test.sh b/submit_test.sh index 4b291fb05c..fe9aaa8878 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -1,7 +1,17 @@ #!/bin/bash -./mfc.sh run ./tests/2F35A1FE/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run ./tests/2F35A1FE/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +./mfc.sh run ./tests/DA8AF07E/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run ./tests/DA8AF07E/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +./mfc.sh run ./tests/6F296065/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run ./tests/6F296065/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +./mfc.sh run ./tests/D3C860B9/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run ./tests/D3C860B9/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta + +./mfc.sh run ./tests/DA8AF07E/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run ./tests/DA8AF07E/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +./mfc.sh run ./tests/18431ACB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run ./tests/18431ACB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta + #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta From ec4f0b196c7353c601c1824d14e110aaf7f0597a Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 5 Jul 2024 15:18:57 -0500 Subject: [PATCH 219/380] fully added hypoelasticity to HLLC 5- and 6-equation models, streamlined computations --- src/simulation/m_riemann_solvers.fpp | 230 +++++++++++---------------- submit_test.sh | 23 +-- 2 files changed, 110 insertions(+), 143 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index b9efa46e73..b85c666a11 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -1047,31 +1047,24 @@ contains !$acc loop seq do i = 1, 2 Re_L(i) = dflt_real - if (Re_size(i) > 0) Re_L(i) = 0d0 - !$acc loop seq do q = 1, Re_size(i) Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + Re_L(i) end do - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) - end do !$acc loop seq do i = 1, 2 Re_R(i) = dflt_real - if (Re_size(i) > 0) Re_R(i) = 0d0 - !$acc loop seq do q = 1, Re_size(i) Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + Re_R(i) end do - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) end do end if @@ -1086,26 +1079,22 @@ contains tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do - - G_L = 0d0 - G_R = 0d0 - + G_L = 0d0; G_R = 0d0 !$acc loop seq do i = 1, num_fluids G_L = G_L + alpha_L(i)*Gs(i) G_R = G_R + alpha_R(i)*Gs(i) end do - do i = 1, strxe - strxb + 1 ! Elastic contribution to energy if G large enough if ((G_L > verysmall) .and. (G_R > verysmall)) then E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) ! Additional terms in 2D and 3D - if ((i == 2) .or. (i == 4) .or. (i == 5)) then - E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) - E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) - end if + if ((i == 2) .or. (i == 4) .or. (i == 5)) then + E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) + E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) + end if end if end do end if @@ -1199,49 +1188,41 @@ contains ! MASS FLUX. !$acc loop seq do i = 1, contxe - flux_rs${XYZ}$_vf(j, k, l, i) = & - xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & - *(vel_L(idx1) + s_M*(xi_L - 1d0)) & - + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & - *(vel_R(idx1) + s_P*(xi_R - 1d0)) + flux_rs${XYZ}$_vf(j, k, l, i) = & + xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) end do ! MOMENTUM FLUX. - ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w) + ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) !$acc loop seq do i = 1, num_dims - idxi = dir_idx(i) - if (elasticity) then - flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & - xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi) + s_M*(xi_L*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))*vel_L(idxi)) - vel_L(idxi))) + & - dir_flg(idxi)*(pres_L) - tau_e_L(dir_idx_tau(i))) + & - xi_P*(rho_R*(vel_R(idx1)*vel_R(idxi) + s_P*(xi_R*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))*vel_R(idxi)) - vel_R(idxi))) + & - dir_flg(idxi)*(pres_R) - tau_e_R(dir_idx_tau(i))) - else - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & - xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi) + s_M*(xi_L*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))*vel_L(idxi)) - vel_L(idxi))) + & - dir_flg(idxi)*(pres_L)) + & - xi_P*(rho_R*(vel_R(idx1)*vel_R(idxi) + s_P*(xi_R*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))*vel_R(idxi)) - vel_R(idxi)))+ & - dir_flg(idxi)*(pres_R)) - end if + idxi = dir_idx(i) + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & + xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi)+s_M*(xi_L*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))*vel_L(idxi))-vel_L(idxi))) + dir_flg(idxi)*(pres_L)) + & + xi_P*(rho_R*(vel_R(idx1)*vel_R(idxi)+s_P*(xi_R*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))*vel_R(idxi))-vel_R(idxi))) + dir_flg(idxi)*(pres_R)) end do ! ENERGY FLUX. - ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) + ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) flux_rs${XYZ}$_vf(j, k, l, E_idx) = & xi_M*( vel_L(idx1)*(E_L + pres_L) + & s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) + & xi_P*(vel_R(idx1)*(E_R + pres_R) + & s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) - ! Additional elastic shear stress terms for the energy flux + + ! Additional elastic shear stress terms for the momentum and energy flux if (elasticity) then !$acc loop seq do i = 1, num_dims idxi = dir_idx(i) + ! MOMENTUM ELASTIC FLUX. + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & + -xi_M*tau_e_L(dir_idx_tau(i))-xi_P*tau_e_R(dir_idx_tau(i)) + ! ENERGY ELASTIC FLUX. flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) - & xi_M*( vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & @@ -1250,6 +1231,16 @@ contains end do end if + ! HYPOELASTIC STRESS EVOLUTION FLUX. + if (hypoelasticity) then + !$acc loop seq + do i = 1, strxe - strxb + 1 + flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & + xi_M*(s_S/(s_L-s_S))*(s_L*rho_L*tau_e_L(i)-rho_L*vel_L(idx1)*tau_e_L(i)) + & + xi_P*(s_S/(s_R-s_S))*(s_R*rho_R*tau_e_R(i)-rho_R*vel_R(idx1)*tau_e_R(i)) + end do + end if + ! VOLUME FRACTION FLUX. !$acc loop seq do i = advxb, advxe @@ -1260,6 +1251,15 @@ contains *(vel_R(idx1) + s_P*(xi_R - 1d0)) end do + ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. + !$acc loop seq + do i = 1, num_dims + idxi = dir_idx(i) + vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & + xi_M*(vel_L(idxi) + dir_flg(idxi)*s_M*(xi_L - 1d0)) + & + xi_P*(vel_R(idxi) + dir_flg(idxi)*s_P*(xi_R - 1d0)) + end do + ! SURFACE TENSION FLUX. need to check if (.not. f_is_default(sigma)) then flux_rs${XYZ}$_vf(j, k, l, c_idx) = & @@ -1267,23 +1267,14 @@ contains xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S end if - ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. - !$acc loop seq - do i = 1, num_dims - idxi = dir_idx(i) - vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & - xi_M*(vel_L(idxi) + dir_flg(idxi)*s_M*(xi_L - 1d0)) + & - xi_P*(vel_R(idxi) + dir_flg(idxi)*s_P*(xi_R - 1d0)) - end do - - ! K-th pressure and velocity in preparation for the internal energy + ! INTERNAL ENERGIES ADVECTION FLUX. + ! K-th pressure and velocity in preparation for the internal energy flux p_K_Star = xi_M*(xi_MP*((pres_L + pi_infs(i)/(1d0 + gammas(i)))* & xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i))-pres_L)+pres_L)+ & xi_P*(xi_PP*((pres_R + pi_infs(i)/(1d0 + gammas(i)))* & xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i))-pres_R)+pres_R) vel_K_Star = xi_M*(xi_MP*(vel_L(dir_idx(1))-s_S) + s_S) + & xi_R*(xi_PP*(vel_R(dir_idx(1))-s_S) + s_S) - ! INTERNAL ENERGIES ADVECTION FLUX. !$acc loop seq do i = 1, num_fluids flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & @@ -1293,10 +1284,10 @@ contains qvs(i))*vel_K_Star end do - flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) + flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) - ! Geometrical source flux for cylindrical coordinates - #:if (NORM_DIR == 2) + ! Geometrical source flux for cylindrical coordinates + #:if (NORM_DIR == 2) if (cyl_coord) then !Substituting the advective flux into the inviscid geometrical source flux !$acc loop seq @@ -1319,8 +1310,8 @@ contains flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 end do end if - #:endif - #:if (NORM_DIR == 3) + #:endif + #:if (NORM_DIR == 3) if (grid_geometry == 3) then !$acc loop seq do i = 1, sys_size @@ -1334,7 +1325,7 @@ contains flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) end if - #:endif + #:endif end do end do @@ -2121,31 +2112,24 @@ contains !$acc loop seq do i = 1, 2 Re_L(i) = dflt_real - if (Re_size(i) > 0) Re_L(i) = 0d0 - !$acc loop seq do q = 1, Re_size(i) Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + Re_L(i) end do - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) - end do !$acc loop seq do i = 1, 2 Re_R(i) = dflt_real - if (Re_size(i) > 0) Re_R(i) = 0d0 - !$acc loop seq do q = 1, Re_size(i) Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + Re_R(i) end do - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) end do end if @@ -2159,8 +2143,7 @@ contains tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do - G_L = 0d0 - G_R = 0d0 + G_L = 0d0; G_R = 0d0 !$acc loop seq do i = 1, num_fluids G_L = G_L + alpha_L(i)*Gs(i) @@ -2274,107 +2257,88 @@ contains ! COMPUTING THE HLLC FLUXES - ! Mass flux. + ! MASS FLUX. !$acc loop seq do i = 1, contxe flux_rs${XYZ}$_vf(j, k, l, i) = & - xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & - *(vel_L(idx1) + s_M*(xi_L - 1d0)) & - + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & - *(vel_R(idx1) + s_P*(xi_R - 1d0)) + xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) end do - ! Momentum flux. - ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w) + ! MOMENTUM FLUX. + ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) !$acc loop seq do i = 1, num_dims - idxi = dir_idx(i) - if (elasticity) then - flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & - xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi) + & - s_M*(xi_L*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))* & - vel_L(idxi)) - vel_L(idxi))) + & - dir_flg(idxi)*(pres_L) - tau_e_L(dir_idx_tau(i))) & - + xi_P*(rho_R*(vel_R(idx1)* & - vel_R(idxi) + & - s_P*(xi_R*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))* & - vel_R(idxi)) - vel_R(idxi))) + & - dir_flg(idxi)*(pres_R) - tau_e_R(dir_idx_tau(i))) - else - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & - xi_M*(rho_L*(vel_L(idx1)* & - vel_L(idxi) + & - s_M*(xi_L*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))* & - vel_L(idxi)) - vel_L(idxi))) + & - dir_flg(idxi)*(pres_L)) & - + xi_P*(rho_R*(vel_R(idx1)* & - vel_R(idxi) + & - s_P*(xi_R*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))* & - vel_R(idxi)) - vel_R(idxi)))+ & - dir_flg(idxi)*(pres_R)) - end if + idxi = dir_idx(i) + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & + xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi)+s_M*(xi_L*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))*vel_L(idxi))-vel_L(idxi))) + dir_flg(idxi)*(pres_L)) + & + xi_P*(rho_R*(vel_R(idx1)*vel_R(idxi)+s_P*(xi_R*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))*vel_R(idxi))-vel_R(idxi))) + dir_flg(idxi)*(pres_R)) end do - ! Energy flux. - ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) + ! ENERGY FLUX. + ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) flux_rs${XYZ}$_vf(j, k, l, E_idx) = & xi_M*( vel_L(idx1)*(E_L + pres_L) + & s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) + & xi_P*(vel_R(idx1)*(E_R + pres_R) + & s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) + ! Additional elastic shear stress terms for the energy flux. - if (hypoelasticity) then + if (elasticity) then !$acc loop seq do i = 1, num_dims + idxi = dir_idx(i) + ! MOMENTUM ELASTIC FLUX. + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & + -xi_M*tau_e_L(dir_idx_tau(i))-xi_P*tau_e_R(dir_idx_tau(i)) + ! ENERGY ELASTIC FLUX. flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) - & - xi_M*( vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & + xi_M*( vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & - xi_P*( vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & + xi_P*( vel_R(idxi)*tau_e_R(dir_idx_tau(i)) + & s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) end do end if - ! Volume fraction flux + ! HYPOELASTIC STRESS EVOLUTION FLUX. + if (hypoelasticity) then + !$acc loop seq + do i = 1, strxe - strxb + 1 + flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & + xi_M*(s_S/(s_L-s_S))*(s_L*rho_L*tau_e_L(i)-rho_L*vel_L(idx1)*tau_e_L(i)) + & + xi_P*(s_S/(s_R-s_S))*(s_R*rho_R*tau_e_R(i)-rho_R*vel_R(idx1)*tau_e_R(i)) + end do + end if + + ! VOLUME FRACTION FLUX. !$acc loop seq do i = advxb, advxe flux_rs${XYZ}$_vf(j, k, l, i) = & - xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & - *(vel_L(idx1) + s_M*(xi_L - 1d0)) & - + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & - *(vel_R(idx1) + s_P*(xi_R - 1d0)) + xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) *(vel_L(idx1) + s_M*(xi_L - 1d0)) + & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) end do - ! Source for volume fraction advection equation + ! VOLUME FRACTION SOURCE FLUX. !$acc loop seq do i = 1, num_dims idxi = dir_idx(i) vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & - xi_M*(vel_L(idxi) + & - dir_flg(idxi)* & - s_M*(xi_L - 1d0)) & - + xi_P*(vel_R(idxi) + & - dir_flg(idxi)* & - s_P*(xi_R - 1d0)) - - !if ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0d0 + xi_M*(vel_L(idxi) + dir_flg(idxi)*s_M*(xi_L - 1d0)) + & + xi_P*(vel_R(idxi) + dir_flg(idxi)*s_P*(xi_R - 1d0)) end do - ! Elastic Stresses - if (hypoelasticity) then - !$acc loop seq - do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow - flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & - xi_M*(s_S/(s_L-s_S))*(s_L*rho_L*tau_e_L(i)-rho_L*vel_L(dir_idx(1))*tau_e_L(i)) + & - xi_P*(s_S/(s_R-s_S))*(s_R*rho_R*tau_e_R(i)-rho_R*vel_R(dir_idx(1))*tau_e_R(i)) - end do - end if - flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) + ! SURFACE TENSION FLUX. need to check + if (.not. f_is_default(sigma)) then + flux_rs${XYZ}$_vf(j, k, l, c_idx) = & + (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S + end if + ! Geometrical source flux for cylindrical coordinates #:if (NORM_DIR == 2) if (cyl_coord) then diff --git a/submit_test.sh b/submit_test.sh index fe9aaa8878..1868a3e1aa 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -1,16 +1,19 @@ #!/bin/bash -./mfc.sh run ./tests/DA8AF07E/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run ./tests/DA8AF07E/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -./mfc.sh run ./tests/6F296065/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run ./tests/6F296065/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -./mfc.sh run ./tests/D3C860B9/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run ./tests/D3C860B9/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +./mfc.sh run ./tests/AED93D34/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run ./tests/AED93D34/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -./mfc.sh run ./tests/DA8AF07E/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run ./tests/DA8AF07E/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -./mfc.sh run ./tests/18431ACB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run ./tests/18431ACB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run ./tests/DA8AF07E/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run ./tests/DA8AF07E/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run ./tests/6F296065/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run ./tests/6F296065/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run ./tests/D3C860B9/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run ./tests/D3C860B9/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta + +#./mfc.sh run ./tests/DA8AF07E/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run ./tests/DA8AF07E/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run ./tests/18431ACB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run ./tests/18431ACB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta From 584c1b24141cbdeefd0ab09f8525d2b241973f42 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 5 Jul 2024 15:44:27 -0500 Subject: [PATCH 220/380] added hyperelasticity speed to HLLC + 6-equation --- src/simulation/m_riemann_solvers.fpp | 55 +++++++++++++++------------- 1 file changed, 30 insertions(+), 25 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index b85c666a11..eabe6a43ef 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -438,31 +438,24 @@ contains !$acc loop seq do i = 1, 2 Re_L(i) = dflt_real - if (Re_size(i) > 0) Re_L(i) = 0d0 - !$acc loop seq do q = 1, Re_size(i) Re_L(i) = alpha_L(Re_idx(i, q))/Res(i, q) & + Re_L(i) end do - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) - end do !$acc loop seq do i = 1, 2 Re_R(i) = dflt_real - if (Re_size(i) > 0) Re_R(i) = 0d0 - !$acc loop seq do q = 1, Re_size(i) Re_R(i) = alpha_R(Re_idx(i, q))/Res(i, q) & + Re_R(i) end do - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) end do end if @@ -472,22 +465,15 @@ contains ! elastic energy update if (hypoelasticity) then - !$acc loop seq - do i = 1, strxe - strxb + 1 - tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) - end do - - G_L = 0d0 - G_R = 0d0 - + G_L = 0d0; G_R = 0d0 !$acc loop seq do i = 1, num_fluids G_L = G_L + alpha_L(i)*Gs(i) G_R = G_R + alpha_R(i)*Gs(i) end do - do i = 1, strxe - strxb + 1 + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ! Elastic contribution to energy if G large enough !TODO take out if statement if stable without if ((G_L > 1000) .and. (G_R > 1000)) then @@ -1072,7 +1058,7 @@ contains E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R - ! ADJUSTMENTS FOR ELASTIC ENERGY + ! ADJUSTMENTS FOR HYPOELASTIC ENERGY if (hypoelasticity) then !$acc loop seq do i = 1, strxe - strxb + 1 @@ -1099,6 +1085,31 @@ contains end do end if + ! ADJUSTMENTS FOR HYPERELASTIC ENERGY + if (hyperelasticity) then + G_L = 0d0; G_R = 0d0; + !$acc loop seq + do i = 1, num_fluids + ! Mixture left and right shear modulus + G_L = G_L + alpha_L(i)*Gs(i) + G_R = G_R + alpha_R(i)*Gs(i) + ! Left and right \xi fields + xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) + xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) + end do + ! Elastic contribution to energy if G large enough + if (G_L < verysmall) G_L = 0d0; + if (G_R < verysmall) G_R = 0d0; + E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) + E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) + !$acc loop seq + do i = 1, b_size-1 + tau_e_L(i) = 0d0; tau_e_R(i) = 0d0; + !tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + !tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + end do + end if + H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -1129,7 +1140,6 @@ contains s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) - s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & @@ -1137,7 +1147,6 @@ contains else s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) - s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))*& (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) @@ -1147,19 +1156,15 @@ contains pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(dir_idx(1)) - & vel_R(dir_idx(1)))) - pres_SR = pres_SL - Ms_L = max(1d0, sqrt(1d0 + ((5d-1 + gamma_L)/(1d0 + gamma_L))* & (pres_SL/pres_L - 1d0)*pres_L/ & ((pres_L + pi_inf_L/(1d0 + gamma_L))))) Ms_R = max(1d0, sqrt(1d0 + ((5d-1 + gamma_R)/(1d0 + gamma_R))* & (pres_SR/pres_R - 1d0)*pres_R/ & ((pres_R + pi_inf_R/(1d0 + gamma_R))))) - s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R - s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & (pres_L - pres_R)/ & (rho_avg*c_avg)) @@ -1213,7 +1218,7 @@ contains xi_P*(vel_R(idx1)*(E_R + pres_R) + & s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) - ! Additional elastic shear stress terms for the momentum and energy flux + ! ELASTICITY. Elastic shear stress terms for the momentum and energy flux if (elasticity) then !$acc loop seq do i = 1, num_dims From 78d0a40a3a69897f3f04fa2264447f5ffb998644 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 6 Jul 2024 11:27:48 -0400 Subject: [PATCH 221/380] partially debugged HLLC implementation, hypo and riemann is working, need phase change --- src/simulation/m_riemann_solvers.fpp | 48 +++++++++++++++------------- 1 file changed, 25 insertions(+), 23 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index eabe6a43ef..db691d15c2 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -948,11 +948,13 @@ contains flux_gsrc_vf, & norm_dir, ix, iy, iz) - idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] if (norm_dir == ${NORM_DIR}$) then + + idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 + ! 6-EQUATION MODEL WITH HLLC if (model_eqns == 3) then !ME3 @@ -1186,8 +1188,8 @@ contains ! goes with the numerical velocity in x/y/z directions ! xi_P/M (pressure) = min/max(0. sgn(1,sL/sR)) - xi_MP = max(0d0, sign(1d0, s_L)) - xi_PP = min(0d0, sign(1d0, s_R)) + xi_MP = -min(0d0,sign(1d0,s_L)) + xi_PP = max(0d0,sign(1d0,s_R)); ! COMPUTING FLUXES ! MASS FLUX. @@ -1213,10 +1215,11 @@ contains ! ENERGY FLUX. ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) flux_rs${XYZ}$_vf(j, k, l, E_idx) = & - xi_M*( vel_L(idx1)*(E_L + pres_L) + & - s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) + & - xi_P*(vel_R(idx1)*(E_R + pres_R) + & - s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) + xi_M*(vel_L(idx1)*(E_L + pres_L) + & + s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & + + xi_P*(vel_R(idx1)*(E_R + pres_R) + & + s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) + ! ELASTICITY. Elastic shear stress terms for the momentum and energy flux if (elasticity) then @@ -1249,11 +1252,9 @@ contains ! VOLUME FRACTION FLUX. !$acc loop seq do i = advxb, advxe - flux_rs${XYZ}$_vf(j, k, l, i) = & - xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & - *(vel_L(idx1) + s_M*(xi_L - 1d0)) & - + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & - *(vel_R(idx1) + s_P*(xi_R - 1d0)) + flux_rs${XYZ}$_vf(j, k, l, i) = & + xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*s_S + & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*s_S end do ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. @@ -1274,19 +1275,20 @@ contains ! INTERNAL ENERGIES ADVECTION FLUX. ! K-th pressure and velocity in preparation for the internal energy flux - p_K_Star = xi_M*(xi_MP*((pres_L + pi_infs(i)/(1d0 + gammas(i)))* & - xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i))-pres_L)+pres_L)+ & - xi_P*(xi_PP*((pres_R + pi_infs(i)/(1d0 + gammas(i)))* & - xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i))-pres_R)+pres_R) - vel_K_Star = xi_M*(xi_MP*(vel_L(dir_idx(1))-s_S) + s_S) + & - xi_R*(xi_PP*(vel_R(dir_idx(1))-s_S) + s_S) + vel_K_Star = vel_L(idx1)*(1d0-xi_MP) + xi_MP*vel_R(idx1) + & + xi_MP*xi_PP*(s_S-vel_R(idx1)) !$acc loop seq do i = 1, num_fluids - flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & - (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & - (gammas(i)*p_K_Star + pi_infs(i)) + & - qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & - qvs(i))*vel_K_Star + p_K_Star = xi_M*(xi_MP*((pres_L + pi_infs(i)/(1d0 + gammas(i)))* & + xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i))-pres_L)+pres_L)+ & + xi_P*(xi_PP*((pres_R + pi_infs(i)/(1d0 + gammas(i)))* & + xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i))-pres_R)+pres_R) + + flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & + (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & + (gammas(i)*p_K_Star + pi_infs(i)) + & + qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & + qvs(i))*vel_K_Star end do flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) From deba134a8ae802764bbd6570a71d1b0a913d7666 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 6 Jul 2024 17:29:33 -0400 Subject: [PATCH 222/380] debugged HLLC + hypo + 6-equation, testing on Delta GPU --- src/simulation/m_riemann_solvers.fpp | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index db691d15c2..e0938310b7 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -1135,7 +1135,7 @@ contains ! COMPUTING THE DIRECT WAVE SPEEDS if (wave_speeds == 1) then - if (hypoelasticity) then + if (elasticity) then s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) @@ -1189,7 +1189,7 @@ contains ! goes with the numerical velocity in x/y/z directions ! xi_P/M (pressure) = min/max(0. sgn(1,sL/sR)) xi_MP = -min(0d0,sign(1d0,s_L)) - xi_PP = max(0d0,sign(1d0,s_R)); + xi_PP = max(0d0,sign(1d0,s_R)) ! COMPUTING FLUXES ! MASS FLUX. @@ -1262,8 +1262,8 @@ contains do i = 1, num_dims idxi = dir_idx(i) vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & - xi_M*(vel_L(idxi) + dir_flg(idxi)*s_M*(xi_L - 1d0)) + & - xi_P*(vel_R(idxi) + dir_flg(idxi)*s_P*(xi_R - 1d0)) + xi_M*(vel_L(idxi)+dir_flg(idxi)*(s_S*(xi_MP*(xi_L-1) + 1)-vel_L(idxi))) + & + xi_P*(vel_R(idxi)+dir_flg(idxi)*(s_S*(xi_PP*(xi_R-1) + 1)-vel_R(idxi))) end do ! SURFACE TENSION FLUX. need to check @@ -1293,6 +1293,12 @@ contains flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) + ! correction pressure for the cylindrical terms + p_Star = xi_M*( pres_L + xi_MP*rho_L*(s_L - & + vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1)))) + & + xi_P*( pres_R + xi_PP*rho_R*(s_R - & + vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1)))) + ! Geometrical source flux for cylindrical coordinates #:if (NORM_DIR == 2) if (cyl_coord) then @@ -1306,11 +1312,8 @@ contains flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) end do ! Recalculating the radial momentum geometric source flux - flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + idx1) = & - xi_M*(rho_L*(vel_L(idx1)*vel_L(idx1) + s_M*(xi_L*(dir_flg(idx1)*s_S + & - (1d0 - dir_flg(idx1))*vel_L(idx1)) - vel_L(idx1)))) + & - xi_P*(rho_R*(vel_R(idx1)*vel_R(idx1) + s_P*(xi_R*(dir_flg(idx1)*s_S + & - (1d0 - dir_flg(idx1))*vel_R(idx1)) - vel_R(idx1)))) + flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & + flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star ! Geometrical source of the void fraction(s) is zero !$acc loop seq do i = advxb, advxe @@ -1324,11 +1327,8 @@ contains do i = 1, sys_size flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 end do - flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb + 1) = & - -xi_M*(rho_L*(vel_L(idx1)*vel_L(idx1) + s_M*(xi_L*(dir_flg(idx1)*s_S + & - (1d0 - dir_flg(idx1))*vel_L(idx1)) - vel_L(idx1)))) & - -xi_P*(rho_R*(vel_R(idx1)*vel_R(idx1) + s_P*(xi_R*(dir_flg(idx1)*s_S + & - (1d0 - dir_flg(idx1))*vel_R(idx1)) - vel_R(idx1)))) + flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & + flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) end if From 0299298489d967d4d802ea390402f59e50c9dfdc Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 6 Jul 2024 19:24:29 -0400 Subject: [PATCH 223/380] added 3D ctr midterm test case for simulations --- examples/3D_ctr_test/case.py | 399 ++++++++++++++++++++++++++++++++++ src/common/m_phase_change.fpp | 4 +- submit_test.sh | 17 +- 3 files changed, 404 insertions(+), 16 deletions(-) create mode 100644 examples/3D_ctr_test/case.py diff --git a/examples/3D_ctr_test/case.py b/examples/3D_ctr_test/case.py new file mode 100644 index 0000000000..1630f1c7f2 --- /dev/null +++ b/examples/3D_ctr_test/case.py @@ -0,0 +1,399 @@ +#!/usr/bin/env python3 +import math, json + +## 1 FOR BACKGROUND, 2 FOR BUBBLE, 3 FOR GEL +# Pressure [Pa] +p01 = 5E6 +p02 = 3550 +p03 = p01 + +# Temperature [K] +T01 = 298.15 +T02 = 298.15 +T03 = T01 + +#### FLUID PROPERTIES #### + +### liquid water ### +# pi infty +piwl = 1.0E+09 +# qv +qvwl = -1167000 +# qv' +qvpwl = 0.0E0 +# cv +cvwl = 1816 +# cp +cpwl = 4267 +# gamma +gamwl = cpwl / cvwl + +## FOR PATCHES 1 & 2 ## + +# density +rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) +rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) +rho0wl3 = (p03 + piwl)/((gamwl-1)*cvwl*T03) + +# speed of sound FOR +c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) +c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) +c_wl3 = math.sqrt( gamwl * ( p03 + piwl ) / rho0wl3 ) + +# part for Gases - relations from IMR +Ru = 8.3144598 # Universal gas constant (J/mol-K) + +### Vapor water ### +Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) +# gamma +gamwv = 1.4 +# cp +cpwv = Rv * gamwv/(gamwv-1) +# cv +cvwv = cpwv/gamwv +# pi infinity +piwv = 0.0E0 +# qv +qvwv = 2030000 +# qv' +qvpwv = -23400 + +## FOR PATCHES 1 & 2 ## + +# density +rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) +rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) +rho0wv3 = (p03 + piwv)/((gamwv-1)*cvwv*T03) + +# speed of sound +c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) +c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) +c_wv3 = math.sqrt( gamwv * ( p03 + piwv ) / rho0wv3 ) + +### Air ### + +Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) +gamwa = 1.4 +# cp +cpa = Ra * gamwa/(gamwa-1) +# cv +cva = cpa/gamwa +# pi infinity +pia = 0.0E0 +# qv +qvwa = 0.0E0 +# qv' +qvpwa = 0.0E0 + +## FOR PATCHES 1 & 2 ## + +# density +rho0wa1 = (p01 + pia)/((gamwa-1)*cva*T01) +rho0wa2 = (p02 + pia)/((gamwa-1)*cva*T02) + +# Speed of sound +c_a1 = math.sqrt( gamwa * ( p01 + pia ) / rho0wa1 ) +c_a2 = math.sqrt( gamwa * ( p02 + pia ) / rho0wa2 ) + +### 3% polyacrylamide gel ### + +# gamma +gamwg = 2.35 +# pi infty +pig = 1.1754E+09 +# qv +qvwg = 0.0E0 +# qv' +qvpwg = 0.0E0 +# cv +cvg = cvwl +# cp +cpg = gamwg*cvg + +## FOR PATCHES 1 & 2 & 3 ## + +# density +rho0wg1 = (p01 + pig)/((gamwg-1)*cvg*T01) +rho0wg2 = (p02 + pig)/((gamwg-1)*cvg*T02) +rho0wg3 = (p03 + pig)/((gamwg-1)*cvg*T03) + +# Speed of sound +c_g1 = math.sqrt( gamwg * ( p01 + pig ) / rho0wg1 ) +c_g2 = math.sqrt( gamwg * ( p02 + pig ) / rho0wg2 ) +c_g3 = math.sqrt( gamwg * ( p03 + pig ) / rho0wg3 ) + +## SHOCK RELATIONS +p02Op01 = p02 / p01 + +# Mach number of the shocked region - this should agree with Min, if everything is correct +Ms = math.sqrt( ( gamwa + 1. ) / ( 2. * gamwa ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) + +# shock speed +ss = Ms * c_a1 + +### volume fractions for each of the patches ### +C0 = 0.25 # vapor concentration for IMR + +# patch 1: liquid water +liq_wv = 1.00E-15 +liq_wg = 1.00E-15 +liq_wa = 1.00E-15 +liq_wl = 1.00E00 - liq_wv - liq_wa - liq_wg +# water vapor +vap_wl = 1.00E-15 +vap_wv = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0wa2 + 1 ) +vap_wg = 1.00E-15 +vap_wa = 1.00E-15 +vap_tot = vap_wl + vap_wv + vap_wa + vap_wg +# bub +bub_wl = 1.00E-15 +bub_wv = vap_tot +bub_wg = 1.00E-15 +bub_wa = 1.00E00 - bub_wl - bub_wv - bub_wg +# gel +gel_wv = 1.00E-15 +gel_wl = 1.00E-15 +gel_wa = 1.00E-15 +gel_wg = 1.00E00 - gel_wl - gel_wv - gel_wa + +## SIMULATION PARAMETERS + +# CFL +cfl = 0.50 + +# Bubble Initial Radius +R0 = 30E-6 #230.4E-06 + +# number of elements +Nx0 = 400 +Nx = 199*2 +Ny = 199 +Nz = 199 + +# domain boundaries +xb = -120E-6 +xe = 120E-6 + +yb = 0.00 +ye = 120E-6 + +zb = 0.00 +ze = 120E-6 + +lenx = ( xe - xb ) +leny = ( ye - yb ) +lenz = ( ze - zb ) + +xcenl = (xb + xe)/2.0 +ycenl = (yb + ye)/2.0 +zcenl = (zb + ze)/2.0 + +#xdist = 6.51E-10 #2.17E-5 +#sod = xdist/R0 +sod = -2.17 +xcenb = sod*R0 +ycenb = 0.00 +zcenb = 0.00 + +xbg = 0 +xeg = xe + +lenxg = (xeg - xbg) +lenyg = leny +lenzg = lenz +xceng = (xbg + xeg)/2.0 +yceng = ycenl +zceng = zcenl + +# typical cell size +dx = ( xe - xb ) / Nx +dy = ( ye - yb ) / Ny +dz = ( ze - zb ) / Nz +#print(dx) +# time step + +# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) +SF = 200 + +# Critical time-step +tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) + +# making Nt divisible by SF +# tendA = 1.5 * tc +tend = 1.2 * tc + +# 1 - ensure NtA is sufficient to go a little beyond tendA +# NtA = int( tendA // dt + 1 ) + +# Array of saves. it is the same as Nt/Sf = t_step_save +# AS = int( NtA // SF + 1 ) + +# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) +# Nt = AS * SF +Nt = int(10E3 * tend // tc * Nx / Nx0 + 1) +#print(Nt) +dt = tend / Nt + +AS = int( Nt//SF ) + +# Total physical time +# tend = Nt * dt + +# Configuring case dictionary ================================================== +print(json.dumps({ + # Logistics ================================================ + 'run_time_info': 'T', + # ========================================================== + # Computational Domain Parameters ========================== + 'x_domain%beg' : xb, + 'x_domain%end' : xe, + 'y_domain%beg' : yb, + 'y_domain%end' : ye, + 'z_domain%beg' : zb, + 'z_domain%end' : ze, + 'stretch_x' : 'F', + 'loops_x' : 1, + 'a_x' : 4.0E0, + 'x_a' : -2.0*R0, + 'x_b' : 2.0*R0, + 'stretch_y' : 'F', + 'loops_y' : 1, + 'a_y' : 4.0E0, + 'y_a' : -2.0*R0, + 'y_b' : 2.0*R0, + 'stretch_z' : 'F', + 'loops_z' : 1, + 'a_z' : 4.0E0, + 'z_a' : -2.0*R0, + 'z_b' : 2.0*R0, + 'cyl_coord' : 'F', + 'm' : Nx, + 'n' : Ny, + 'p' : Nz, + 'dt' : dt, + 't_step_start' : 0, + 't_step_stop' : Nt, + 't_step_save' : AS, + # ========================================================== + # Simulation Algorithm Parameters ========================== + 'num_patches' : 3, + 'model_eqns' : 3, + 'num_fluids' : 4, + 'adv_alphan' : 'T', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'relax' : 'T', + 'relax_model' : 6, + 'palpha_eps' : 1.0E-6, + 'ptgalpha_eps' : 1.0E-2, + 'time_stepper' : 3, + 'weno_order' : 3, + 'weno_eps' : 1.0E-16, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'F', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -6, #-2, + 'bc_x%end' : -6, + 'bc_y%beg' : -2, + 'bc_y%end' : -6, + 'bc_z%beg' : -2, + 'bc_z%end' : -6, + # ========================================================== + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt':'T', + 'parallel_io' :'T', + # ========================================================== + # Patch 1: High pressured water ============================ + # Specify the cubic water background grid geometry + 'patch_icpp(1)%geometry' : 9, + 'patch_icpp(1)%x_centroid' : xcenl, + 'patch_icpp(1)%y_centroid' : ycenl, + 'patch_icpp(1)%z_centroid' : zcenl, + 'patch_icpp(1)%length_x' : lenx, + 'patch_icpp(1)%length_y' : leny, + 'patch_icpp(1)%length_z' : lenz, + 'patch_icpp(1)%vel(1)' : 0.0E+00, + 'patch_icpp(1)%vel(2)' : 0.0E+00, + 'patch_icpp(1)%vel(3)' : 0.0E+00, + 'patch_icpp(1)%pres' : p01, + 'patch_icpp(1)%alpha_rho(1)' : liq_wl * rho0wl1, + 'patch_icpp(1)%alpha_rho(2)' : liq_wv * rho0wv1, + 'patch_icpp(1)%alpha_rho(3)' : liq_wa * rho0wa1, + 'patch_icpp(1)%alpha_rho(4)' : liq_wg * rho0wg1, + 'patch_icpp(1)%alpha(1)' : liq_wl, + 'patch_icpp(1)%alpha(2)' : liq_wv, + 'patch_icpp(1)%alpha(3)' : liq_wa, + 'patch_icpp(1)%alpha(4)' : liq_wg, + # ========================================================== + # Patch 2: (Vapor) Bubble ================================== + 'patch_icpp(2)%geometry' : 8, + 'patch_icpp(2)%x_centroid' : xcenb, + 'patch_icpp(2)%y_centroid' : ycenb, + 'patch_icpp(2)%z_centroid' : zcenb, + 'patch_icpp(2)%radius' : R0, + 'patch_icpp(2)%vel(1)' : 0.0E+00, + 'patch_icpp(2)%vel(2)' : 0.0E+00, + 'patch_icpp(2)%vel(3)' : 0.0E+00, + 'patch_icpp(2)%pres' : p02, + 'patch_icpp(2)%alpha_rho(1)' : bub_wl * rho0wl2, + 'patch_icpp(2)%alpha_rho(2)' : bub_wv * rho0wv2, + 'patch_icpp(2)%alpha_rho(3)' : bub_wa * rho0wa2, + 'patch_icpp(2)%alpha_rho(4)' : bub_wg * rho0wg2, + 'patch_icpp(2)%alpha(1)' : bub_wl, + 'patch_icpp(2)%alpha(2)' : bub_wv, + 'patch_icpp(2)%alpha(3)' : bub_wa, + 'patch_icpp(2)%alpha(4)' : bub_wg, + 'patch_icpp(2)%alter_patch(1)' : 'T', + # ========================================================== + # Patch 3: Gel Object ====================================== + 'patch_icpp(3)%geometry' : 9, + 'patch_icpp(3)%x_centroid' : xceng, + 'patch_icpp(3)%y_centroid' : yceng, + 'patch_icpp(3)%z_centroid' : zceng, + 'patch_icpp(3)%length_x' : lenxg, + 'patch_icpp(3)%length_y' : lenyg, + 'patch_icpp(3)%length_z' : lenzg, + 'patch_icpp(3)%vel(1)' : 0.0E+00, + 'patch_icpp(3)%vel(2)' : 0.0E+00, + 'patch_icpp(3)%vel(3)' : 0.0E+00, + 'patch_icpp(3)%pres' : p03, + 'patch_icpp(3)%alpha_rho(1)' : gel_wl * rho0wl2, + 'patch_icpp(3)%alpha_rho(2)' : gel_wv * rho0wv2, + 'patch_icpp(3)%alpha_rho(3)' : gel_wa * rho0wa2, + 'patch_icpp(3)%alpha_rho(4)' : gel_wg * rho0wg2, + 'patch_icpp(3)%alpha(1)' : gel_wl, + 'patch_icpp(3)%alpha(2)' : gel_wv, + 'patch_icpp(3)%alpha(3)' : gel_wa, + 'patch_icpp(3)%alpha(4)' : gel_wg, + 'patch_icpp(3)%alter_patch(1)' : 'T', + # ========================================================== + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), + 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), + 'fluid_pp(1)%cv' : cvwl, + 'fluid_pp(1)%qv' : qvwl, + 'fluid_pp(1)%qvp' : qvpwl, + 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), + 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), + 'fluid_pp(2)%cv' : cvwv, + 'fluid_pp(2)%qv' : qvwv, + 'fluid_pp(2)%qvp' : qvpwv, + 'fluid_pp(3)%gamma' : 1.0E+00 / ( gamwa - 1 ), + 'fluid_pp(3)%pi_inf' : gamwa * pia / ( gamwa - 1 ), + 'fluid_pp(3)%cv' : cva, + 'fluid_pp(3)%qv' : qvwa, + 'fluid_pp(3)%qvp' : qvpwa, + 'fluid_pp(4)%gamma' : 1.0E+00 / ( gamwg - 1), + 'fluid_pp(4)%pi_inf' : gamwg * pig / ( gamwg - 1), + 'fluid_pp(4)%cv' : cvg, + 'fluid_pp(4)%qv' : qvwg, + 'fluid_pp(4)%qvp' : qvpwg, + # ========================================================== +})) diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 1c6a7acdf0..884ed8f842 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -358,7 +358,7 @@ contains ns = 0 ! change this relative error metric. 1E4 is arbitrary do while ((DABS(pS - pO) > palpha_eps) .and. & - (DABS((pS - pO)/pO) > palpha_eps/1d4) .or. (ns == 0)) + (DABS((pS - pO)/pO) > palpha_eps/1d1) .or. (ns == 0)) ! increasing counter ns = ns + 1 @@ -448,7 +448,7 @@ contains R2D(1) = 0.0d0; R2D(2) = 0.0d0 DeltamP(1) = 0.0d0; DeltamP(2) = 0.0d0 do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & - .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) & + .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d1))) & .or. (ns == 0)) ! Updating counter for the iterative procedure diff --git a/submit_test.sh b/submit_test.sh index 1868a3e1aa..6db0de57bc 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -1,19 +1,8 @@ #!/bin/bash -./mfc.sh run ./tests/AED93D34/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run ./tests/AED93D34/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta - -#./mfc.sh run ./tests/DA8AF07E/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run ./tests/DA8AF07E/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -#./mfc.sh run ./tests/6F296065/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run ./tests/6F296065/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -#./mfc.sh run ./tests/D3C860B9/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run ./tests/D3C860B9/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta - -#./mfc.sh run ./tests/DA8AF07E/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run ./tests/DA8AF07E/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -#./mfc.sh run ./tests/18431ACB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run ./tests/18431ACB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 16 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar +./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 16 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta From b1d02af0b143b92bee04e3bf517a9995a7362543 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 6 Jul 2024 19:46:51 -0500 Subject: [PATCH 224/380] added CTR test case for midterm review --- examples/3D_ctr_test/case.py | 36 +- examples/3D_ctr_test/old_case.py | 399 ++++++++++++++++++ .../{casefile.py => case.py} | 0 src/common/m_phase_change.fpp | 4 +- submit_test.sh | 10 +- 5 files changed, 426 insertions(+), 23 deletions(-) create mode 100644 examples/3D_ctr_test/old_case.py rename examples/3D_phasechange_bubble/{casefile.py => case.py} (100%) diff --git a/examples/3D_ctr_test/case.py b/examples/3D_ctr_test/case.py index 1630f1c7f2..aac9ec367a 100644 --- a/examples/3D_ctr_test/case.py +++ b/examples/3D_ctr_test/case.py @@ -96,17 +96,16 @@ c_a2 = math.sqrt( gamwa * ( p02 + pia ) / rho0wa2 ) ### 3% polyacrylamide gel ### - # gamma gamwg = 2.35 # pi infty -pig = 1.1754E+09 +pig = 1.0E+09 # qv -qvwg = 0.0E0 +qvwg = -1167000 # qv' qvpwg = 0.0E0 # cv -cvg = cvwl +cvg = 1816 # cp cpg = gamwg*cvg @@ -132,28 +131,28 @@ ss = Ms * c_a1 ### volume fractions for each of the patches ### -C0 = 0.25 # vapor concentration for IMR +C0 = 0.5 # vapor concentration for IMR # patch 1: liquid water liq_wv = 1.00E-15 -liq_wg = 1.00E-15 +liq_wg = 0. liq_wa = 1.00E-15 liq_wl = 1.00E00 - liq_wv - liq_wa - liq_wg # water vapor vap_wl = 1.00E-15 vap_wv = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0wa2 + 1 ) -vap_wg = 1.00E-15 +vap_wg = 0. vap_wa = 1.00E-15 vap_tot = vap_wl + vap_wv + vap_wa + vap_wg # bub bub_wl = 1.00E-15 bub_wv = vap_tot -bub_wg = 1.00E-15 +bub_wg = 0. bub_wa = 1.00E00 - bub_wl - bub_wv - bub_wg # gel -gel_wv = 1.00E-15 -gel_wl = 1.00E-15 -gel_wa = 1.00E-15 +gel_wv = 0. +gel_wl = 0. +gel_wa = 0. gel_wg = 1.00E00 - gel_wl - gel_wv - gel_wa ## SIMULATION PARAMETERS @@ -162,23 +161,24 @@ cfl = 0.50 # Bubble Initial Radius -R0 = 30E-6 #230.4E-06 +R0 = 230.4E-06 # number of elements Nx0 = 400 -Nx = 199*2 +Nx = 399 Ny = 199 Nz = 199 +lref = 921.6E-6 # domain boundaries -xb = -120E-6 -xe = 120E-6 +xb = -lref +xe = lref yb = 0.00 -ye = 120E-6 +ye = lref zb = 0.00 -ze = 120E-6 +ze = lref lenx = ( xe - xb ) leny = ( ye - yb ) @@ -213,7 +213,7 @@ # time step # save frequency = SF + 1 (because the initial state, 0.dat, is also saved) -SF = 200 +SF = 60 # Critical time-step tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) diff --git a/examples/3D_ctr_test/old_case.py b/examples/3D_ctr_test/old_case.py new file mode 100644 index 0000000000..092c021366 --- /dev/null +++ b/examples/3D_ctr_test/old_case.py @@ -0,0 +1,399 @@ +#!/usr/bin/env python3 +import math, json + +## 1 FOR BACKGROUND, 2 FOR BUBBLE, 3 FOR GEL +# Pressure [Pa] +p01 = 5E6 +p02 = 3550 +p03 = p01 + +# Temperature [K] +T01 = 298.15 +T02 = 298.15 +T03 = T01 + +#### FLUID PROPERTIES #### + +### liquid water ### +# pi infty +piwl = 1.0E+09 +# qv +qvwl = -1167000 +# qv' +qvpwl = 0.0E0 +# cv +cvwl = 1816 +# cp +cpwl = 4267 +# gamma +gamwl = cpwl / cvwl + +## FOR PATCHES 1 & 2 ## + +# density +rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) +rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) +rho0wl3 = (p03 + piwl)/((gamwl-1)*cvwl*T03) + +# speed of sound FOR +c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) +c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) +c_wl3 = math.sqrt( gamwl * ( p03 + piwl ) / rho0wl3 ) + +# part for Gases - relations from IMR +Ru = 8.3144598 # Universal gas constant (J/mol-K) + +### Vapor water ### +Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) +# gamma +gamwv = 1.4 +# cp +cpwv = Rv * gamwv/(gamwv-1) +# cv +cvwv = cpwv/gamwv +# pi infinity +piwv = 0.0E0 +# qv +qvwv = 2030000 +# qv' +qvpwv = -23400 + +## FOR PATCHES 1 & 2 ## + +# density +rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) +rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) +rho0wv3 = (p03 + piwv)/((gamwv-1)*cvwv*T03) + +# speed of sound +c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) +c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) +c_wv3 = math.sqrt( gamwv * ( p03 + piwv ) / rho0wv3 ) + +### Air ### + +Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) +gamwa = 1.4 +# cp +cpa = Ra * gamwa/(gamwa-1) +# cv +cva = cpa/gamwa +# pi infinity +pia = 0.0E0 +# qv +qvwa = 0.0E0 +# qv' +qvpwa = 0.0E0 + +## FOR PATCHES 1 & 2 ## + +# density +rho0wa1 = (p01 + pia)/((gamwa-1)*cva*T01) +rho0wa2 = (p02 + pia)/((gamwa-1)*cva*T02) + +# Speed of sound +c_a1 = math.sqrt( gamwa * ( p01 + pia ) / rho0wa1 ) +c_a2 = math.sqrt( gamwa * ( p02 + pia ) / rho0wa2 ) + +### 3% polyacrylamide gel ### +# gamma +gamwg = 2.35 +# pi infty +pig = 1.0E+09 +# qv +qvwg = -1167000 +# qv' +qvpwg = 0.0E0 +# cv +cvg = 1816 +# cp +cpg = gamwg*cvg + +## FOR PATCHES 1 & 2 & 3 ## + +# density +rho0wg1 = (p01 + pig)/((gamwg-1)*cvg*T01) +rho0wg2 = (p02 + pig)/((gamwg-1)*cvg*T02) +rho0wg3 = (p03 + pig)/((gamwg-1)*cvg*T03) + +# Speed of sound +c_g1 = math.sqrt( gamwg * ( p01 + pig ) / rho0wg1 ) +c_g2 = math.sqrt( gamwg * ( p02 + pig ) / rho0wg2 ) +c_g3 = math.sqrt( gamwg * ( p03 + pig ) / rho0wg3 ) + +## SHOCK RELATIONS +p02Op01 = p02 / p01 + +# Mach number of the shocked region - this should agree with Min, if everything is correct +Ms = math.sqrt( ( gamwa + 1. ) / ( 2. * gamwa ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) + +# shock speed +ss = Ms * c_a1 + +### volume fractions for each of the patches ### +C0 = 0.1 # vapor concentration for IMR + +# patch 1: liquid water +liq_wv = 1.00E-15 +liq_wg = 1.00E-15 +liq_wa = 1.00E-15 +liq_wl = 1.00E00 - liq_wv - liq_wa - liq_wg +# water vapor +vap_wl = 1.00E-15 +vap_wv = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0wa2 + 1 ) +vap_wg = 1.00E-15 +vap_wa = 1.00E-15 +vap_tot = vap_wl + vap_wv + vap_wa + vap_wg +# bub +bub_wl = 1.00E-15 +bub_wv = vap_tot +bub_wg = 1.00E-15 +bub_wa = 1.00E00 - bub_wl - bub_wv - bub_wg +# gel +gel_wv = 1.00E-15 +gel_wl = 1.00E-15 +gel_wa = 1.00E-15 +gel_wg = 1.00E00 - gel_wl - gel_wv - gel_wa + +## SIMULATION PARAMETERS + +# CFL +cfl = 0.50 + +# Bubble Initial Radius +R0 = 230.4E-06 + +# number of elements +Nx0 = 400 +Nx = 199*2 +Ny = 199 +Nz = 199 + +lref = 921.6E-6 +# domain boundaries +xb = -lref +xe = lref + +yb = 0.00 +ye = lref + +zb = 0.00 +ze = lref + +lenx = ( xe - xb ) +leny = ( ye - yb ) +lenz = ( ze - zb ) + +xcenl = (xb + xe)/2.0 +ycenl = (yb + ye)/2.0 +zcenl = (zb + ze)/2.0 + +#xdist = 6.51E-10 #2.17E-5 +#sod = xdist/R0 +sod = -2.17 +xcenb = sod*R0 +ycenb = 0.00 +zcenb = 0.00 + +xbg = 0 +xeg = xe + +lenxg = (xeg - xbg) +lenyg = leny +lenzg = lenz +xceng = (xbg + xeg)/2.0 +yceng = ycenl +zceng = zcenl + +# typical cell size +dx = ( xe - xb ) / Nx +dy = ( ye - yb ) / Ny +dz = ( ze - zb ) / Nz +#print(dx) +# time step + +# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) +SF = 60 + +# Critical time-step +tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) + +# making Nt divisible by SF +# tendA = 1.5 * tc +tend = 1.2 * tc + +# 1 - ensure NtA is sufficient to go a little beyond tendA +# NtA = int( tendA // dt + 1 ) + +# Array of saves. it is the same as Nt/Sf = t_step_save +# AS = int( NtA // SF + 1 ) + +# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) +# Nt = AS * SF +Nt = int(10E3 * tend // tc * Nx / Nx0 + 1) +#print(Nt) +dt = tend / Nt + +AS = int( Nt//SF ) + +# Total physical time +# tend = Nt * dt + +# Configuring case dictionary ================================================== +print(json.dumps({ + # Logistics ================================================ + 'run_time_info': 'T', + # ========================================================== + # Computational Domain Parameters ========================== + 'x_domain%beg' : xb, + 'x_domain%end' : xe, + 'y_domain%beg' : yb, + 'y_domain%end' : ye, + 'z_domain%beg' : zb, + 'z_domain%end' : ze, + 'stretch_x' : 'F', + 'loops_x' : 1, + 'a_x' : 4.0E0, + 'x_a' : -2.0*R0, + 'x_b' : 2.0*R0, + 'stretch_y' : 'F', + 'loops_y' : 1, + 'a_y' : 4.0E0, + 'y_a' : -2.0*R0, + 'y_b' : 2.0*R0, + 'stretch_z' : 'F', + 'loops_z' : 1, + 'a_z' : 4.0E0, + 'z_a' : -2.0*R0, + 'z_b' : 2.0*R0, + 'cyl_coord' : 'F', + 'm' : Nx, + 'n' : Ny, + 'p' : Nz, + 'dt' : dt, + 't_step_start' : 0, + 't_step_stop' : Nt, + 't_step_save' : AS, + # ========================================================== + # Simulation Algorithm Parameters ========================== + 'num_patches' : 3, + 'model_eqns' : 3, + 'num_fluids' : 4, + 'adv_alphan' : 'T', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'relax' : 'T', + 'relax_model' : 6, + 'palpha_eps' : 1.0E-6, + 'ptgalpha_eps' : 1.0E-2, + 'time_stepper' : 3, + 'weno_order' : 3, + 'weno_eps' : 1.0E-16, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'F', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -6, #-2, + 'bc_x%end' : -6, + 'bc_y%beg' : -2, + 'bc_y%end' : -6, + 'bc_z%beg' : -2, + 'bc_z%end' : -6, + # ========================================================== + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt':'T', + 'parallel_io' :'T', + # ========================================================== + # Patch 1: High pressured water ============================ + # Specify the cubic water background grid geometry + 'patch_icpp(1)%geometry' : 9, + 'patch_icpp(1)%x_centroid' : xcenl, + 'patch_icpp(1)%y_centroid' : ycenl, + 'patch_icpp(1)%z_centroid' : zcenl, + 'patch_icpp(1)%length_x' : lenx, + 'patch_icpp(1)%length_y' : leny, + 'patch_icpp(1)%length_z' : lenz, + 'patch_icpp(1)%vel(1)' : 0.0E+00, + 'patch_icpp(1)%vel(2)' : 0.0E+00, + 'patch_icpp(1)%vel(3)' : 0.0E+00, + 'patch_icpp(1)%pres' : p01, + 'patch_icpp(1)%alpha_rho(1)' : liq_wl * rho0wl1, + 'patch_icpp(1)%alpha_rho(2)' : liq_wv * rho0wv1, + 'patch_icpp(1)%alpha_rho(3)' : liq_wa * rho0wa1, + 'patch_icpp(1)%alpha_rho(4)' : liq_wg * rho0wg1, + 'patch_icpp(1)%alpha(1)' : liq_wl, + 'patch_icpp(1)%alpha(2)' : liq_wv, + 'patch_icpp(1)%alpha(3)' : liq_wa, + 'patch_icpp(1)%alpha(4)' : liq_wg, + # ========================================================== + # Patch 2: (Vapor) Bubble ================================== + 'patch_icpp(2)%geometry' : 8, + 'patch_icpp(2)%x_centroid' : xcenb, + 'patch_icpp(2)%y_centroid' : ycenb, + 'patch_icpp(2)%z_centroid' : zcenb, + 'patch_icpp(2)%radius' : R0, + 'patch_icpp(2)%vel(1)' : 0.0E+00, + 'patch_icpp(2)%vel(2)' : 0.0E+00, + 'patch_icpp(2)%vel(3)' : 0.0E+00, + 'patch_icpp(2)%pres' : p02, + 'patch_icpp(2)%alpha_rho(1)' : bub_wl * rho0wl2, + 'patch_icpp(2)%alpha_rho(2)' : bub_wv * rho0wv2, + 'patch_icpp(2)%alpha_rho(3)' : bub_wa * rho0wa2, + 'patch_icpp(2)%alpha_rho(4)' : bub_wg * rho0wg2, + 'patch_icpp(2)%alpha(1)' : bub_wl, + 'patch_icpp(2)%alpha(2)' : bub_wv, + 'patch_icpp(2)%alpha(3)' : bub_wa, + 'patch_icpp(2)%alpha(4)' : bub_wg, + 'patch_icpp(2)%alter_patch(1)' : 'T', + # ========================================================== + # Patch 3: Gel Object ====================================== + 'patch_icpp(3)%geometry' : 9, + 'patch_icpp(3)%x_centroid' : xceng, + 'patch_icpp(3)%y_centroid' : yceng, + 'patch_icpp(3)%z_centroid' : zceng, + 'patch_icpp(3)%length_x' : lenxg, + 'patch_icpp(3)%length_y' : lenyg, + 'patch_icpp(3)%length_z' : lenzg, + 'patch_icpp(3)%vel(1)' : 0.0E+00, + 'patch_icpp(3)%vel(2)' : 0.0E+00, + 'patch_icpp(3)%vel(3)' : 0.0E+00, + 'patch_icpp(3)%pres' : p03, + 'patch_icpp(3)%alpha_rho(1)' : gel_wl * rho0wl2, + 'patch_icpp(3)%alpha_rho(2)' : gel_wv * rho0wv2, + 'patch_icpp(3)%alpha_rho(3)' : gel_wa * rho0wa2, + 'patch_icpp(3)%alpha_rho(4)' : gel_wg * rho0wg2, + 'patch_icpp(3)%alpha(1)' : gel_wl, + 'patch_icpp(3)%alpha(2)' : gel_wv, + 'patch_icpp(3)%alpha(3)' : gel_wa, + 'patch_icpp(3)%alpha(4)' : gel_wg, + 'patch_icpp(3)%alter_patch(1)' : 'T', + # ========================================================== + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), + 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), + 'fluid_pp(1)%cv' : cvwl, + 'fluid_pp(1)%qv' : qvwl, + 'fluid_pp(1)%qvp' : qvpwl, + 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), + 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), + 'fluid_pp(2)%cv' : cvwv, + 'fluid_pp(2)%qv' : qvwv, + 'fluid_pp(2)%qvp' : qvpwv, + 'fluid_pp(3)%gamma' : 1.0E+00 / ( gamwa - 1 ), + 'fluid_pp(3)%pi_inf' : gamwa * pia / ( gamwa - 1 ), + 'fluid_pp(3)%cv' : cva, + 'fluid_pp(3)%qv' : qvwa, + 'fluid_pp(3)%qvp' : qvpwa, + 'fluid_pp(4)%gamma' : 1.0E+00 / ( gamwg - 1), + 'fluid_pp(4)%pi_inf' : gamwg * pig / ( gamwg - 1), + 'fluid_pp(4)%cv' : cvg, + 'fluid_pp(4)%qv' : qvwg, + 'fluid_pp(4)%qvp' : qvpwg, + # ========================================================== +})) diff --git a/examples/3D_phasechange_bubble/casefile.py b/examples/3D_phasechange_bubble/case.py similarity index 100% rename from examples/3D_phasechange_bubble/casefile.py rename to examples/3D_phasechange_bubble/case.py diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 884ed8f842..7a8885d5b2 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -358,7 +358,7 @@ contains ns = 0 ! change this relative error metric. 1E4 is arbitrary do while ((DABS(pS - pO) > palpha_eps) .and. & - (DABS((pS - pO)/pO) > palpha_eps/1d1) .or. (ns == 0)) + (DABS((pS - pO)/pO) > palpha_eps/1d2) .or. (ns == 0)) ! increasing counter ns = ns + 1 @@ -448,7 +448,7 @@ contains R2D(1) = 0.0d0; R2D(2) = 0.0d0 DeltamP(1) = 0.0d0; DeltamP(2) = 0.0d0 do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & - .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d1))) & + .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d2))) & .or. (ns == 0)) ! Updating counter for the iterative procedure diff --git a/submit_test.sh b/submit_test.sh index 6db0de57bc..f95bcd03f7 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -1,8 +1,12 @@ #!/bin/bash -./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 16 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar -./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 16 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar +#./mfc.sh run ./examples/3D_phasechange_bubble/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run ./examples/3D_phasechange_bubble/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta + +./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta From 66a25ac2af560c906180b80b1bffd2d0ff3422bb Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 6 Jul 2024 19:58:04 -0500 Subject: [PATCH 225/380] formatted code --- src/common/m_checker_common.fpp | 8 +- src/common/m_phase_change.fpp | 2 +- src/common/m_variables_conversion.fpp | 1072 ++++++------ src/common/m_xi_tensor_calc.f90 | 1923 ++++++++++----------- src/post_process/m_data_output.fpp | 91 +- src/post_process/m_global_parameters.fpp | 12 +- src/post_process/m_start_up.f90 | 7 +- src/pre_process/include/2dHardcodedIC.fpp | 32 +- src/pre_process/m_assign_variables.f90 | 10 +- src/pre_process/m_global_parameters.fpp | 2 +- src/pre_process/m_initial_condition.fpp | 2 +- src/simulation/m_checker.fpp | 6 +- src/simulation/m_data_output.fpp | 8 +- src/simulation/m_global_parameters.fpp | 10 +- src/simulation/m_hyperelastic.f90 | 28 +- src/simulation/m_mpi_proxy.fpp | 2 +- src/simulation/m_rhs.fpp | 8 +- src/simulation/m_riemann_solvers.fpp | 362 ++-- 18 files changed, 1786 insertions(+), 1799 deletions(-) diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index a3c88d71e2..ab5df7862f 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -174,10 +174,10 @@ contains !! Called by s_check_inputs_common for pre-processing and simulation subroutine s_check_inputs_hypoelasticity !if ((model_eqns /= 2) .or. (model_eqns /= 3)) then - if ((model_eqns == 1) .or. (model_eqns == 4)) then - call s_mpi_abort('hypoelasticity requires either '// & - '5-equation (model_eqns = 2) or '// & - '6-equation model (model_eqns = 3). Exiting ...') + if ((model_eqns == 1) .or. (model_eqns == 4)) then + call s_mpi_abort('hypoelasticity requires either '// & + '5-equation (model_eqns = 2) or '// & + '6-equation model (model_eqns = 3). Exiting ...') end if end subroutine s_check_inputs_hypoelasticity diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 7a8885d5b2..e6effa17ad 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -358,7 +358,7 @@ contains ns = 0 ! change this relative error metric. 1E4 is arbitrary do while ((DABS(pS - pO) > palpha_eps) .and. & - (DABS((pS - pO)/pO) > palpha_eps/1d2) .or. (ns == 0)) + (DABS((pS - pO)/pO) > palpha_eps/1d2) .or. (ns == 0)) ! increasing counter ns = ns + 1 diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index c5c4ff9fe1..2f1dec575e 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -151,7 +151,7 @@ contains )**(1.d0/gamma + 1.d0) - pi_inf end if - if ( hypoelasticity .and. present(G)) then + if (hypoelasticity .and. present(G)) then ! calculate elastic contribution to Energy E_e = 0d0 do s = stress_idx%beg, stress_idx%end @@ -166,14 +166,14 @@ contains end if end do - pres = (energy - 0.5d0*(mom**2.d0)/rho - pi_inf - qv - E_e )/gamma + pres = (energy - 0.5d0*(mom**2.d0)/rho - pi_inf - qv - E_e)/gamma end if if (hyperelasticity .and. present(G)) then - ! calculate elastic contribution to Energy + ! calculate elastic contribution to Energy E_e = 0d0 - pres = (energy - 0.5d0*(mom**2.d0)/rho - pi_inf - qv - E_e )/gamma + pres = (energy - 0.5d0*(mom**2.d0)/rho - pi_inf - qv - E_e)/gamma end if @@ -839,7 +839,6 @@ contains ix, iy, iz, & qK_btensor_vf) - type(scalar_field), dimension(sys_size), intent(in) :: qK_cons_vf type(scalar_field), dimension(sys_size), intent(inout) :: qK_prim_vf type(scalar_field), & @@ -875,7 +874,7 @@ contains real(kind(0.d0)) :: ntmp #ifdef MFC_POST_PROCESS - type(scalar_field), dimension(b_size) :: q_btensor + type(scalar_field), dimension(b_size) :: q_btensor #endif #:if MFC_CASE_OPTIMIZATION @@ -926,7 +925,7 @@ contains end if #else ! If pre-processing, use non acc mixture subroutines - if (elasticity) then + if (elasticity) then call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) else @@ -1004,19 +1003,19 @@ contains ! subtracting elastic contribution for pressure calculation if (G_K > 1000) then !TODO: check if stable for >0 qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K + ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K ! extra terms in 2 and 3D if ((i == strxb + 1) .or. & (i == strxb + 3) .or. & (i == strxb + 4)) then qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K + ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K end if end if end do end if - !if ( hyperelasticity ) then + !if ( hyperelasticity ) then ! !$acc loop seq ! do i = xibeg, xiend ! ! qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K @@ -1037,62 +1036,62 @@ contains end do !$acc end parallel loop - !print *, 'I got here AA' + !print *, 'I got here AA' #ifdef MFC_SIMULATION - if (hyperelasticity) then - !call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf, 0, m, 0, n, 0, p) - !print *, 'I got here AAA' + if (hyperelasticity) then + !call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf, 0, m, 0, n, 0, p) + !print *, 'I got here AAA' !!$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) - !do l = izb, ize - ! do k = iyb, iye - ! do j = ixb, ixe + !do l = izb, ize + ! do k = iyb, iye + ! do j = ixb, ixe !!$acc loop seq - !do i = 1, num_fluids - ! alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) - ! alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) - !end do - ! If in simulation, use acc mixture subroutines - !call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & - ! alpha_rho_K, Re_K, j, k, l, G_K, Gs) - !rho_K = max(rho_K, sgm_eps) - !if (G_K > 1d-3) then - ! qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & - !G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K - !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) - !end if - ! end do - ! end do - !end do + !do i = 1, num_fluids + ! alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) + ! alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) + !end do + ! If in simulation, use acc mixture subroutines + !call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & + ! alpha_rho_K, Re_K, j, k, l, G_K, Gs) + !rho_K = max(rho_K, sgm_eps) + !if (G_K > 1d-3) then + ! qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & + !G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K + !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) + !end if + ! end do + ! end do + !end do !!$acc end parallel loop end if #endif #ifdef MFC_POST_PROCESS do l = 1, b_size - allocate(q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) + allocate (q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) end do - if (hyperelasticity) then - call s_calculate_btensor(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) - do l = 0, p - do k = 0, n - do j = 0, m - do i = 1, num_fluids - alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) - alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) + if (hyperelasticity) then + call s_calculate_btensor(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) + do l = 0, p + do k = 0, n + do j = 0, m + do i = 1, num_fluids + alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) + alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) + end do + ! If pre-processing, use non acc mixture subroutines + !call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & + ! rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) + !if ( G_K > 1000 ) then + ! !qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) ! - & + ! !G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K + !end if end do - ! If pre-processing, use non acc mixture subroutines - !call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & - ! rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) - !if ( G_K > 1000 ) then - ! !qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) ! - & - ! !G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K - !end if - end do - end do - end do - end if + end do + end do + end if #endif end subroutine s_convert_conservative_to_primitive_variables ! --------- @@ -1135,8 +1134,8 @@ contains ! going through hyperelasticity again due to the btensor calculation ! s_calculate_btensor has its own triple nested for loop, with openacc !if (hyperelasticity) then - !call s_calculate_btensor(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) - !end if + !call s_calculate_btensor(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) + !end if ! Converting the primitive variables to the conservative variables do l = 0, p @@ -1234,13 +1233,13 @@ contains ! adding elastic contribution if (G > 1000) then q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) + (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) ! extra terms in 2 and 3D if ((i == stress_idx%beg + 1) .or. & (i == stress_idx%beg + 3) .or. & (i == stress_idx%beg + 4)) then q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) + (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) end if end if end do @@ -1248,15 +1247,15 @@ contains ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 !if (hyperelasticity) then - ! adding the elastic contribution - !do i = xibeg, xiend - !q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) - !end do - !if (G > 1000) then - !q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - ! G*f_elastic_energy(q_btensor, j, k, l) - !end if - !end if + ! adding the elastic contribution + !do i = xibeg, xiend + !q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) + !end do + !if (G > 1000) then + !q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & + ! G*f_elastic_energy(q_btensor, j, k, l) + !end if + !end if if (.not. f_is_default(sigma)) then q_cons_vf(c_idx)%sf(j, k, l) = q_prim_vf(c_idx)%sf(j, k, l) @@ -1264,7 +1263,7 @@ contains end do end do - end do + end do #else @@ -1431,24 +1430,24 @@ contains do l = zb, ze do k = yb, ye do j = xb, xe - call s_compute_gradient_xi(q_prim_vf, xb, xe, yb, & - ye, zb, ze, j, k, l, tensora, tensorb) - ! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j,k,l) = tensorb(1) - !if (num_dims > 1) then ! 2D - btensor(2)%sf(j,k,l) = tensorb(2) - ! btensor(3)%sf(j,k,l) = tensorb(4) - !end if - !if (num_dims > 2) then ! 3D - btensor(3)%sf(j,k,l) = tensorb(3) - btensor(4)%sf(j,k,l) = tensorb(5) - btensor(5)%sf(j,k,l) = tensorb(6) - btensor(6)%sf(j,k,l) = tensorb(9) - !end if - ! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) + call s_compute_gradient_xi(q_prim_vf, xb, xe, yb, & + ye, zb, ze, j, k, l, tensora, tensorb) + ! 1: 1D, 3: 2D, 6: 3D + btensor(1)%sf(j, k, l) = tensorb(1) + !if (num_dims > 1) then ! 2D + btensor(2)%sf(j, k, l) = tensorb(2) + ! btensor(3)%sf(j,k,l) = tensorb(4) + !end if + !if (num_dims > 2) then ! 3D + btensor(3)%sf(j, k, l) = tensorb(3) + btensor(4)%sf(j, k, l) = tensorb(5) + btensor(5)%sf(j, k, l) = tensorb(6) + btensor(6)%sf(j, k, l) = tensorb(9) + !end if + ! store the determinant at the last entry of the btensor sf + btensor(b_size)%sf(j, k, l) = tensorb(tensor_size) end do - end do + end do end do end subroutine s_calculate_btensor @@ -1462,11 +1461,10 @@ contains !! btensor is symmetric, save the data space subroutine s_calculate_btensor_acc(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor integer, intent(in) :: xb, xe, yb, ye, zb, ze - real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb + real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb integer :: j, k, l, i ! if (num_dims == 1) then @@ -1501,465 +1499,463 @@ contains ! end do ! end do ! !$acc end parallel loop -! else ! 3D - +! else ! 3D !print *,'I got here AAAA' - !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) - do l = zb, ze - do k = yb, ye + !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) + do l = zb, ze + do k = yb, ye do j = xb, xe - ! STEP 1: computing the grad_xi tensor - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - - ! 1D - if(j == xb) then - ! dxix/dx - !print *, ' grid check xb :: ',q_prim_vf(xibeg)%sf(j, k, l) - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l) ) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - ! dxiy / dx - tensora(2) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg+1)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg+1)%sf(j + 4, k, l) ) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - ! dxiz / dx - tensora(3) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l) ) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - !print *, ' grid check xb :: ',tensora(1),tensora(2),tensora(7) - - else if (j == xb + 1) then - !print *, ' grid check xb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + q_prim_vf(xibeg)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (-3d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & - + q_prim_vf(xibeg+1)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(3) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xiend)%sf(j,k,l) & - + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + q_prim_vf(xiend)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - !print *, ' grid check xb1 :: ',tensora(1),tensora(2),tensora(7) - - else if (j == xe - 1) then - !print *, ' grid check xe1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - q_prim_vf(xibeg)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (3d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - - q_prim_vf(xibeg+1)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(3) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - q_prim_vf(xiend)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - !print *, ' grid check xe1 :: ',tensora(1),tensora(2),tensora(7) - - else if (j == xe) then - !print *, ' grid check xe :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix/dx - tensora(1) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l) ) & - /(12d0*(x_cb(j) - x_cb(j-1))) - ! dxiy / dx - tensora(2) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg+1)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg+1)%sf(j - 4, k, l) ) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(3) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l) ) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - !print *, ' grid check xe :: ',tensora(1),tensora(2),tensora(7) + ! STEP 1: computing the grad_xi tensor + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz + + ! 1D + if (j == xb) then + ! dxix/dx + !print *, ' grid check xb :: ',q_prim_vf(xibeg)%sf(j, k, l) + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + ! dxiy / dx + tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + ! dxiz / dx + tensora(3) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + !print *, ' grid check xb :: ',tensora(1),tensora(2),tensora(7) + + else if (j == xb + 1) then + !print *, ' grid check xb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix/dx + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + q_prim_vf(xibeg)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(3) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + q_prim_vf(xiend)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + !print *, ' grid check xb1 :: ',tensora(1),tensora(2),tensora(7) + + else if (j == xe - 1) then + !print *, ' grid check xe1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix/dx + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - q_prim_vf(xibeg)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(3) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - q_prim_vf(xiend)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + !print *, ' grid check xe1 :: ',tensora(1),tensora(2),tensora(7) + + else if (j == xe) then + !print *, ' grid check xe :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix/dx + tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(3) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + !print *, ' grid check xe :: ',tensora(1),tensora(2),tensora(7) - else - ! dxix/dx - tensora(1) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = ( q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg+1)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(3) = ( q_prim_vf(xiend)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - q_prim_vf(xiend)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - - end if - - ! 2D - if(k == yb) then - !print *, ' grid check yb :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dy - tensora(4) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - ! dxiy / dy - tensora(5) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg+1)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg+1)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - ! dxiz / dy - tensora(6) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - !print *, ' grid check yb :: ',tensora(4),tensora(5),tensora(8) - - else if (k == yb + 1) then - !print *, ' grid check yb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dy - tensora(4) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + q_prim_vf(xibeg)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & - + q_prim_vf(xibeg+1)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(6) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xiend)%sf(j,k,l) & - + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + q_prim_vf(xiend)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - !print *, ' grid check yb1 :: ',tensora(4),tensora(5),tensora(8) - - else if (k == ye - 1) then - !print *, ' grid check ye1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dy - tensora(4) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - q_prim_vf(xibeg)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (3d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - - q_prim_vf(xibeg+1)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(6) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - q_prim_vf(xiend)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - !print *, ' grid check yb1 :: ',tensora(4),tensora(5),tensora(8) - - else if (k == ye) then - !print *, ' grid check ye :: ',q_prim_vf(xibeg+1)%sf(j, k, l) - - ! dxix / dy - tensora(4) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg+1)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg+1)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(6) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxix / dy - tensora(4) = ( q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = ( q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg+1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(6) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - ! 3D - if(l == zb) then - !print *, ' grid check zb :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dz - tensora(7) = (-25d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 48d0*q_prim_vf(xibeg)%sf(j,k,l+1) & - - 36d0*q_prim_vf(xibeg)%sf(j,k,l+2) & - + 16d0*q_prim_vf(xibeg)%sf(j,k,l+3) & - - 3d0*q_prim_vf(xibeg)%sf(j,k,l+4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiy / dz - tensora(8) = (-25d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j,k,l+1) & - - 36d0*q_prim_vf(xibeg+1)%sf(j,k,l+2) & - + 16d0*q_prim_vf(xibeg+1)%sf(j,k,l+3) & - - 3d0*q_prim_vf(xibeg+1)%sf(j,k,l+4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiz / dz - tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j,k, l) & - + 48d0*q_prim_vf(xiend)%sf(j,k,l + 1) & - - 36d0*q_prim_vf(xiend)%sf(j,k,l + 2) & - + 16d0*q_prim_vf(xiend)%sf(j,k,l + 3) & - - 3d0*q_prim_vf(xiend)%sf(j,k,l + 4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == zb + 1) then - !print *, ' grid check zb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dz - tensora(7) = (-3d0*q_prim_vf(xibeg)%sf(j,k,l - 1) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j,k,l + 1) & - - 6d0*q_prim_vf(xibeg)%sf(j,k,l + 2) & - + q_prim_vf(xibeg)%sf(j,k,l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(8) = (-3d0*q_prim_vf(xibeg+1)%sf(j,k,l - 1) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j,k,l + 1) & - - 6d0*q_prim_vf(xibeg+1)%sf(j,k,l + 2) & - + q_prim_vf(xibeg+1)%sf(j,k,l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j,k,l - 1) & - - 10d0*q_prim_vf(xiend)%sf(j,k,l) & - + 18d0*q_prim_vf(xiend)%sf(j,k,l + 1) & - - 6d0*q_prim_vf(xiend)%sf(j,k,l + 2) & - + q_prim_vf(xiend)%sf(j,k,l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze - 1) then - !print *, ' grid check ze1 :: ',q_prim_vf(xiend)%sf(j, k, l) - - ! dxix / dz - tensora(7) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - - q_prim_vf(xibeg)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(8) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - q_prim_vf(xibeg+1)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - - 18d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - - q_prim_vf(xiend)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze) then - !print *, ' grid check ze :: ',q_prim_vf(xiend)%sf(j, k, l) - - ! dxix / dz - tensora(7) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(8) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xiend)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xiend)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxix / dz - tensora(7) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - - q_prim_vf(xibeg)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(8) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - - q_prim_vf(xiend)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - - !print *, 'I got here AAAAA' - - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) - tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) - tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) - tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) - tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) - tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) - tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) - tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) - tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) - - - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & - + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - - !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 3d0 ) then - ! print *, 'j, k, l :: ', j, k, l - ! do i = 1, 9 - ! print *,'i :: ',i,', ten :: ',tensorb(i) - ! end do - ! print *, 'det : ',tensorb(tensor_size) - ! tensorb(tensor_size) = 1d0 - !end if - - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse - ! STEP 4: store the determinant of F in the last entry of the tensor - - !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 2d0 ) then - tensorb(tensor_size) = 1d0 - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = 0d0 - end do - tensorb(1) = 1d0 - tensorb(5) = 1d0 - tensorb(9) = 1d0 - !end if - - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - !print *, 'I got here A6' - ! STEP 3: computing F tranpose F - !tensorb(1) = tensora(1)**2 - tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 - tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 - tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) - tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) - tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) - tensorb(4) = tensorb(2) - tensorb(7) = tensorb(3) - tensorb(8) = tensorb(6) - !print *, 'I got here A7' - !call s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, & - !iye, izb, ize, j, k, l, tensora, tensorb) + else + ! dxix/dx + tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(3) = (q_prim_vf(xiend)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - q_prim_vf(xiend)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + + end if + + ! 2D + if (k == yb) then + !print *, ' grid check yb :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix / dy + tensora(4) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + ! dxiy / dy + tensora(5) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + ! dxiz / dy + tensora(6) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + !print *, ' grid check yb :: ',tensora(4),tensora(5),tensora(8) + + else if (k == yb + 1) then + !print *, ' grid check yb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix / dy + tensora(4) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + q_prim_vf(xibeg)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(6) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + q_prim_vf(xiend)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + !print *, ' grid check yb1 :: ',tensora(4),tensora(5),tensora(8) + + else if (k == ye - 1) then + !print *, ' grid check ye1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix / dy + tensora(4) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - q_prim_vf(xibeg)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(6) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - q_prim_vf(xiend)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + !print *, ' grid check yb1 :: ',tensora(4),tensora(5),tensora(8) + + else if (k == ye) then + !print *, ' grid check ye :: ',q_prim_vf(xibeg+1)%sf(j, k, l) + + ! dxix / dy + tensora(4) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(6) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxix / dy + tensora(4) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(6) = (q_prim_vf(xiend)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - q_prim_vf(xiend)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + ! 3D + if (l == zb) then + !print *, ' grid check zb :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix / dz + tensora(7) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xibeg)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xibeg)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiy / dz + tensora(8) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiz / dz + tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xiend)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xiend)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xiend)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == zb + 1) then + !print *, ' grid check zb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix / dz + tensora(7) = (-3d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & + + q_prim_vf(xibeg)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(8) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & + + q_prim_vf(xibeg + 1)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xiend)%sf(j, k, l + 2) & + + q_prim_vf(xiend)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze - 1) then + !print *, ' grid check ze1 :: ',q_prim_vf(xiend)%sf(j, k, l) + + ! dxix / dz + tensora(7) = (3d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & + - q_prim_vf(xibeg)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(8) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - q_prim_vf(xibeg + 1)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xiend)%sf(j, k, l - 2) & + - q_prim_vf(xiend)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze) then + !print *, ' grid check ze :: ',q_prim_vf(xiend)%sf(j, k, l) + + ! dxix / dz + tensora(7) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xibeg)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xibeg)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(8) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xiend)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xiend)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xiend)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxix / dz + tensora(7) = (q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - q_prim_vf(xibeg)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(8) = (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (q_prim_vf(xiend)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - q_prim_vf(xiend)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if + + !print *, 'I got here AAAAA' + + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) + tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) + tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) + tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) + tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) + tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) + tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) + tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) + tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) + + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + + !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 3d0 ) then + ! print *, 'j, k, l :: ', j, k, l + ! do i = 1, 9 + ! print *,'i :: ',i,', ten :: ',tensorb(i) + ! end do + ! print *, 'det : ',tensorb(tensor_size) + ! tensorb(tensor_size) = 1d0 + !end if + + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse + ! STEP 4: store the determinant of F in the last entry of the tensor + + !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 2d0 ) then + tensorb(tensor_size) = 1d0 + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = 0d0 + end do + tensorb(1) = 1d0 + tensorb(5) = 1d0 + tensorb(9) = 1d0 + !end if + + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do + !print *, 'I got here A6' + ! STEP 3: computing F tranpose F + !tensorb(1) = tensora(1)**2 + tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 + tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 + tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) + tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) + tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) + tensorb(4) = tensorb(2) + tensorb(7) = tensorb(3) + tensorb(8) = tensorb(6) + !print *, 'I got here A7' + !call s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, & + !iye, izb, ize, j, k, l, tensora, tensorb) !! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j,k,l) = tensorb(1) - btensor(2)%sf(j,k,l) = tensorb(2) - btensor(3)%sf(j,k,l) = tensorb(3) - btensor(4)%sf(j,k,l) = tensorb(5) - btensor(5)%sf(j,k,l) = tensorb(6) - btensor(6)%sf(j,k,l) = tensorb(9) - !print *, 'I got here A8' + btensor(1)%sf(j, k, l) = tensorb(1) + btensor(2)%sf(j, k, l) = tensorb(2) + btensor(3)%sf(j, k, l) = tensorb(3) + btensor(4)%sf(j, k, l) = tensorb(5) + btensor(5)%sf(j, k, l) = tensorb(6) + btensor(6)%sf(j, k, l) = tensorb(9) + !print *, 'I got here A8' !! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) + btensor(b_size)%sf(j, k, l) = tensorb(tensor_size) end do - end do - end do - !$acc end parallel loop - !print *, 'I got here A9' + end do + end do + !$acc end parallel loop + !print *, 'I got here A9' ! end if end subroutine s_calculate_btensor_acc diff --git a/src/common/m_xi_tensor_calc.f90 b/src/common/m_xi_tensor_calc.f90 index 9a910a2b06..9f4b6e76f5 100644 --- a/src/common/m_xi_tensor_calc.f90 +++ b/src/common/m_xi_tensor_calc.f90 @@ -15,13 +15,13 @@ module m_xi_tensor_calc implicit none - private; public :: s_compute_gradient_xi, & -s_compute_gradient_xi1d_acc, & -s_compute_gradient_xi2d_acc, & -s_compute_gradient_xi3d_acc, & -f_elastic_energy + private; public :: s_compute_gradient_xi, & + s_compute_gradient_xi1d_acc, & + s_compute_gradient_xi2d_acc, & + s_compute_gradient_xi3d_acc, & + f_elastic_energy - contains +contains !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. @@ -32,10 +32,10 @@ module m_xi_tensor_calc !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- - zb, ze, j, k, l, tensora, tensorb) + zb, ze, j, k, l, tensora, tensorb) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora, tensorb + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora, tensorb integer, intent(IN) :: xb, xe, yb, ye, zb, ze integer, intent(IN) :: j, k, l @@ -46,170 +46,170 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - if(j == xb) then - ! dxix/dx - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l) ) & - /(12d0*(x_cb(j+1) - x_cb(j))) + if (j == xb) then + ! dxix/dx + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) else if (j == xb + 1) then - ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + q_prim_vf(xibeg)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxix/dx + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + q_prim_vf(xibeg)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == xe - 1) then - ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - q_prim_vf(xibeg)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxix/dx + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - q_prim_vf(xibeg)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == xe) then - ! dxix/dx - tensora(1) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l) ) & - /(12d0*(x_cb(j) - x_cb(j-1))) + ! dxix/dx + tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) else - ! dxix/dx - tensora(1) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if + ! dxix/dx + tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if if (num_dims > 1) then - if(j == xb) then - ! dxiy / dx - tensora(2) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg+1)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg+1)%sf(j + 4, k, l) ) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == xb + 1) then - ! dxiy / dx - tensora(2) = (-3d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & - + q_prim_vf(xibeg+1)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == xe - 1) then - ! dxiy / dx - tensora(2) = (3d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - - q_prim_vf(xibeg+1)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == xe) then - ! dxiy / dx - tensora(2) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg+1)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg+1)%sf(j - 4, k, l) ) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxiy / dx - tensora(2) = ( q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg+1)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - if(k == yb) then - ! dxix / dy - tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - else if (k == yb + 1) then - ! dxix / dy - tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + q_prim_vf(xibeg)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye - 1) then - ! dxix / dy - tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - q_prim_vf(xibeg)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye) then - ! dxix / dy - tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxix / dy - tensora(3) = ( q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - if(k == yb) then - ! dxiy / dy - tensora(4) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg+1)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg+1)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k+1) - y_cb(k))) - else if (k == yb + 1) then - ! dxiy / dy - tensora(4) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & - + q_prim_vf(xibeg+1)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye - 1) then - ! dxiy / dy - tensora(4) = (3d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - - q_prim_vf(xibeg+1)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye) then - ! dxiy / dy - tensora(4) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg+1)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg+1)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxiy / dy - tensora(4) = ( q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg+1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if + if (j == xb) then + ! dxiy / dx + tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + else if (j == xb + 1) then + ! dxiy / dx + tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == xe - 1) then + ! dxiy / dx + tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == xe) then + ! dxiy / dx + tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxiy / dx + tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + if (k == yb) then + ! dxix / dy + tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + else if (k == yb + 1) then + ! dxix / dy + tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + q_prim_vf(xibeg)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye - 1) then + ! dxix / dy + tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - q_prim_vf(xibeg)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye) then + ! dxix / dy + tensora(3) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxix / dy + tensora(3) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + if (k == yb) then + ! dxiy / dy + tensora(4) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + else if (k == yb + 1) then + ! dxiy / dy + tensora(4) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye - 1) then + ! dxiy / dy + tensora(4) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye) then + ! dxiy / dy + tensora(4) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxiy / dy + tensora(4) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if end if @@ -219,213 +219,213 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- tensora(5) = tensora(4) tensora(4) = tensora(3) - if(l == zb) then - ! dxix / dz - tensora(7) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - - 36d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & - + 16d0*q_prim_vf(xibeg)%sf(j, k , l + 3) & - - 3d0*q_prim_vf(xibeg)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == zb + 1) then - ! dxix / dz - tensora(7) = (-3d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - - 6d0*q_prim_vf(xibeg)%sf(j, k , l + 2) & - + q_prim_vf(xibeg)%sf(j, k , l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze - 1) then - ! dxix / dz - tensora(7) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - - q_prim_vf(xibeg)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze) then - ! dxix / dz - tensora(7) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxix / dz - tensora(7) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - - q_prim_vf(xibeg)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - - if(l == zb) then - ! dxiy / dz - tensora(8) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - - 36d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & - + 16d0*q_prim_vf(xibeg+1)%sf(j, k , l + 3) & - - 3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(l+1) - z_cb(l))) - else if (l == zb + 1) then - ! dxiy / dz - tensora(8) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - - 6d0*q_prim_vf(xibeg+1)%sf(j, k , l + 2) & - + q_prim_vf(xibeg+1)%sf(j, k , l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze - 1) then - ! dxiy / dz - tensora(8) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - q_prim_vf(xibeg+1)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze) then - ! dxiy / dz - tensora(8) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l-1))) - else - ! dxiy / dz - tensora(8) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - - if(j == xb) then - ! dxiz / dx - tensora(3) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l) ) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == xb + 1) then - ! dxiz / dx - tensora(3) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xiend)%sf(j,k,l) & - + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + q_prim_vf(xiend)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == xe - 1) then - ! dxiz / dx - tensora(3) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - q_prim_vf(xiend)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == xe) then - ! dxiz / dx - tensora(3) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l) ) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxiz / dx - tensora(3) = ( q_prim_vf(xiend)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - q_prim_vf(xiend)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - if(k == yb) then - ! dxiz / dy - tensora(6) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k+1) - y_cb(k))) - else if (k == yb + 1) then - ! dxiz / dy - tensora(6) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xiend)%sf(j,k,l) & - + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + q_prim_vf(xiend)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye - 1) then - ! dxiz / dy - tensora(6) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - q_prim_vf(xiend)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye) then - ! dxiz / dy - tensora(6) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxiz / dy - tensora(6) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - if(l == zb) then - ! dxiz / dz - tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - - 36d0*q_prim_vf(xiend)%sf(j, k , l + 2) & - + 16d0*q_prim_vf(xiend)%sf(j, k , l + 3) & - - 3d0*q_prim_vf(xiend)%sf(j, k , l + 4) ) & - /(12d0*(z_cb(l+1) - z_cb(l))) - else if (l == zb + 1) then - ! dxiz / dz - tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - - 10d0*q_prim_vf(xiend)%sf(j,k,l) & - + 18d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - - 6d0*q_prim_vf(xiend)%sf(j, k , l + 2) & - + q_prim_vf(xiend)%sf(j, k , l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze - 1) then - ! dxiz / dz - tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - - 18d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - - q_prim_vf(xiend)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze) then - ! dxiz / dz - tensora(9) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xiend)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xiend)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxiz / dz - tensora(9) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - - q_prim_vf(xiend)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if + if (l == zb) then + ! dxix / dz + tensora(7) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xibeg)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xibeg)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == zb + 1) then + ! dxix / dz + tensora(7) = (-3d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & + + q_prim_vf(xibeg)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze - 1) then + ! dxix / dz + tensora(7) = (3d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & + - q_prim_vf(xibeg)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze) then + ! dxix / dz + tensora(7) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xibeg)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xibeg)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxix / dz + tensora(7) = (q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - q_prim_vf(xibeg)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if + + if (l == zb) then + ! dxiy / dz + tensora(8) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == zb + 1) then + ! dxiy / dz + tensora(8) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & + + q_prim_vf(xibeg + 1)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze - 1) then + ! dxiy / dz + tensora(8) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - q_prim_vf(xibeg + 1)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze) then + ! dxiy / dz + tensora(8) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxiy / dz + tensora(8) = (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if + + if (j == xb) then + ! dxiz / dx + tensora(3) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + else if (j == xb + 1) then + ! dxiz / dx + tensora(3) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + q_prim_vf(xiend)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == xe - 1) then + ! dxiz / dx + tensora(3) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - q_prim_vf(xiend)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == xe) then + ! dxiz / dx + tensora(3) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxiz / dx + tensora(3) = (q_prim_vf(xiend)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - q_prim_vf(xiend)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + if (k == yb) then + ! dxiz / dy + tensora(6) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + else if (k == yb + 1) then + ! dxiz / dy + tensora(6) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + q_prim_vf(xiend)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye - 1) then + ! dxiz / dy + tensora(6) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - q_prim_vf(xiend)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye) then + ! dxiz / dy + tensora(6) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxiz / dy + tensora(6) = (q_prim_vf(xiend)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - q_prim_vf(xiend)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + if (l == zb) then + ! dxiz / dz + tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xiend)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xiend)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xiend)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == zb + 1) then + ! dxiz / dz + tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xiend)%sf(j, k, l + 2) & + + q_prim_vf(xiend)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze - 1) then + ! dxiz / dz + tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xiend)%sf(j, k, l - 2) & + - q_prim_vf(xiend)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze) then + ! dxiz / dz + tensora(9) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xiend)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xiend)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xiend)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxiz / dz + tensora(9) = (q_prim_vf(xiend)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - q_prim_vf(xiend)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if end if - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse if (num_dims == 1) then tensorb(1) = 1 elseif (num_dims == 2) then @@ -445,15 +445,15 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) end if - ! STEP 2b: computing the determinant of the grad_xi tensor + ! STEP 2b: computing the determinant of the grad_xi tensor if (num_dims == 1) then determinant = tensora(1) elseif (num_dims == 2) then determinant = tensora(1)*tensora(4) - tensora(2)*tensora(3) else determinant = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & - + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) end if ! error checking !if (determinant == 0) then @@ -461,18 +461,18 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- ! print *, 'ERROR: Determinant was zero' ! stop !end if - if (determinant .lt. 0d0 .or. determinant .gt. 2d0) then - print *, 'i, j, k :: ', j,' ', k,' ',l,',det ::',tensorb(tensor_size) - ! stop + if (determinant < 0d0 .or. determinant > 2d0) then + print *, 'i, j, k :: ', j, ' ', k, ' ', l, ',det ::', tensorb(tensor_size) + ! stop end if - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/determinant - end do + tensora(i) = tensorb(i)/determinant + end do - ! STEP 3: computing F tranpose F + ! STEP 3: computing F tranpose F tensorb(1) = tensora(1)**2 if (num_dims == 2) then tensorb(1) = tensorb(1) + tensora(3)**2 @@ -490,12 +490,11 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- tensorb(7) = tensorb(3) tensorb(8) = tensorb(6) end if - ! STEP 4: store the determinant of F in the last entry of the tensor + ! STEP 4: store the determinant of F in the last entry of the tensor tensorb(tensor_size) = determinant end subroutine s_compute_gradient_xi - !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. !! @param q_prim_vf Primitive variables @@ -505,78 +504,78 @@ end subroutine s_compute_gradient_xi !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space subroutine s_compute_gradient_xi1d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- - izb, ize, j, k, l, tensora, tensorb) + izb, ize, j, k, l, tensora, tensorb) !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb integer, intent(IN) :: ixb, ixe, iyb, iye, izb, ize integer, intent(IN) :: j, k, l integer :: i - + ! STEP 1: computing the grad_xi tensor ! grad_xi definition / organization ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - if(j == ixb) then - ! dxix/dx - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l) ) & - /(12d0*(x_cb(j+1) - x_cb(j))) + if (j == ixb) then + ! dxix/dx + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) else if (j == ixb + 1) then - ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + q_prim_vf(xibeg)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxix/dx + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + q_prim_vf(xibeg)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == ixe - 1) then - ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - q_prim_vf(xibeg)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxix/dx + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - q_prim_vf(xibeg)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == ixe) then - ! dxix/dx - tensora(1) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l) ) & - /(12d0*(x_cb(j) - x_cb(j-1))) + ! dxix/dx + tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) else - ! dxix/dx - tensora(1) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = 1 + ! dxix/dx + tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = 1 - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1) + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1) - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse !$acc loop seq do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do - ! STEP 3: computing F tranpose F + ! STEP 3: computing F tranpose F tensorb(1) = tensora(1)**2 - ! STEP 4: store the determinant of F in the last entry of the tensor + ! STEP 4: store the determinant of F in the last entry of the tensor !tensorb(tensor_size) = determinant end subroutine s_compute_gradient_xi1d_acc @@ -590,208 +589,208 @@ end subroutine s_compute_gradient_xi1d_acc !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space subroutine s_compute_gradient_xi2d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- - izb, ize, j, k, l, tensora, tensorb) + izb, ize, j, k, l, tensora, tensorb) !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb integer, intent(IN) :: ixb, ixe, iyb, iye, izb, ize integer, intent(IN) :: j, k, l integer :: i - + ! STEP 1: computing the grad_xi tensor ! grad_xi definition / organization ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - if(j == ixb) then - ! dxix/dx - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l) ) & - /(12d0*(x_cb(j+1) - x_cb(j))) + if (j == ixb) then + ! dxix/dx + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) else if (j == ixb + 1) then - ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + q_prim_vf(xibeg)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxix/dx + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + q_prim_vf(xibeg)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == ixe - 1) then - ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - q_prim_vf(xibeg)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxix/dx + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - q_prim_vf(xibeg)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == ixe) then - ! dxix/dx - tensora(1) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l) ) & - /(12d0*(x_cb(j) - x_cb(j-1))) + ! dxix/dx + tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) else - ! dxix/dx - tensora(1) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if + ! dxix/dx + tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if ! 2D - if(j == ixb) then - ! dxiy / dx - tensora(2) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg+1)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg+1)%sf(j + 4, k, l) ) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == ixb + 1) then - ! dxiy / dx - tensora(2) = (-3d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & - + q_prim_vf(xibeg+1)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe - 1) then - ! dxiy / dx - tensora(2) = (3d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - - q_prim_vf(xibeg+1)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe) then - ! dxiy / dx - tensora(2) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg+1)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg+1)%sf(j - 4, k, l) ) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxiy / dx - tensora(2) = ( q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg+1)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - if(k == iyb) then - ! dxix / dy - tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - else if (k == iyb + 1) then - ! dxix / dy - tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + q_prim_vf(xibeg)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye - 1) then - ! dxix / dy - tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - q_prim_vf(xibeg)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye) then - ! dxix / dy - tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxix / dy - tensora(3) = ( q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - if(k == iyb) then - ! dxiy / dy - tensora(4) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg+1)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg+1)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - else if (k == iyb + 1) then - ! dxiy / dy - tensora(4) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & - + q_prim_vf(xibeg+1)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye - 1) then - ! dxiy / dy - tensora(4) = (3d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - - q_prim_vf(xibeg+1)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye) then - ! dxiy / dy - tensora(4) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg+1)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg+1)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxiy / dy - tensora(4) = ( q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg+1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + if (j == ixb) then + ! dxiy / dx + tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + else if (j == ixb + 1) then + ! dxiy / dx + tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe - 1) then + ! dxiy / dx + tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe) then + ! dxiy / dx + tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxiy / dx + tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + if (k == iyb) then + ! dxix / dy + tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + else if (k == iyb + 1) then + ! dxix / dy + tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + q_prim_vf(xibeg)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye - 1) then + ! dxix / dy + tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - q_prim_vf(xibeg)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye) then + ! dxix / dy + tensora(3) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxix / dy + tensora(3) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + if (k == iyb) then + ! dxiy / dy + tensora(4) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + else if (k == iyb + 1) then + ! dxiy / dy + tensora(4) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye - 1) then + ! dxiy / dy + tensora(4) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye) then + ! dxiy / dy + tensora(4) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxiy / dy + tensora(4) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse tensorb(1) = tensora(4) tensorb(2) = -tensora(3) tensorb(3) = -tensora(2) tensorb(4) = tensora(1) - ! STEP 2b: computing the determinant of the grad_xi tensor + ! STEP 2b: computing the determinant of the grad_xi tensor tensorb(tensor_size) = tensora(1)*tensora(4) - tensora(2)*tensora(3) - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse !$acc loop seq do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - ! STEP 3: computing F tranpose F + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do + ! STEP 3: computing F tranpose F tensorb(1) = tensora(1)**2 tensorb(1) = tensorb(1) + tensora(3)**2 tensorb(2) = tensora(1)*tensora(2) + tensora(3)*tensora(4) tensorb(3) = tensorb(2) tensorb(4) = tensora(2)**2 + tensora(4)**2 - ! STEP 4: store the determinant of F in the last entry of the tensor + ! STEP 4: store the determinant of F in the last entry of the tensor end subroutine s_compute_gradient_xi2d_acc @@ -804,18 +803,18 @@ end subroutine s_compute_gradient_xi2d_acc !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space subroutine s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- - izb, ize, j, k, l, tensora, tensorb) + izb, ize, j, k, l, tensora, tensorb) !$acc routine seq type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb integer, intent(IN) :: ixb, ixe integer, intent(IN) :: iyb, iye integer, intent(IN) :: izb, ize integer, intent(IN) :: j, k, l integer :: i - + ! STEP 1: computing the grad_xi tensor ! grad_xi definition / organization ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx @@ -823,377 +822,375 @@ subroutine s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !------- ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz ! 1D - if(j == ixb) then - ! dxix/dx - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l) ) & - /(12d0*(x_cb(j+1) - x_cb(j))) - ! dxiy / dx - tensora(2) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg+1)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg+1)%sf(j + 4, k, l) ) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - ! dxiz / dx - tensora(7) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l) ) & - /(12d0*(x_cb(j + 1) - x_cb(j))) + if (j == ixb) then + ! dxix/dx + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + ! dxiy / dx + tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + ! dxiz / dx + tensora(7) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) else if (j == ixb + 1) then - ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + q_prim_vf(xibeg)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (-3d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg+1)%sf(j + 2, k, l) & - + q_prim_vf(xibeg+1)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(7) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xiend)%sf(j,k,l) & - + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + q_prim_vf(xiend)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxix/dx + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + q_prim_vf(xibeg)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(7) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + q_prim_vf(xiend)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == ixe - 1) then - ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - q_prim_vf(xibeg)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (3d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - - q_prim_vf(xibeg+1)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(7) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - q_prim_vf(xiend)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxix/dx + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - q_prim_vf(xibeg)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(7) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - q_prim_vf(xiend)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) else if (j == ixe) then - ! dxix/dx - tensora(1) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l) ) & - /(12d0*(x_cb(j) - x_cb(j-1))) - ! dxiy / dx - tensora(2) = (25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg+1)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg+1)%sf(j - 4, k, l) ) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(7) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l) ) & - /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxix/dx + tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(7) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) else - ! dxix/dx - tensora(1) = ( q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = ( q_prim_vf(xibeg+1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg+1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg+1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg+1)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(7) = ( q_prim_vf(xiend)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - q_prim_vf(xiend)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - - end if + ! dxix/dx + tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(7) = (q_prim_vf(xiend)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - q_prim_vf(xiend)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + + end if ! 2D - if(k == iyb) then - ! dxix / dy - tensora(4) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - ! dxiy / dy - tensora(5) = (-25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg+1)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg+1)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - ! dxiz / dy - tensora(8) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l) ) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - - else if (k == iyb + 1) then - ! dxix / dy - tensora(4) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + q_prim_vf(xibeg)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (-3d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg+1)%sf(j, k + 2, l) & - + q_prim_vf(xibeg+1)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(8) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xiend)%sf(j,k,l) & - + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + q_prim_vf(xiend)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye - 1) then - ! dxix / dy - tensora(4) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - q_prim_vf(xibeg)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (3d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - - q_prim_vf(xibeg+1)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(8) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - q_prim_vf(xiend)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye) then - ! dxix / dy - tensora(4) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg+1)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg+1)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(8) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l) ) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxix / dy - tensora(4) = ( q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = ( q_prim_vf(xibeg+1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg+1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg+1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg+1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(8) = ( q_prim_vf(xiend)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if + if (k == iyb) then + ! dxix / dy + tensora(4) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + ! dxiy / dy + tensora(5) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + ! dxiz / dy + tensora(8) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + + else if (k == iyb + 1) then + ! dxix / dy + tensora(4) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + q_prim_vf(xibeg)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(8) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + q_prim_vf(xiend)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye - 1) then + ! dxix / dy + tensora(4) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - q_prim_vf(xibeg)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(8) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - q_prim_vf(xiend)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye) then + ! dxix / dy + tensora(4) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(8) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxix / dy + tensora(4) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(8) = (q_prim_vf(xiend)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - q_prim_vf(xiend)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if ! 3D - if(l == izb) then - ! dxix / dz - tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 48d0*q_prim_vf(xibeg)%sf(j,k,l+1) & - - 36d0*q_prim_vf(xibeg)%sf(j,k,l+2) & - + 16d0*q_prim_vf(xibeg)%sf(j,k,l+3) & - - 3d0*q_prim_vf(xibeg)%sf(j,k,l+4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiy / dz - tensora(6) = (-25d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 48d0*q_prim_vf(xibeg+1)%sf(j,k,l+1) & - - 36d0*q_prim_vf(xibeg+1)%sf(j,k,l+2) & - + 16d0*q_prim_vf(xibeg+1)%sf(j,k,l+3) & - - 3d0*q_prim_vf(xibeg+1)%sf(j,k,l+4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiz / dz - tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j,k, l) & - + 48d0*q_prim_vf(xiend)%sf(j,k,l + 1) & - - 36d0*q_prim_vf(xiend)%sf(j,k,l + 2) & - + 16d0*q_prim_vf(xiend)%sf(j,k,l + 3) & - - 3d0*q_prim_vf(xiend)%sf(j,k,l + 4) ) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == izb + 1) then - ! dxix / dz - tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j,k,l - 1) & - - 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg)%sf(j,k,l + 1) & - - 6d0*q_prim_vf(xibeg)%sf(j,k,l + 2) & - + q_prim_vf(xibeg)%sf(j,k,l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = (-3d0*q_prim_vf(xibeg+1)%sf(j,k,l - 1) & - - 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - + 18d0*q_prim_vf(xibeg+1)%sf(j,k,l + 1) & - - 6d0*q_prim_vf(xibeg+1)%sf(j,k,l + 2) & - + q_prim_vf(xibeg+1)%sf(j,k,l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j,k,l - 1) & - - 10d0*q_prim_vf(xiend)%sf(j,k,l) & - + 18d0*q_prim_vf(xiend)%sf(j,k,l + 1) & - - 6d0*q_prim_vf(xiend)%sf(j,k,l + 2) & - + q_prim_vf(xiend)%sf(j,k,l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize - 1) then - ! dxix / dz - tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xibeg)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - - q_prim_vf(xibeg)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = (3d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xibeg+1)%sf(j,k,l) & - - 18d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - q_prim_vf(xibeg+1)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - + 10d0*q_prim_vf(xiend)%sf(j,k,l) & - - 18d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 6d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - - q_prim_vf(xiend)%sf(j, k , l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize) then - ! dxix / dz - tensora(3) =(25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xibeg)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xibeg)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xibeg)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) =(25d0*q_prim_vf(xibeg+1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xibeg+1)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xibeg+1)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) =(25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 36d0*q_prim_vf(xiend)%sf(j, k , l - 2) & - - 16d0*q_prim_vf(xiend)%sf(j, k , l - 3) & - + 3d0*q_prim_vf(xiend)%sf(j, k , l - 4) ) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxix / dz - tensora(3) = ( q_prim_vf(xibeg)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k , l + 1) & - - q_prim_vf(xibeg)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = ( q_prim_vf(xibeg+1)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xibeg+1)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xibeg+1)%sf(j, k , l + 1) & - - q_prim_vf(xibeg+1)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = ( q_prim_vf(xiend)%sf(j, k , l - 2) & - - 8d0*q_prim_vf(xiend)%sf(j, k , l - 1) & - + 8d0*q_prim_vf(xiend)%sf(j, k , l + 1) & - - q_prim_vf(xiend)%sf(j, k , l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - - - - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) - tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) - tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) - tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) - tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) - tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) - tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) - tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) - tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) - - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & - + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + if (l == izb) then + ! dxix / dz + tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xibeg)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xibeg)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiy / dz + tensora(6) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiz / dz + tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xiend)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xiend)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xiend)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == izb + 1) then + ! dxix / dz + tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & + + q_prim_vf(xibeg)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & + + q_prim_vf(xibeg + 1)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xiend)%sf(j, k, l + 2) & + + q_prim_vf(xiend)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ize - 1) then + ! dxix / dz + tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & + - q_prim_vf(xibeg)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - q_prim_vf(xibeg + 1)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xiend)%sf(j, k, l - 2) & + - q_prim_vf(xiend)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ize) then + ! dxix / dz + tensora(3) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xibeg)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xibeg)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xiend)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xiend)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xiend)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxix / dz + tensora(3) = (q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - q_prim_vf(xibeg)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (q_prim_vf(xiend)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - q_prim_vf(xiend)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse - ! STEP 4: store the determinant of F in the last entry of the tensor + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) + tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) + tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) + tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) + tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) + tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) + tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) + tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) + tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) + + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse + ! STEP 4: store the determinant of F in the last entry of the tensor !$acc loop seq do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do - ! STEP 3: computing F tranpose F + ! STEP 3: computing F tranpose F tensorb(1) = tensora(1)**2 - tensorb(1) = tensorb(1) + tensora(4)**2 + tensora(7)**2 - tensorb(5) = tensora(2) + tensora(5)**2 + tensora(8)**2 - tensorb(9) = tensora(3) + tensora(6)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(2) + tensora(4)*tensora(5) + tensora(7)*tensora(8) - tensorb(3) = tensora(1)*tensora(3) + tensora(4)*tensora(6) + tensora(7)*tensora(9) - tensorb(6) = tensora(2)*tensora(3) + tensora(5)*tensora(6) + tensora(8)*tensora(9) - tensorb(4) = tensorb(2) - tensorb(7) = tensorb(3) - tensorb(8) = tensorb(4) + tensorb(1) = tensorb(1) + tensora(4)**2 + tensora(7)**2 + tensorb(5) = tensora(2) + tensora(5)**2 + tensora(8)**2 + tensorb(9) = tensora(3) + tensora(6)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(2) + tensora(4)*tensora(5) + tensora(7)*tensora(8) + tensorb(3) = tensora(1)*tensora(3) + tensora(4)*tensora(6) + tensora(7)*tensora(9) + tensorb(6) = tensora(2)*tensora(3) + tensora(5)*tensora(6) + tensora(8)*tensora(9) + tensorb(4) = tensorb(2) + tensorb(7) = tensorb(3) + tensorb(8) = tensorb(4) end subroutine s_compute_gradient_xi3d_acc @@ -1219,7 +1216,7 @@ function f_elastic_energy(btensor, j, k, l) !if (num_dims == 2) then ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) !elseif (num_dims == 3) then - invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) !end if ! compute the invariant without the elastic modulus diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 9937bea952..2988fccc87 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -988,7 +988,7 @@ contains real(kind(0d0)), dimension(num_fluids) :: alpha, vol_fluid, xcom, ycom, zcom real(kind=8), parameter :: pi = 4.d0*datan(1.d0) real(kind(0d0)), allocatable :: x_td(:), y_td(:), x_d1(:), y_d1(:), y_d(:), x_d(:) - real(kind(0d0)) :: axp, axm, ayp, aym, azm, azp, tgp, euc_d, thres, maxalph_loc, maxalph_glb + real(kind(0d0)) :: axp, axm, ayp, aym, azm, azp, tgp, euc_d, thres, maxalph_loc, maxalph_glb allocate (x_d1(m*n)) allocate (y_d1(m*n)) @@ -998,7 +998,7 @@ contains do j = 0, n do i = 0, m if (q_prim_vf(E_idx + 2)%sf(i, j, k) > maxalph_loc) then - maxalph_loc = q_prim_vf(E_idx + 2)%sf(i, j, k) + maxalph_loc = q_prim_vf(E_idx + 2)%sf(i, j, k) end if end do end do @@ -1006,7 +1006,7 @@ contains call s_mpi_allreduce_max(maxalph_loc, maxalph_glb) do l = 0, p - if (z_cc(l) .lt. dz(l) .and. z_cc(l) .gt. 0) then + if (z_cc(l) < dz(l) .and. z_cc(l) > 0) then cent = l end if end do @@ -1017,8 +1017,8 @@ contains axm = q_prim_vf(E_idx + 2)%sf(j, k, cent) ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, cent) aym = q_prim_vf(E_idx + 2)%sf(j, k, cent) - if ((axp .gt. thres .and. axm .lt. thres) .or. (axp .lt. thres .and. axm .gt. thres) & - .or. (ayp .gt. thres .and. aym .lt. thres) .or. (ayp .lt. thres .and. aym .gt. thres)) then + if ((axp > thres .and. axm < thres) .or. (axp < thres .and. axm > thres) & + .or. (ayp > thres .and. aym < thres) .or. (ayp < thres .and. aym > thres)) then if (counter == 0) then counter = counter + 1 x_d1(counter) = x_cc(j) @@ -1029,7 +1029,7 @@ contains euc_d = dsqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2) tgp = dsqrt(dx(j)**2 + dy(k)**2) do i = 1, counter - if (euc_d .lt. tgp) then + if (euc_d < tgp) then cycle OLoop elseif (euc_d > tgp .and. i == counter .and. x_cc(j) < 1.5 .and. y_cc(k) < 1.5) then !artificial bounding on the interface for bubble at a centroid. @@ -1045,7 +1045,6 @@ contains end do OLoop end do - allocate (y_d(counter)) allocate (x_d(counter)) do i = 1, counter @@ -1066,9 +1065,7 @@ contains x_td(i), y_td(i), 0d0 end if end do - end if - - + end if end subroutine s_write_intf_data_file ! ----------------------------------- @@ -1094,48 +1091,48 @@ contains dV = 0d0 pres_av = 0d0 pres = 0d0 - do k = 0, p - do j = 0, n - do i = 0, m - pres = 0d0 - dV = dx(i)*dy(j)*dz(k) - rho = 0d0 - gamma = 0d0 - pi_inf = 0d0 - pres = q_prim_vf(E_idx)%sf(i, j, k) - Egint = Egint + q_prim_vf(E_idx + 2)%sf(i, j, k)*(fluid_pp(2)%gamma*pres)*dV - do s = 1, num_dims - vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) - Egk = Egk + 0.5d0*q_prim_vf(E_idx + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV - Elk = Elk + 0.5d0*q_prim_vf(E_idx + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV - if (dabs(vel(s)) > maxvel) then - maxvel = dabs(vel(s)) - end if - end do - do l = 1, adv_idx%end - E_idx - adv(l) = q_prim_vf(E_idx + l)%sf(i, j, k) - gamma = gamma + adv(l)*fluid_pp(l)%gamma - pi_inf = pi_inf + adv(l)*fluid_pp(l)%pi_inf - rho = rho + adv(l)*q_prim_vf(l)%sf(i, j, k) - end do + do k = 0, p + do j = 0, n + do i = 0, m + pres = 0d0 + dV = dx(i)*dy(j)*dz(k) + rho = 0d0 + gamma = 0d0 + pi_inf = 0d0 + pres = q_prim_vf(E_idx)%sf(i, j, k) + Egint = Egint + q_prim_vf(E_idx + 2)%sf(i, j, k)*(fluid_pp(2)%gamma*pres)*dV + do s = 1, num_dims + vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) + Egk = Egk + 0.5d0*q_prim_vf(E_idx + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV + Elk = Elk + 0.5d0*q_prim_vf(E_idx + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV + if (dabs(vel(s)) > maxvel) then + maxvel = dabs(vel(s)) + end if + end do + do l = 1, adv_idx%end - E_idx + adv(l) = q_prim_vf(E_idx + l)%sf(i, j, k) + gamma = gamma + adv(l)*fluid_pp(l)%gamma + pi_inf = pi_inf + adv(l)*fluid_pp(l)%pi_inf + rho = rho + adv(l)*q_prim_vf(l)%sf(i, j, k) + end do - H = ((gamma + 1d0)*pres + pi_inf)/rho + H = ((gamma + 1d0)*pres + pi_inf)/rho - call s_compute_speed_of_sound(pres, rho, & - gamma, pi_inf, & - H, adv, 0d0, c) + call s_compute_speed_of_sound(pres, rho, & + gamma, pi_inf, & + H, adv, 0d0, c) - Ma = maxvel/c - if (Ma > MaxMa .and. adv(1) > 1.0d0 - 1.0d-10) then - MaxMa = Ma - end if - Vl = Vl + adv(1)*dV - Vb = Vb + adv(2)*dV - pres_av = pres_av + adv(1)*pres*dV - Et = Et + q_cons_vf(E_idx)%sf(i, j, k)*dV - end do + Ma = maxvel/c + if (Ma > MaxMa .and. adv(1) > 1.0d0 - 1.0d-10) then + MaxMa = Ma + end if + Vl = Vl + adv(1)*dV + Vb = Vb + adv(2)*dV + pres_av = pres_av + adv(1)*pres*dV + Et = Et + q_cons_vf(E_idx)%sf(i, j, k)*dV end do end do + end do tmp = pres_av call s_mpi_allreduce_sum(tmp, pres_av) diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 1fd09dcd1b..9ebf401397 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -500,11 +500,11 @@ contains end if if (hypoelasticity .or. hyperelasticity) then - elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D - sys_size = stress_idx%end + elasticity = .true. + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end end if if (hyperelasticity) then @@ -542,7 +542,7 @@ contains internalEnergies_idx%end = adv_idx%end + num_fluids sys_size = internalEnergies_idx%end alf_idx = 1 ! dummy, cannot actually have a void fraction - + if (hypoelasticity) then stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index e125a33883..b54f8737c0 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -74,7 +74,7 @@ subroutine s_read_input_file parallel_io, rhoref, pref, bubbles, qbmm, sigR, & R0ref, nb, polytropic, thermal, Ca, Web, Re_inv, & polydisperse, poly_sigma, file_per_process, relax, & - relax_model, cf_wrt, sigma, adv_n, ib, sim_data, & + relax_model, cf_wrt, sigma, adv_n, ib, sim_data, & hyperelasticity ! Inquiring the status of the post_process.inp file @@ -324,7 +324,7 @@ subroutine s_save_data(t_step, varname, pres, c, H) -offset_x%beg:m + offset_x%end, & -offset_y%beg:n + offset_y%end, & -offset_z%beg:p + offset_z%end) - write (varname, '(A,I0)') 'tau', i + write (varname, '(A,I0)') 'tau', i call s_write_variable_to_formatted_database_file(varname, t_step) end if varname(:) = ' ' @@ -337,7 +337,7 @@ subroutine s_save_data(t_step, varname, pres, c, H) -offset_x%beg:m + offset_x%end, & -offset_y%beg:n + offset_y%end, & -offset_z%beg:p + offset_z%end) - write (varname, '(A,I0)') 'xi', i + write (varname, '(A,I0)') 'xi', i call s_write_variable_to_formatted_database_file(varname, t_step) end if varname(:) = ' ' @@ -659,7 +659,6 @@ subroutine s_save_data(t_step, varname, pres, c, H) call s_close_energy_data_file() end if - ! Closing the formatted database file call s_close_formatted_database_file() diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp index e07821f225..394f560b1f 100644 --- a/src/pre_process/include/2dHardcodedIC.fpp +++ b/src/pre_process/include/2dHardcodedIC.fpp @@ -11,7 +11,7 @@ #:def Hardcoded2D() select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case - + case (200) if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1d0/3d0)) then ! Volume Fractions @@ -68,7 +68,7 @@ q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(E_idx)%sf(i, j, 0)**(1d0/gam) - case (204) ! Rayleigh-taylor problem + case (204) ! Rayleigh-taylor problem rhoH = 3 rhoL = 1 pRef = 1e5 @@ -103,39 +103,39 @@ case (205) ! 2D lung wave interaction problem h = 0.0 !non dim origin y lam = 1.0 !non dim lambda - amp = patch_icpp(patch_id)%a2 !to be changed later! !non dim amplitude + amp = patch_icpp(patch_id)%a2 !to be changed later! !non dim amplitude - intH = amp*sin(2*pi*x_cc(i)/lam - pi/2)+h + intH = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h - if (y_cc(j) > intH) then + if (y_cc(j) > intH) then q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) - end if - - case (206) ! 2D lung wave interaction problem - horizontal domain + end if + + case (206) ! 2D lung wave interaction problem - horizontal domain h = 0.0 !non dim origin y lam = 1.0 !non dim lambda - amp = patch_icpp(patch_id)%a2 - - intL = amp*sin(2*pi*y_cc(j)/lam - pi/2)+h + amp = patch_icpp(patch_id)%a2 - if (x_cc(i) > intL) then !this is the liquid + intL = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h + + if (x_cc(i) > intL) then !this is the liquid q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) - end if - + end if + case default - if (proc_rank == 0) then + if (proc_rank == 0) then call s_int_to_str(patch_id, iStr) call s_mpi_abort("Invalid hcid specified for patch "//trim(iStr)) end if - + end select #:enddef diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 index 916c20f835..8b094de4a3 100644 --- a/src/pre_process/m_assign_variables.f90 +++ b/src/pre_process/m_assign_variables.f90 @@ -466,20 +466,20 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & theta = atan2(y_cc(k), x_cc(j)) phi = atan2(sqrt(x_cc(j)**2 + y_cc(k)**2), z_cc(l)) !spherical coord, assuming Rmax=1 - xi_sph = (rcoord**3 - R0ref**3 + 1d0)**(1d0/3d0) + xi_sph = (rcoord**3 - R0ref**3 + 1d0)**(1d0/3d0) xi_cart(1) = xi_sph*sin(phi)*cos(theta) xi_cart(2) = xi_sph*sin(phi)*sin(theta) xi_cart(3) = xi_sph*cos(phi) - else + else xi_cart(1) = x_cc(j) xi_cart(2) = y_cc(k) xi_cart(3) = z_cc(l) end if - + ! assigning the reference map to the q_prim vector field do i = 1, num_dims - q_prim_vf(i+xibeg-1)%sf(j,k,l) = eta*xi_cart(i) + & - (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1) + q_prim_vf(i + xibeg - 1)%sf(j, k, l) = eta*xi_cart(i) + & + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1) end do end if diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 06ed8d27c1..f30937bb5a 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -599,7 +599,7 @@ contains end if end if - if (hypoelasticity .or. hyperelasticity) then + if (hypoelasticity .or. hyperelasticity) then elasticity = .true. stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp index f81fe81636..869194b56a 100644 --- a/src/pre_process/m_initial_condition.fpp +++ b/src/pre_process/m_initial_condition.fpp @@ -257,7 +257,7 @@ contains ! STL patch elseif (patch_icpp(i)%geometry == 21) then call s_model(i, patch_id_fp, q_prim_vf) - + end if !> @} end do diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index 4d2ac4926b..b23668d2bd 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -240,9 +240,9 @@ contains subroutine s_check_inputs_hypoelasticity if (riemann_solver == 3) then call s_mpi_abort('hypoelasticity requires HLL '// & - '(riemann_solver = 1) or HLLC '// & - '(riemann_solver = 2) Riemann solver. '// & - 'Exiting ...') + '(riemann_solver = 1) or HLLC '// & + '(riemann_solver = 2) Riemann solver. '// & + 'Exiting ...') end if end subroutine diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index bf432effa2..f862aa8e14 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -335,10 +335,10 @@ contains call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c) if (c /= c) then - print *, 'crashed at processor: ', proc_rank,', at j :: ',j,', k :: ',k,' l :: ',l - print *, 'alpha1 ::', alpha(1),'and alpha2 ::',alpha(2), ' alpha3 :: ',alpha(3) - print *, 'alpha_rho1 ::', alpha_rho(1),', alpha_rho2 ::',alpha_rho(2), ' alpha_rho3 :: ',alpha_rho(3) - print *, 'E :: ',E,', pres :: ',pres,', rho :: ',rho + print *, 'crashed at processor: ', proc_rank, ', at j :: ', j, ', k :: ', k, ' l :: ', l + print *, 'alpha1 ::', alpha(1), 'and alpha2 ::', alpha(2), ' alpha3 :: ', alpha(3) + print *, 'alpha_rho1 ::', alpha_rho(1), ', alpha_rho2 ::', alpha_rho(2), ' alpha_rho3 :: ', alpha_rho(3) + print *, 'E :: ', E, ', pres :: ', pres, ', rho :: ', rho call s_mpi_abort('Exiting ...') end if diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index ddb4068f32..8e46a2161b 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -389,7 +389,7 @@ module m_global_parameters !$acc declare create(nb) #:endif - !$acc declare create(R0ref, Ca, Web, Re_inv, bubbles, polytropic, polydisperse, qbmm, nmomsp, nmomtot, R0_type, bubble_model, thermal, poly_sigma, adv_n, adap_dt, pi_fac) +!$acc declare create(R0ref, Ca, Web, Re_inv, bubbles, polytropic, polydisperse, qbmm, nmomsp, nmomtot, R0_type, bubble_model, thermal, poly_sigma, adv_n, adap_dt, pi_fac) #ifdef CRAY_ACC_WAR @:CRAY_DECLARE_GLOBAL(type(scalar_field), dimension(:), mom_sp) @@ -405,7 +405,7 @@ module m_global_parameters !> @name Physical bubble parameters (see Ando 2010, Preston 2007) !> @{ real(kind(0d0)) :: R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v - !$acc declare create(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v) +!$acc declare create(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v) #ifdef CRAY_ACC_WAR @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), k_n, k_v, pb0, mass_n0, mass_v0, Pe_T) @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN) @@ -443,8 +443,8 @@ module m_global_parameters integer :: bubxb, bubxe integer :: strxb, strxe integer :: xibeg, xiend - !$acc declare create(momxb, momxe, advxb, advxe, contxb, contxe, intxb, intxe, bubxb, bubxe, strxb, strxe) - !$acc declare create(xibeg,xiend) +!$acc declare create(momxb, momxe, advxb, advxe, contxb, contxe, intxb, intxe, bubxb, bubxe, strxb, strxe) +!$acc declare create(xibeg,xiend) #ifdef CRAY_ACC_WAR @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps) @@ -868,7 +868,7 @@ contains internalEnergies_idx%beg = adv_idx%end + 1 internalEnergies_idx%end = adv_idx%end + num_fluids sys_size = internalEnergies_idx%end - + if (hypoelasticity) then stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 diff --git a/src/simulation/m_hyperelastic.f90 b/src/simulation/m_hyperelastic.f90 index ef2302b70d..c7c660f186 100644 --- a/src/simulation/m_hyperelastic.f90 +++ b/src/simulation/m_hyperelastic.f90 @@ -15,7 +15,7 @@ module m_hyperelastic private; public :: s_calculate_cauchy_from_btensor - contains +contains !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. @@ -31,20 +31,20 @@ subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, ix, iy, iz) type(scalar_field), dimension(b_size), intent(IN) :: btensor type(int_bounds_info), intent(IN) :: ix, iy, iz - real(kind(0d0)), dimension(b_size-1) :: tensor + real(kind(0d0)), dimension(b_size - 1) :: tensor real(kind(0d0)) :: trace integer :: i, j, k, l !< Generic loop iterators !$acc parallel loop collapse(3) gang vector default(present) private(trace) do l = 0, p - do k = 0, n - do j = 0, m + do k = 0, n + do j = 0, m ! tensor is the symmetric tensor & calculate the trace of the tensor !trace = btensor(1)%sf(j,k,l) !if (num_dims == 2) then ! trace = trace + btensor(3)%sf(j,k,l) !else - trace = btensor(1)%sf(j,k,l) + btensor(4)%sf(j,k,l) + btensor(6)%sf(j,k,l) + trace = btensor(1)%sf(j, k, l) + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) !end if ! invariant calculation, saving it in the q_prim_vf field !invariant1 = btensor(1)%sf(j, k, l) @@ -55,27 +55,27 @@ subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, ix, iy, iz) !end if ! calculate the deviatoric of the tensor - btensor(1)%sf(j,k,l) = btensor(1)%sf(j,k,l) - (1d0/3d0)*trace + btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - (1d0/3d0)*trace !if (num_dims == 2) then ! btensor(3)%sf(j,k,l) = btensor(3)%sf(j,k,l) - (1d0/3d0)*trace !else - btensor(4)%sf(j,k,l) = btensor(4)%sf(j,k,l) - (1d0/3d0)*trace - btensor(6)%sf(j,k,l) = btensor(6)%sf(j,k,l) - (1d0/3d0)*trace + btensor(4)%sf(j, k, l) = btensor(4)%sf(j, k, l) - (1d0/3d0)*trace + btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - (1d0/3d0)*trace !end if ! dividing by the jacobian for neo-Hookean model ! setting the tensor to the stresses for riemann solver !$acc loop seq do i = 1, b_size - 1 - q_prim_vf(strxb+i)%sf(j, k, l) = btensor(i)%sf(j,k,l)/btensor(b_size)%sf(j, k, l) + q_prim_vf(strxb + i)%sf(j, k, l) = btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) end do ! compute the invariant without the elastic modulus - ! if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then - q_prim_vf(xiend+1)%sf(j,k,l) = 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) - ! else - ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 - ! end if + ! if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then + q_prim_vf(xiend + 1)%sf(j, k, l) = 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) + ! else + ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 + ! end if end do end do end do diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index 80cbfab5f8..b46781a582 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -235,7 +235,7 @@ contains & 'parallel_io', 'hypoelasticity', 'bubbles', 'polytropic', & & 'polydisperse', 'qbmm', 'monopole', 'probe_wrt', 'integral_wrt', & & 'prim_vars_wrt', 'weno_avg', 'file_per_process', 'relax', & - & 'adv_n', 'adap_dt', 'ib', 'bodyForces', 'bf_x', 'bf_y', 'bf_z', & + & 'adv_n', 'adap_dt', 'ib', 'bodyForces', 'bf_x', 'bf_y', 'bf_z', & & 'hyperelasticity' ] call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) #:endfor diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 9d2af70e81..f139c844a5 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -77,7 +77,7 @@ module m_rhs type(vector_field) :: q_prim_qp !< !$acc declare create(q_prim_qp) - !! The btensor at the cell-interior Gaussian quadrature points. + !! The btensor at the cell-interior Gaussian quadrature points. !! These tensor is needed to be calculated once and make the code DRY. type(vector_field) :: q_btensor !< !$acc declare create(q_btensor) @@ -798,9 +798,9 @@ contains !print *, "I got here B" call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") - if ( hyperelasticity ) then - ! call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) - end if + if (hyperelasticity) then + ! call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) + end if call nvtxEndRange call nvtxStartRange("RHS-MPI") diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index e0938310b7..e3f7b303eb 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -490,9 +490,9 @@ contains ! elastic energy update !if ( hyperelasticity ) then - ! G_L = 0d0 + ! G_L = 0d0 ! G_R = 0d0 - ! + ! ! !$acc loop seq ! do i = 1, num_fluids ! G_L = G_L + alpha_L(i)*Gs(i) @@ -509,8 +509,8 @@ contains ! end do ! !$acc loop seq ! do i = 1, b_size-1 - ! tau_e_L(i) = 0d0 - ! tau_e_R(i) = 0d0 + ! tau_e_L(i) = 0d0 + ! tau_e_R(i) = 0d0 ! end do ! !$acc loop seq ! do i = 1, num_dims @@ -520,7 +520,7 @@ contains ! end if !end if - ! Enthalpy with elastic energy + ! Enthalpy with elastic energy H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -548,7 +548,7 @@ contains end if if (wave_speeds == 1) then - if ( hypoelasticity ) then + if (hypoelasticity) then s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & (((4d0*G_L)/3d0) + & tau_e_L(dir_idx_tau(1)))/rho_L) & @@ -561,11 +561,11 @@ contains , vel_L(dir_idx(1)) + sqrt(c_L*c_L + & (((4d0*G_L)/3d0) + & tau_e_L(dir_idx_tau(1)))/rho_L)) - else if ( hyperelasticity ) then - s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L ) & - , vel_R(dir_idx(1)) - sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R )) - s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R ) & - , vel_L(dir_idx(1)) + sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L )) + else if (hyperelasticity) then + s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L) & + , vel_R(dir_idx(1)) - sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R)) + s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R) & + , vel_L(dir_idx(1)) + sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L)) else s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) @@ -634,7 +634,7 @@ contains - rho_R*vel_R(dir_idx(i)))) & /(s_M - s_P) end do - else if ( hypoelasticity ) then + else if (hypoelasticity) then !$acc loop seq do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & @@ -673,7 +673,7 @@ contains - s_P*vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) & + s_M*s_P*(E_L - E_R)) & /(s_M - s_P) - else if ( hypoelasticity ) then + else if (hypoelasticity) then !TODO: simplify this so it's not split into 3 if (num_dims == 1) then flux_rs${XYZ}$_vf(j, k, l, E_idx) = & @@ -715,7 +715,7 @@ contains end if ! Elastic Stresses - if ( hypoelasticity ) then + if (hypoelasticity) then do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & (s_M*(rho_R*vel_R(dir_idx(1)) & @@ -742,7 +742,7 @@ contains end do ! Xi field - !if ( hyperelasticity ) then + !if ( hyperelasticity ) then ! do i = 1, num_dims ! flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & ! (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & @@ -751,7 +751,7 @@ contains ! - rho_R*xi_field_R(i))) & ! /(s_M - s_P) ! end do - !end if + !end if ! Div(U)? !$acc loop seq @@ -948,14 +948,13 @@ contains flux_gsrc_vf, & norm_dir, ix, iy, iz) - #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] if (norm_dir == ${NORM_DIR}$) then - idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 + idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 - ! 6-EQUATION MODEL WITH HLLC + ! 6-EQUATION MODEL WITH HLLC if (model_eqns == 3) then !ME3 !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R) copyin(is1,is2,is3) @@ -1059,13 +1058,13 @@ contains E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R - + ! ADJUSTMENTS FOR HYPOELASTIC ENERGY if (hypoelasticity) then !$acc loop seq do i = 1, strxe - strxb + 1 - tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do G_L = 0d0; G_R = 0d0 !$acc loop seq @@ -1078,18 +1077,18 @@ contains if ((G_L > verysmall) .and. (G_R > verysmall)) then E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) - ! Additional terms in 2D and 3D - if ((i == 2) .or. (i == 4) .or. (i == 5)) then - E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) - E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) - end if + ! Additional terms in 2D and 3D + if ((i == 2) .or. (i == 4) .or. (i == 5)) then + E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) + E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) + end if end if end do end if ! ADJUSTMENTS FOR HYPERELASTIC ENERGY if (hyperelasticity) then - G_L = 0d0; G_R = 0d0; + G_L = 0d0; G_R = 0d0; !$acc loop seq do i = 1, num_fluids ! Mixture left and right shear modulus @@ -1101,14 +1100,14 @@ contains end do ! Elastic contribution to energy if G large enough if (G_L < verysmall) G_L = 0d0; - if (G_R < verysmall) G_R = 0d0; + if (G_R < verysmall) G_R = 0d0; E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) !$acc loop seq - do i = 1, b_size-1 - tau_e_L(i) = 0d0; tau_e_R(i) = 0d0; - !tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - !tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + do i = 1, b_size - 1 + tau_e_L(i) = 0d0; tau_e_R(i) = 0d0; + !tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + !tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do end if @@ -1137,21 +1136,21 @@ contains if (wave_speeds == 1) then if (elasticity) then s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & - (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & - (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & - tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & - rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & - rho_R*(s_R - vel_R(idx1))) - else + tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & + rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & + rho_R*(s_R - vel_R(idx1))) + else s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) - s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))*& - (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & - /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) + s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & + (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & + /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) end if elseif (wave_speeds == 2) then @@ -1188,138 +1187,137 @@ contains ! goes with the numerical velocity in x/y/z directions ! xi_P/M (pressure) = min/max(0. sgn(1,sL/sR)) - xi_MP = -min(0d0,sign(1d0,s_L)) - xi_PP = max(0d0,sign(1d0,s_R)) + xi_MP = -min(0d0, sign(1d0, s_L)) + xi_PP = max(0d0, sign(1d0, s_R)) ! COMPUTING FLUXES ! MASS FLUX. !$acc loop seq do i = 1, contxe - flux_rs${XYZ}$_vf(j, k, l, i) = & - xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & - xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) + flux_rs${XYZ}$_vf(j, k, l, i) = & + xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) end do ! MOMENTUM FLUX. ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) !$acc loop seq do i = 1, num_dims - idxi = dir_idx(i) - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & - xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi)+s_M*(xi_L*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))*vel_L(idxi))-vel_L(idxi))) + dir_flg(idxi)*(pres_L)) + & - xi_P*(rho_R*(vel_R(idx1)*vel_R(idxi)+s_P*(xi_R*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))*vel_R(idxi))-vel_R(idxi))) + dir_flg(idxi)*(pres_R)) + idxi = dir_idx(i) + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & + xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi) + s_M*(xi_L*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))*vel_L(idxi)) - vel_L(idxi))) + dir_flg(idxi)*(pres_L)) + & + xi_P*(rho_R*(vel_R(idx1)*vel_R(idxi) + s_P*(xi_R*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))*vel_R(idxi)) - vel_R(idxi))) + dir_flg(idxi)*(pres_R)) end do ! ENERGY FLUX. ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) flux_rs${XYZ}$_vf(j, k, l, E_idx) = & - xi_M*(vel_L(idx1)*(E_L + pres_L) + & - s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & - + xi_P*(vel_R(idx1)*(E_R + pres_R) + & - s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) - + xi_M*(vel_L(idx1)*(E_L + pres_L) + & + s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & + + xi_P*(vel_R(idx1)*(E_R + pres_R) + & + s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) ! ELASTICITY. Elastic shear stress terms for the momentum and energy flux if (elasticity) then - !$acc loop seq - do i = 1, num_dims - idxi = dir_idx(i) - ! MOMENTUM ELASTIC FLUX. - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & - -xi_M*tau_e_L(dir_idx_tau(i))-xi_P*tau_e_R(dir_idx_tau(i)) - ! ENERGY ELASTIC FLUX. - flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) - & - xi_M*( vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & - s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & - xi_P*( vel_R(idxi)*tau_e_R(dir_idx_tau(i)) + & - s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) - end do + !$acc loop seq + do i = 1, num_dims + idxi = dir_idx(i) + ! MOMENTUM ELASTIC FLUX. + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & + - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) + ! ENERGY ELASTIC FLUX. + flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) - & + xi_M*(vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & + s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & + xi_P*(vel_R(idxi)*tau_e_R(dir_idx_tau(i)) + & + s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) + end do end if ! HYPOELASTIC STRESS EVOLUTION FLUX. if (hypoelasticity) then - !$acc loop seq - do i = 1, strxe - strxb + 1 - flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & - xi_M*(s_S/(s_L-s_S))*(s_L*rho_L*tau_e_L(i)-rho_L*vel_L(idx1)*tau_e_L(i)) + & - xi_P*(s_S/(s_R-s_S))*(s_R*rho_R*tau_e_R(i)-rho_R*vel_R(idx1)*tau_e_R(i)) - end do + !$acc loop seq + do i = 1, strxe - strxb + 1 + flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & + xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & + xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) + end do end if ! VOLUME FRACTION FLUX. !$acc loop seq do i = advxb, advxe - flux_rs${XYZ}$_vf(j, k, l, i) = & - xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*s_S + & - xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*s_S + flux_rs${XYZ}$_vf(j, k, l, i) = & + xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*s_S + & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*s_S end do ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. !$acc loop seq do i = 1, num_dims - idxi = dir_idx(i) - vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & - xi_M*(vel_L(idxi)+dir_flg(idxi)*(s_S*(xi_MP*(xi_L-1) + 1)-vel_L(idxi))) + & - xi_P*(vel_R(idxi)+dir_flg(idxi)*(s_S*(xi_PP*(xi_R-1) + 1)-vel_R(idxi))) + idxi = dir_idx(i) + vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & + xi_M*(vel_L(idxi) + dir_flg(idxi)*(s_S*(xi_MP*(xi_L - 1) + 1) - vel_L(idxi))) + & + xi_P*(vel_R(idxi) + dir_flg(idxi)*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(idxi))) end do ! SURFACE TENSION FLUX. need to check if (.not. f_is_default(sigma)) then - flux_rs${XYZ}$_vf(j, k, l, c_idx) = & - (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & - xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S + flux_rs${XYZ}$_vf(j, k, l, c_idx) = & + (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S end if ! INTERNAL ENERGIES ADVECTION FLUX. ! K-th pressure and velocity in preparation for the internal energy flux - vel_K_Star = vel_L(idx1)*(1d0-xi_MP) + xi_MP*vel_R(idx1) + & - xi_MP*xi_PP*(s_S-vel_R(idx1)) + vel_K_Star = vel_L(idx1)*(1d0 - xi_MP) + xi_MP*vel_R(idx1) + & + xi_MP*xi_PP*(s_S - vel_R(idx1)) !$acc loop seq do i = 1, num_fluids - p_K_Star = xi_M*(xi_MP*((pres_L + pi_infs(i)/(1d0 + gammas(i)))* & - xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i))-pres_L)+pres_L)+ & - xi_P*(xi_PP*((pres_R + pi_infs(i)/(1d0 + gammas(i)))* & - xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i))-pres_R)+pres_R) - - flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & - (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & - (gammas(i)*p_K_Star + pi_infs(i)) + & - qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & - qvs(i))*vel_K_Star + p_K_Star = xi_M*(xi_MP*((pres_L + pi_infs(i)/(1d0 + gammas(i)))* & + xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - pres_L) + pres_L) + & + xi_P*(xi_PP*((pres_R + pi_infs(i)/(1d0 + gammas(i)))* & + xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - pres_R) + pres_R) + + flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & + (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & + (gammas(i)*p_K_Star + pi_infs(i)) + & + qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & + qvs(i))*vel_K_Star end do flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) ! correction pressure for the cylindrical terms - p_Star = xi_M*( pres_L + xi_MP*rho_L*(s_L - & - vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1)))) + & - xi_P*( pres_R + xi_PP*rho_R*(s_R - & - vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1)))) + p_Star = xi_M*(pres_L + xi_MP*rho_L*(s_L - & + vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1)))) + & + xi_P*(pres_R + xi_PP*rho_R*(s_R - & + vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1)))) ! Geometrical source flux for cylindrical coordinates #:if (NORM_DIR == 2) - if (cyl_coord) then - !Substituting the advective flux into the inviscid geometrical source flux - !$acc loop seq - do i = 1, E_idx - flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) - end do - !$acc loop seq - do i = intxb, intxe - flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) - end do - ! Recalculating the radial momentum geometric source flux - flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & - flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star - ! Geometrical source of the void fraction(s) is zero - !$acc loop seq - do i = advxb, advxe - flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 - end do - end if + if (cyl_coord) then + !Substituting the advective flux into the inviscid geometrical source flux + !$acc loop seq + do i = 1, E_idx + flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) + end do + !$acc loop seq + do i = intxb, intxe + flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) + end do + ! Recalculating the radial momentum geometric source flux + flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & + flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star + ! Geometrical source of the void fraction(s) is zero + !$acc loop seq + do i = advxb, advxe + flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 + end do + end if #:endif #:if (NORM_DIR == 3) if (grid_geometry == 3) then @@ -1328,7 +1326,7 @@ contains flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 end do flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & - flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star + flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) end if @@ -2037,7 +2035,7 @@ contains end do end do !$acc end parallel loop - else + else ! TODO 5-EQUATION MODEL WITH HLLC, INTERFACE CAPTURING ONLY !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, tau_e_L, tau_e_R, G_L, G_R) copyin(is1,is2,is3) do l = is3%beg, is3%end @@ -2147,8 +2145,8 @@ contains if (hypoelasticity) then !$acc loop seq do i = 1, strxe - strxb + 1 - tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do G_L = 0d0; G_R = 0d0 !$acc loop seq @@ -2162,7 +2160,7 @@ contains if ((G_L > verysmall) .and. (G_R > verysmall)) then E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) - ! Additional terms in 2D and 3D + ! Additional terms in 2D and 3D if ((i == 2) .or. (i == 4) .or. (i == 5)) then E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) @@ -2170,10 +2168,10 @@ contains end if end do end if - + H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R - + @:compute_average_state() call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & @@ -2197,22 +2195,22 @@ contains end if if (wave_speeds == 1) then if (hypoelasticity) then - s_L = min(vel_L(dir_idx(1)) - & - sqrt(c_L*c_L + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), & - vel_R(dir_idx(1)) - & - sqrt(c_R*c_R + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) - s_R = max(vel_R(dir_idx(1)) + & - sqrt(c_R*c_R + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), & - vel_L(dir_idx(1)) + & - sqrt(c_L*c_L + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) + s_L = min(vel_L(dir_idx(1)) - & + sqrt(c_L*c_L + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), & + vel_R(dir_idx(1)) - & + sqrt(c_R*c_R + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) + s_R = max(vel_R(dir_idx(1)) + & + sqrt(c_R*c_R + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), & + vel_L(dir_idx(1)) + & + sqrt(c_L*c_L + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)* & (s_L - vel_L(idx1)) - & rho_R*vel_R(idx1)* & (s_R - vel_R(idx1))) & - /(rho_L*(s_L - vel_L(idx1)) - & - rho_R*(s_R - vel_R(idx1))) + /(rho_L*(s_L - vel_L(idx1)) - & + rho_R*(s_R - vel_R(idx1))) else s_L = min(vel_L(idx1) - c_L, vel_R(idx1) - c_R) @@ -2222,9 +2220,9 @@ contains (s_L - vel_L(idx1)) - & rho_R*vel_R(idx1)* & (s_R - vel_R(idx1))) & - /(rho_L*(s_L - vel_L(idx1)) - & - rho_R*(s_R - vel_R(idx1))) - end if + /(rho_L*(s_L - vel_L(idx1)) - & + rho_R*(s_R - vel_R(idx1))) + end if elseif (wave_speeds == 2) then pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & @@ -2276,59 +2274,59 @@ contains ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) !$acc loop seq do i = 1, num_dims - idxi = dir_idx(i) - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & - xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi)+s_M*(xi_L*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))*vel_L(idxi))-vel_L(idxi))) + dir_flg(idxi)*(pres_L)) + & - xi_P*(rho_R*(vel_R(idx1)*vel_R(idxi)+s_P*(xi_R*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))*vel_R(idxi))-vel_R(idxi))) + dir_flg(idxi)*(pres_R)) + idxi = dir_idx(i) + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & + xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi) + s_M*(xi_L*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))*vel_L(idxi)) - vel_L(idxi))) + dir_flg(idxi)*(pres_L)) + & + xi_P*(rho_R*(vel_R(idx1)*vel_R(idxi) + s_P*(xi_R*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))*vel_R(idxi)) - vel_R(idxi))) + dir_flg(idxi)*(pres_R)) end do ! ENERGY FLUX. ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) flux_rs${XYZ}$_vf(j, k, l, E_idx) = & - xi_M*( vel_L(idx1)*(E_L + pres_L) + & - s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) + & - xi_P*(vel_R(idx1)*(E_R + pres_R) + & - s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) + xi_M*(vel_L(idx1)*(E_L + pres_L) + & + s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) + & + xi_P*(vel_R(idx1)*(E_R + pres_R) + & + s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) ! Additional elastic shear stress terms for the energy flux. if (elasticity) then - !$acc loop seq - do i = 1, num_dims - idxi = dir_idx(i) - ! MOMENTUM ELASTIC FLUX. - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & - -xi_M*tau_e_L(dir_idx_tau(i))-xi_P*tau_e_R(dir_idx_tau(i)) - ! ENERGY ELASTIC FLUX. - flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) - & - xi_M*( vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & - s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & - xi_P*( vel_R(idxi)*tau_e_R(dir_idx_tau(i)) + & - s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) - end do + !$acc loop seq + do i = 1, num_dims + idxi = dir_idx(i) + ! MOMENTUM ELASTIC FLUX. + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & + - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) + ! ENERGY ELASTIC FLUX. + flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) - & + xi_M*(vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & + s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & + xi_P*(vel_R(idxi)*tau_e_R(dir_idx_tau(i)) + & + s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) + end do end if ! HYPOELASTIC STRESS EVOLUTION FLUX. if (hypoelasticity) then - !$acc loop seq - do i = 1, strxe - strxb + 1 - flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & - xi_M*(s_S/(s_L-s_S))*(s_L*rho_L*tau_e_L(i)-rho_L*vel_L(idx1)*tau_e_L(i)) + & - xi_P*(s_S/(s_R-s_S))*(s_R*rho_R*tau_e_R(i)-rho_R*vel_R(idx1)*tau_e_R(i)) - end do + !$acc loop seq + do i = 1, strxe - strxb + 1 + flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & + xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & + xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) + end do end if ! VOLUME FRACTION FLUX. !$acc loop seq do i = advxb, advxe flux_rs${XYZ}$_vf(j, k, l, i) = & - xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) *(vel_L(idx1) + s_M*(xi_L - 1d0)) + & - xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) + xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) end do - ! VOLUME FRACTION SOURCE FLUX. + ! VOLUME FRACTION SOURCE FLUX. !$acc loop seq do i = 1, num_dims idxi = dir_idx(i) @@ -2341,9 +2339,9 @@ contains ! SURFACE TENSION FLUX. need to check if (.not. f_is_default(sigma)) then - flux_rs${XYZ}$_vf(j, k, l, c_idx) = & - (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & - xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S + flux_rs${XYZ}$_vf(j, k, l, c_idx) = & + (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S end if ! Geometrical source flux for cylindrical coordinates @@ -2640,7 +2638,7 @@ contains !$acc update device(is1, is2, is3) - if ( elasticity ) then + if (elasticity) then if (norm_dir == 1) then dir_idx_tau = (/1, 2, 4/) else if (norm_dir == 2) then From cf9fd2b177c3b653ef1162da3149e0d84ccf4354 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 7 Jul 2024 01:42:01 -0500 Subject: [PATCH 226/380] debugged ACC syncronization issue, working HLLC+hypo+6eq --- src/simulation/m_rhs.fpp | 4 ++-- src/simulation/m_riemann_solvers.fpp | 31 ++++++++++++++++++---------- src/simulation/m_start_up.fpp | 4 ++-- submit_test.sh | 10 ++++++--- 4 files changed, 31 insertions(+), 18 deletions(-) diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index f139c844a5..11814541db 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -798,9 +798,9 @@ contains !print *, "I got here B" call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") - if (hyperelasticity) then + !if (hyperelasticity) then ! call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) - end if + !end if call nvtxEndRange call nvtxStartRange("RHS-MPI") diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index e3f7b303eb..8f17469c77 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -923,6 +923,8 @@ contains real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star, vel_K_Star real(kind(0d0)) :: pres_SL, pres_SR, Ms_L, Ms_R real(kind(0d0)) :: start, finish + real(kind(0d0)) :: flux_ene_e + integer :: i, j, k, l, q !< Generic loop iterators integer :: idx1, idxi @@ -957,7 +959,7 @@ contains ! 6-EQUATION MODEL WITH HLLC if (model_eqns == 3) then !ME3 - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R) copyin(is1,is2,is3) + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -1072,6 +1074,7 @@ contains G_L = G_L + alpha_L(i)*Gs(i) G_R = G_R + alpha_R(i)*Gs(i) end do + !$acc loop seq do i = 1, strxe - strxb + 1 ! Elastic contribution to energy if G large enough if ((G_L > verysmall) .and. (G_R > verysmall)) then @@ -1089,7 +1092,7 @@ contains ! ADJUSTMENTS FOR HYPERELASTIC ENERGY if (hyperelasticity) then G_L = 0d0; G_R = 0d0; - !$acc loop seq + !$acc loop seq reduction(+:G_L,G_R) do i = 1, num_fluids ! Mixture left and right shear modulus G_L = G_L + alpha_L(i)*Gs(i) @@ -1201,7 +1204,7 @@ contains ! MOMENTUM FLUX. ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) - !$acc loop seq + !$acc loop seq private(idxi) do i = 1, num_dims idxi = dir_idx(i) flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & @@ -1221,20 +1224,26 @@ contains ! ELASTICITY. Elastic shear stress terms for the momentum and energy flux if (elasticity) then - !$acc loop seq + flux_ene_e = 0d0; + !$acc loop seq private(idxi) do i = 1, num_dims idxi = dir_idx(i) ! MOMENTUM ELASTIC FLUX. flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) - ! ENERGY ELASTIC FLUX. - flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) - & - xi_M*(vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & - s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & - xi_P*(vel_R(idxi)*tau_e_R(dir_idx_tau(i)) + & - s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) end do + ! ENERGY ELASTIC FLUX. + !$acc loop seq private(idxi) reduction(+:flux_ene_e) + do i = 1, num_dims + idxi = dir_idx(i) + flux_ene_e = flux_ene_e - & + xi_M*(vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & + s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & + xi_P*(vel_R(idxi)*tau_e_R(dir_idx_tau(i)) + & + s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) + end do + flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e end if ! HYPOELASTIC STRESS EVOLUTION FLUX. @@ -1256,7 +1265,7 @@ contains end do ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. - !$acc loop seq + !$acc loop seq private(idxi) do i = 1, num_dims idxi = dir_idx(i) vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 1d96ce8d2e..3951d6b6a3 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -1274,7 +1274,7 @@ contains call acc_present_dump() #endif - if (elasticity) call s_initialize_hypoelastic_module() + if (hypoelasticity) call s_initialize_hypoelastic_module() if (relax) call s_initialize_phasechange_module() call s_initialize_data_output_module() call s_initialize_derived_variables_module() @@ -1425,7 +1425,7 @@ contains s_write_data_files => null() call s_finalize_time_steppers_module() - if (elasticity) call s_finalize_hypoelastic_module() + if (hypoelasticity) call s_finalize_hypoelastic_module() call s_finalize_derived_variables_module() call s_finalize_data_output_module() call s_finalize_rhs_module() diff --git a/submit_test.sh b/submit_test.sh index f95bcd03f7..894fcb3bc3 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -4,9 +4,13 @@ #./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run ./examples/3D_phasechange_bubble/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta +#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta + +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta From 4d14ae8df4e2af8c1c142607157cca57d573ad13 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 7 Jul 2024 17:22:58 -0500 Subject: [PATCH 227/380] retesting for the synchronization error, compiles and passes test suite --- src/common/m_phase_change.fpp | 12 +--- src/simulation/m_rhs.fpp | 4 +- src/simulation/m_riemann_solvers.fpp | 84 +++++++++++++--------------- submit_test.sh | 3 + 4 files changed, 45 insertions(+), 58 deletions(-) diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index e6effa17ad..3bbbee7e24 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -1,11 +1,3 @@ -!> -!! @file m_phase_change.fpp -!! @brief Contains module m_phasechange - -#:include 'macros.fpp' - -!> @brief This module is used to relax the model equations (6-eqn model) -!> towards pressure and temperature (6-eqn to 4-eqn), and (if wanted) Gibbs free !> energies (6-eqn to 4-eqn) equilibrium through an infinitely fast (algebraic) !> procedure. module m_phase_change @@ -358,7 +350,7 @@ contains ns = 0 ! change this relative error metric. 1E4 is arbitrary do while ((DABS(pS - pO) > palpha_eps) .and. & - (DABS((pS - pO)/pO) > palpha_eps/1d2) .or. (ns == 0)) + (DABS((pS - pO)/pO) > palpha_eps/1d1) .or. (ns == 0)) ! increasing counter ns = ns + 1 @@ -448,7 +440,7 @@ contains R2D(1) = 0.0d0; R2D(2) = 0.0d0 DeltamP(1) = 0.0d0; DeltamP(2) = 0.0d0 do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & - .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d2))) & + .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d1))) & .or. (ns == 0)) ! Updating counter for the iterative procedure diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 11814541db..bf280de440 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -797,11 +797,11 @@ contains call nvtxEndRange !print *, "I got here B" - call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") + !call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") !if (hyperelasticity) then ! call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) !end if - call nvtxEndRange + !call nvtxEndRange call nvtxStartRange("RHS-MPI") call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 8f17469c77..99b14b6ac6 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -959,7 +959,7 @@ contains ! 6-EQUATION MODEL WITH HLLC if (model_eqns == 3) then !ME3 - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R) + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R, flux_ene_e) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -1092,7 +1092,7 @@ contains ! ADJUSTMENTS FOR HYPERELASTIC ENERGY if (hyperelasticity) then G_L = 0d0; G_R = 0d0; - !$acc loop seq reduction(+:G_L,G_R) + !$acc loop seq do i = 1, num_fluids ! Mixture left and right shear modulus G_L = G_L + alpha_L(i)*Gs(i) @@ -1139,11 +1139,11 @@ contains if (wave_speeds == 1) then if (elasticity) then s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & - (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & - (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & @@ -1204,14 +1204,14 @@ contains ! MOMENTUM FLUX. ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) - !$acc loop seq private(idxi) + !$acc loop seq do i = 1, num_dims - idxi = dir_idx(i) - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & - xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi) + s_M*(xi_L*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))*vel_L(idxi)) - vel_L(idxi))) + dir_flg(idxi)*(pres_L)) + & - xi_P*(rho_R*(vel_R(idx1)*vel_R(idxi) + s_P*(xi_R*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))*vel_R(idxi)) - vel_R(idxi))) + dir_flg(idxi)*(pres_R)) + !idxi = dir_idx(i) + flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & + xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & + (1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & + xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & + (1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) end do ! ENERGY FLUX. @@ -1223,37 +1223,29 @@ contains s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) ! ELASTICITY. Elastic shear stress terms for the momentum and energy flux - if (elasticity) then + if (hypoelasticity) then flux_ene_e = 0d0; - !$acc loop seq private(idxi) - do i = 1, num_dims - idxi = dir_idx(i) - ! MOMENTUM ELASTIC FLUX. - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & - - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) - end do + !$acc loop seq + do i = 1, num_dims + ! MOMENTUM ELASTIC FLUX. + flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & + flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) & + - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) ! ENERGY ELASTIC FLUX. - !$acc loop seq private(idxi) reduction(+:flux_ene_e) - do i = 1, num_dims - idxi = dir_idx(i) - flux_ene_e = flux_ene_e - & - xi_M*(vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & - s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & - xi_P*(vel_R(idxi)*tau_e_R(dir_idx_tau(i)) + & - s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) - end do + flux_ene_e = flux_ene_e - & + xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & + s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & + xi_P*(vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & + s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) + end do flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e - end if - - ! HYPOELASTIC STRESS EVOLUTION FLUX. - if (hypoelasticity) then - !$acc loop seq - do i = 1, strxe - strxb + 1 - flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & - xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & - xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) - end do + ! HYPOELASTIC STRESS EVOLUTION FLUX. + !$acc loop seq + do i = 1, strxe - strxb + 1 + flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & + xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & + xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) + end do end if ! VOLUME FRACTION FLUX. @@ -1265,12 +1257,12 @@ contains end do ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. - !$acc loop seq private(idxi) + !$acc loop seq do i = 1, num_dims - idxi = dir_idx(i) - vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & - xi_M*(vel_L(idxi) + dir_flg(idxi)*(s_S*(xi_MP*(xi_L - 1) + 1) - vel_L(idxi))) + & - xi_P*(vel_R(idxi) + dir_flg(idxi)*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(idxi))) + !idxi = dir_idx(i) + vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = & + xi_M*(vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_MP*(xi_L - 1) + 1) - vel_L(dir_idx(i)))) + & + xi_P*(vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(dir_idx(i)))) end do ! SURFACE TENSION FLUX. need to check diff --git a/submit_test.sh b/submit_test.sh index 894fcb3bc3..875658781b 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -12,6 +12,9 @@ ./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta +#./mfc.sh run /scratch/bciv/mcarcanabarbosa/testingpc4f/4testing/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta + #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta From 7b6656e712bd0592a7f0d67db9f7b77bd58840cd Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 7 Jul 2024 18:37:36 -0500 Subject: [PATCH 228/380] HLLC + hypo + 6equation, operational --- src/post_process/m_global_parameters.fpp | 10 ++++++---- src/simulation/m_global_parameters.fpp | 11 ++++++----- src/simulation/m_rhs.fpp | 22 +++++++++++++++------- submit_test.sh | 2 +- 4 files changed, 28 insertions(+), 17 deletions(-) diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 9ebf401397..4712ddd024 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -543,10 +543,12 @@ contains sys_size = internalEnergies_idx%end alf_idx = 1 ! dummy, cannot actually have a void fraction - if (hypoelasticity) then - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - sys_size = stress_idx%end + if (hypoelasticity .or. hyperelasticity) then + elasticity = .true. + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end end if if (.not. f_is_default(sigma)) then diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 8e46a2161b..508ec20750 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -869,11 +869,12 @@ contains internalEnergies_idx%end = adv_idx%end + num_fluids sys_size = internalEnergies_idx%end - if (hypoelasticity) then - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D - sys_size = stress_idx%end + if (hypoelasticity .or. hyperelasticity) then + elasticity = .true. + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end end if if (.not. f_is_default(sigma)) then diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index bf280de440..428492259a 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -254,7 +254,7 @@ contains @:ALLOCATE(q_cons_qp%vf(1:sys_size)) @:ALLOCATE(q_prim_qp%vf(1:sys_size)) - !@:ALLOCATE(q_btensor%vf(1:b_size)) + @:ALLOCATE(q_btensor%vf(1:b_size)) do l = 1, sys_size @:ALLOCATE(q_cons_qp%vf(l)%sf(ix%beg:ix%end, iy%beg:iy%end, iz%beg:iz%end)) @@ -278,11 +278,14 @@ contains end if - !do l = 1, b_size - ! @:ALLOCATE(q_btensor%vf(l)%sf(ix%beg:ix%end, iy%beg:iy%end, iz%beg:iz%end)) - !end do + @:ACC_SETUP_VFs(q_cons_qp, q_prim_qp) - @:ACC_SETUP_VFs(q_cons_qp, q_prim_qp, q_btensor) + if (hyperelasticity) then + do l = 1, b_size + @:ALLOCATE(q_btensor%vf(l)%sf(ix%beg:ix%end, iy%beg:iy%end, iz%beg:iz%end)) + end do + @:ACC_SETUP_VFs(q_btensor) + end if do l = 1, cont_idx%end q_prim_qp%vf(l)%sf => q_cons_qp%vf(l)%sf @@ -792,8 +795,13 @@ contains q_cons_qp%vf, & q_prim_qp%vf, & gm_alpha_qp%vf, & - ix, iy, iz, & - q_btensor%vf) + ix, iy, iz) +! call s_convert_conservative_to_primitive_variables( & +! q_cons_qp%vf, & +! q_prim_qp%vf, & +! gm_alpha_qp%vf, & +! ix, iy, iz, & +! q_btensor%vf) call nvtxEndRange !print *, "I got here B" diff --git a/submit_test.sh b/submit_test.sh index 875658781b..e0225d8d22 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -8,7 +8,7 @@ #./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta From c9a7f110b56f3006e3971f4e63305b643e14ec17 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 9 Jul 2024 15:44:11 -0400 Subject: [PATCH 229/380] rearranging the btensor calculation --- src/common/m_variables_conversion.fpp | 596 +---------------------- src/common/m_xi_tensor_calc.f90 | 553 ++++++++++++++++++++- src/post_process/m_global_parameters.fpp | 10 + src/pre_process/m_global_parameters.fpp | 10 + src/simulation/m_global_parameters.fpp | 11 + src/simulation/m_rhs.fpp | 10 +- src/simulation/m_riemann_solvers.fpp | 8 +- submit_test.sh | 6 +- 8 files changed, 621 insertions(+), 583 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 2f1dec575e..1654d79e6f 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1015,13 +1015,14 @@ contains end do end if - !if ( hyperelasticity ) then - ! !$acc loop seq - ! do i = xibeg, xiend - ! ! qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K - ! !print *, 'i ::',i,',j,k,l ::',j,k,l,', qprim ::',qK_prim_vf(i)%sf(j,k,l) - ! end do - !end if + if ( hyperelasticity ) then + !$acc loop seq + do i = xibeg, xiend + qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K + !print *, 'i ::',i,',j,k,l ::',j,k,l,', qprim ::',qK_prim_vf(i)%sf(j,k,l) + end do + end if + !$acc loop seq do i = advxb, advxe qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) @@ -1040,7 +1041,7 @@ contains #ifdef MFC_SIMULATION if (hyperelasticity) then - !call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf, 0, m, 0, n, 0, p) + call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf, 0, m, 0, n, 0, p) !print *, 'I got here AAA' !!$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) !do l = izb, ize @@ -1127,9 +1128,9 @@ contains integer :: i, j, k, l, q !< Generic loop iterators #ifndef MFC_SIMULATION - !do l = 1, b_size - ! @:ALLOCATE(q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) - !end do + do l = 1, b_size + @:ALLOCATE(q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) + end do ! going through hyperelasticity again due to the btensor calculation ! s_calculate_btensor has its own triple nested for loop, with openacc @@ -1246,16 +1247,16 @@ contains end if ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 - !if (hyperelasticity) then - ! adding the elastic contribution - !do i = xibeg, xiend - !q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) - !end do - !if (G > 1000) then - !q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - ! G*f_elastic_energy(q_btensor, j, k, l) - !end if - !end if + if (hyperelasticity) then + ! adding the elastic contribution + do i = xibeg, xiend + q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) + end do + if (G > verysmall) then + q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & + G*f_elastic_energy(q_btensor, j, k, l) + end if + end if if (.not. f_is_default(sigma)) then q_cons_vf(c_idx)%sf(j, k, l) = q_prim_vf(c_idx)%sf(j, k, l) @@ -1265,6 +1266,10 @@ contains end do end do + ! deallocating the btensor + do l = 1, b_size + @:DEALLOCATE(q_btensor(l)%sf) + end do #else if (proc_rank == 0) then @@ -1408,557 +1413,8 @@ contains end do end do #endif - end subroutine s_convert_primitive_to_flux_variables - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_calculate_btensor(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) - - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(INOUT) :: btensor - integer, intent(IN) :: xb, xe, yb, ye, zb, ze - real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb - integer :: j, k, l - - do l = zb, ze - do k = yb, ye - do j = xb, xe - call s_compute_gradient_xi(q_prim_vf, xb, xe, yb, & - ye, zb, ze, j, k, l, tensora, tensorb) - ! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensorb(1) - !if (num_dims > 1) then ! 2D - btensor(2)%sf(j, k, l) = tensorb(2) - ! btensor(3)%sf(j,k,l) = tensorb(4) - !end if - !if (num_dims > 2) then ! 3D - btensor(3)%sf(j, k, l) = tensorb(3) - btensor(4)%sf(j, k, l) = tensorb(5) - btensor(5)%sf(j, k, l) = tensorb(6) - btensor(6)%sf(j, k, l) = tensorb(9) - !end if - ! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j, k, l) = tensorb(tensor_size) - end do - end do - end do - end subroutine s_calculate_btensor - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_calculate_btensor_acc(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) - - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(inout) :: btensor - integer, intent(in) :: xb, xe, yb, ye, zb, ze - real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb - integer :: j, k, l, i - -! if (num_dims == 1) then -!! !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) -! do l = izb, ize -! do k = iyb, iye -! do j = ixb, ixe -! call s_compute_gradient_xi1d_acc(q_prim_vf, ixb, ixe, iyb, & -! iye, izb, ize, j, k, l, tensora, tensorb) -! !! 1: 1D, 3: 2D, 6: 3D -! btensor(1)%sf(j, k, l) = tensorb(1) -! !! store the determinant at the last entry of the btensor sf -! btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) -! end do -! end do -! end do -! !$acc end parallel loop -! else if (num_dims == 2) then ! 2D -! !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) -! do l = izb, ize -! do k = iyb, iye -! do j = ixb, ixe -! call s_compute_gradient_xi2d_acc(q_prim_vf, ixb, ixe, iyb, & -! iye, izb, ize, j, k, l, tensora, tensorb) -! !! 1: 1D, 3: 2D, 6: 3D -! btensor(1)%sf(j, k, l) = tensorb(1) -! btensor(2)%sf(j,k,l) = tensorb(2) -! btensor(3)%sf(j,k,l) = tensorb(4) -! !! store the determinant at the last entry of the btensor sf -! btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) -! end do -! end do -! end do -! !$acc end parallel loop -! else ! 3D - - !print *,'I got here AAAA' - !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) - do l = zb, ze - do k = yb, ye - do j = xb, xe - ! STEP 1: computing the grad_xi tensor - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - - ! 1D - if (j == xb) then - ! dxix/dx - !print *, ' grid check xb :: ',q_prim_vf(xibeg)%sf(j, k, l) - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - ! dxiy / dx - tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - ! dxiz / dx - tensora(3) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - !print *, ' grid check xb :: ',tensora(1),tensora(2),tensora(7) - - else if (j == xb + 1) then - !print *, ' grid check xb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + q_prim_vf(xibeg)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(3) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + q_prim_vf(xiend)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - !print *, ' grid check xb1 :: ',tensora(1),tensora(2),tensora(7) - - else if (j == xe - 1) then - !print *, ' grid check xe1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - q_prim_vf(xibeg)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(3) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - q_prim_vf(xiend)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - !print *, ' grid check xe1 :: ',tensora(1),tensora(2),tensora(7) - - else if (j == xe) then - !print *, ' grid check xe :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix/dx - tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(3) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - !print *, ' grid check xe :: ',tensora(1),tensora(2),tensora(7) - - else - ! dxix/dx - tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(3) = (q_prim_vf(xiend)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - q_prim_vf(xiend)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - - end if - - ! 2D - if (k == yb) then - !print *, ' grid check yb :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dy - tensora(4) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - ! dxiy / dy - tensora(5) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - ! dxiz / dy - tensora(6) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - !print *, ' grid check yb :: ',tensora(4),tensora(5),tensora(8) - - else if (k == yb + 1) then - !print *, ' grid check yb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dy - tensora(4) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + q_prim_vf(xibeg)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(6) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + q_prim_vf(xiend)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - !print *, ' grid check yb1 :: ',tensora(4),tensora(5),tensora(8) - - else if (k == ye - 1) then - !print *, ' grid check ye1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dy - tensora(4) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - q_prim_vf(xibeg)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(6) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - q_prim_vf(xiend)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - !print *, ' grid check yb1 :: ',tensora(4),tensora(5),tensora(8) - - else if (k == ye) then - !print *, ' grid check ye :: ',q_prim_vf(xibeg+1)%sf(j, k, l) - - ! dxix / dy - tensora(4) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(6) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxix / dy - tensora(4) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(6) = (q_prim_vf(xiend)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - ! 3D - if (l == zb) then - !print *, ' grid check zb :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dz - tensora(7) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xibeg)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xibeg)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiy / dz - tensora(8) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiz / dz - tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xiend)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xiend)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xiend)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == zb + 1) then - !print *, ' grid check zb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dz - tensora(7) = (-3d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & - + q_prim_vf(xibeg)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(8) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & - + q_prim_vf(xibeg + 1)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xiend)%sf(j, k, l + 2) & - + q_prim_vf(xiend)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze - 1) then - !print *, ' grid check ze1 :: ',q_prim_vf(xiend)%sf(j, k, l) - - ! dxix / dz - tensora(7) = (3d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & - - q_prim_vf(xibeg)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(8) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - q_prim_vf(xibeg + 1)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xiend)%sf(j, k, l - 2) & - - q_prim_vf(xiend)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze) then - !print *, ' grid check ze :: ',q_prim_vf(xiend)%sf(j, k, l) - - ! dxix / dz - tensora(7) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xibeg)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xibeg)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(8) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xiend)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xiend)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xiend)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxix / dz - tensora(7) = (q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - q_prim_vf(xibeg)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(8) = (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (q_prim_vf(xiend)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - q_prim_vf(xiend)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - - !print *, 'I got here AAAAA' - - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) - tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) - tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) - tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) - tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) - tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) - tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) - tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) - tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) - - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & - + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - - !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 3d0 ) then - ! print *, 'j, k, l :: ', j, k, l - ! do i = 1, 9 - ! print *,'i :: ',i,', ten :: ',tensorb(i) - ! end do - ! print *, 'det : ',tensorb(tensor_size) - ! tensorb(tensor_size) = 1d0 - !end if - - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse - ! STEP 4: store the determinant of F in the last entry of the tensor - - !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 2d0 ) then - tensorb(tensor_size) = 1d0 - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = 0d0 - end do - tensorb(1) = 1d0 - tensorb(5) = 1d0 - tensorb(9) = 1d0 - !end if - - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - !print *, 'I got here A6' - ! STEP 3: computing F tranpose F - !tensorb(1) = tensora(1)**2 - tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 - tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 - tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) - tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) - tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) - tensorb(4) = tensorb(2) - tensorb(7) = tensorb(3) - tensorb(8) = tensorb(6) - !print *, 'I got here A7' - !call s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, & - !iye, izb, ize, j, k, l, tensora, tensorb) - !! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensorb(1) - btensor(2)%sf(j, k, l) = tensorb(2) - btensor(3)%sf(j, k, l) = tensorb(3) - btensor(4)%sf(j, k, l) = tensorb(5) - btensor(5)%sf(j, k, l) = tensorb(6) - btensor(6)%sf(j, k, l) = tensorb(9) - !print *, 'I got here A8' - !! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j, k, l) = tensorb(tensor_size) - end do - end do - end do - !$acc end parallel loop - !print *, 'I got here A9' -! end if - end subroutine s_calculate_btensor_acc - subroutine s_finalize_variables_conversion_module() ! ------------------ integer :: i !< Generic loop iterators diff --git a/src/common/m_xi_tensor_calc.f90 b/src/common/m_xi_tensor_calc.f90 index 9f4b6e76f5..aa993c8662 100644 --- a/src/common/m_xi_tensor_calc.f90 +++ b/src/common/m_xi_tensor_calc.f90 @@ -19,7 +19,9 @@ module m_xi_tensor_calc s_compute_gradient_xi1d_acc, & s_compute_gradient_xi2d_acc, & s_compute_gradient_xi3d_acc, & - f_elastic_energy + f_elastic_energy, & + s_calculate_btensor, & + s_calculate_btensor_acc contains @@ -1224,5 +1226,552 @@ function f_elastic_energy(btensor, j, k, l) end function f_elastic_energy -end module m_xi_tensor_calc + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_calculate_btensor(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(INOUT) :: btensor + integer, intent(IN) :: xb, xe, yb, ye, zb, ze + real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb + integer :: j, k, l + + do l = zb, ze + do k = yb, ye + do j = xb, xe + call s_compute_gradient_xi(q_prim_vf, xb, xe, yb, & + ye, zb, ze, j, k, l, tensora, tensorb) + ! 1: 1D, 3: 2D, 6: 3D + btensor(1)%sf(j, k, l) = tensorb(1) + !if (num_dims > 1) then ! 2D + btensor(2)%sf(j, k, l) = tensorb(2) + ! btensor(3)%sf(j,k,l) = tensorb(4) + !end if + !if (num_dims > 2) then ! 3D + btensor(3)%sf(j, k, l) = tensorb(3) + btensor(4)%sf(j, k, l) = tensorb(5) + btensor(5)%sf(j, k, l) = tensorb(6) + btensor(6)%sf(j, k, l) = tensorb(9) + !end if + ! store the determinant at the last entry of the btensor sf + btensor(b_size)%sf(j, k, l) = tensorb(tensor_size) + end do + end do + end do + end subroutine s_calculate_btensor + + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_calculate_btensor_acc(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) + + type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(inout) :: btensor + integer, intent(in) :: xb, xe, yb, ye, zb, ze + real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb + integer :: j, k, l, i + +! if (num_dims == 1) then +!! !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) +! do l = izb, ize +! do k = iyb, iye +! do j = ixb, ixe +! call s_compute_gradient_xi1d_acc(q_prim_vf, ixb, ixe, iyb, & +! iye, izb, ize, j, k, l, tensora, tensorb) +! !! 1: 1D, 3: 2D, 6: 3D +! btensor(1)%sf(j, k, l) = tensorb(1) +! !! store the determinant at the last entry of the btensor sf +! btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) +! end do +! end do +! end do +! !$acc end parallel loop +! else if (num_dims == 2) then ! 2D +! !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) +! do l = izb, ize +! do k = iyb, iye +! do j = ixb, ixe +! call s_compute_gradient_xi2d_acc(q_prim_vf, ixb, ixe, iyb, & +! iye, izb, ize, j, k, l, tensora, tensorb) +! !! 1: 1D, 3: 2D, 6: 3D +! btensor(1)%sf(j, k, l) = tensorb(1) +! btensor(2)%sf(j,k,l) = tensorb(2) +! btensor(3)%sf(j,k,l) = tensorb(4) +! !! store the determinant at the last entry of the btensor sf +! btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) +! end do +! end do +! end do +! !$acc end parallel loop +! else ! 3D + + !print *,'I got here AAAA' + !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) + do l = zb, ze + do k = yb, ye + do j = xb, xe + ! STEP 1: computing the grad_xi tensor + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz + + ! 1D + if (j == xb) then + ! dxix/dx + !print *, ' grid check xb :: ',q_prim_vf(xibeg)%sf(j, k, l) + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + ! dxiy / dx + tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + ! dxiz / dx + tensora(3) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + !print *, ' grid check xb :: ',tensora(1),tensora(2),tensora(7) + + else if (j == xb + 1) then + !print *, ' grid check xb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix/dx + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + q_prim_vf(xibeg)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(3) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + q_prim_vf(xiend)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + !print *, ' grid check xb1 :: ',tensora(1),tensora(2),tensora(7) + + else if (j == xe - 1) then + !print *, ' grid check xe1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix/dx + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - q_prim_vf(xibeg)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(3) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - q_prim_vf(xiend)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + !print *, ' grid check xe1 :: ',tensora(1),tensora(2),tensora(7) + + else if (j == xe) then + !print *, ' grid check xe :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix/dx + tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(3) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + !print *, ' grid check xe :: ',tensora(1),tensora(2),tensora(7) + + else + ! dxix/dx + tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(3) = (q_prim_vf(xiend)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - q_prim_vf(xiend)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + + end if + + ! 2D + if (k == yb) then + !print *, ' grid check yb :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix / dy + tensora(4) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + ! dxiy / dy + tensora(5) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + ! dxiz / dy + tensora(6) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + !print *, ' grid check yb :: ',tensora(4),tensora(5),tensora(8) + + else if (k == yb + 1) then + !print *, ' grid check yb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix / dy + tensora(4) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + q_prim_vf(xibeg)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(6) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + q_prim_vf(xiend)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + !print *, ' grid check yb1 :: ',tensora(4),tensora(5),tensora(8) + + else if (k == ye - 1) then + !print *, ' grid check ye1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix / dy + tensora(4) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - q_prim_vf(xibeg)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(6) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - q_prim_vf(xiend)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + !print *, ' grid check yb1 :: ',tensora(4),tensora(5),tensora(8) + + else if (k == ye) then + !print *, ' grid check ye :: ',q_prim_vf(xibeg+1)%sf(j, k, l) + + ! dxix / dy + tensora(4) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(6) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxix / dy + tensora(4) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(6) = (q_prim_vf(xiend)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - q_prim_vf(xiend)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + ! 3D + if (l == zb) then + !print *, ' grid check zb :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix / dz + tensora(7) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xibeg)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xibeg)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiy / dz + tensora(8) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiz / dz + tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xiend)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xiend)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xiend)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == zb + 1) then + !print *, ' grid check zb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix / dz + tensora(7) = (-3d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & + + q_prim_vf(xibeg)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(8) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & + + q_prim_vf(xibeg + 1)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xiend)%sf(j, k, l + 2) & + + q_prim_vf(xiend)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze - 1) then + !print *, ' grid check ze1 :: ',q_prim_vf(xiend)%sf(j, k, l) + + ! dxix / dz + tensora(7) = (3d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & + - q_prim_vf(xibeg)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(8) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - q_prim_vf(xibeg + 1)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xiend)%sf(j, k, l - 2) & + - q_prim_vf(xiend)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze) then + !print *, ' grid check ze :: ',q_prim_vf(xiend)%sf(j, k, l) + + ! dxix / dz + tensora(7) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xibeg)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xibeg)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(8) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xiend)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xiend)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xiend)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxix / dz + tensora(7) = (q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - q_prim_vf(xibeg)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(8) = (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (q_prim_vf(xiend)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - q_prim_vf(xiend)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if + + !print *, 'I got here AAAAA' + + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) + tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) + tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) + tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) + tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) + tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) + tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) + tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) + tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) + + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + + !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 3d0 ) then + ! print *, 'j, k, l :: ', j, k, l + ! do i = 1, 9 + ! print *,'i :: ',i,', ten :: ',tensorb(i) + ! end do + ! print *, 'det : ',tensorb(tensor_size) + ! tensorb(tensor_size) = 1d0 + !end if + + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse + ! STEP 4: store the determinant of F in the last entry of the tensor + + !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 2d0 ) then + tensorb(tensor_size) = 1d0 + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = 0d0 + end do + tensorb(1) = 1d0 + tensorb(5) = 1d0 + tensorb(9) = 1d0 + !end if + + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do + !print *, 'I got here A6' + ! STEP 3: computing F tranpose F + !tensorb(1) = tensora(1)**2 + tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 + tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 + tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) + tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) + tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) + tensorb(4) = tensorb(2) + tensorb(7) = tensorb(3) + tensorb(8) = tensorb(6) + !print *, 'I got here A7' + !call s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, & + !iye, izb, ize, j, k, l, tensora, tensorb) + !! 1: 1D, 3: 2D, 6: 3D + btensor(1)%sf(j, k, l) = tensorb(1) + btensor(2)%sf(j, k, l) = tensorb(2) + btensor(3)%sf(j, k, l) = tensorb(3) + btensor(4)%sf(j, k, l) = tensorb(5) + btensor(5)%sf(j, k, l) = tensorb(6) + btensor(6)%sf(j, k, l) = tensorb(9) + !print *, 'I got here A8' + !! store the determinant at the last entry of the btensor sf + btensor(b_size)%sf(j, k, l) = tensorb(tensor_size) + end do + end do + end do + !$acc end parallel loop + !print *, 'I got here A9' +! end if + end subroutine s_calculate_btensor_acc + +end module m_xi_tensor_calc diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 4712ddd024..08037fcdd0 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -551,6 +551,16 @@ contains sys_size = stress_idx%end end if + if (hyperelasticity) then + xi_idx%beg = sys_size + 1 + xi_idx%end = sys_size + num_dims + ! adding three more equations for the \xi field and the elastic energy + sys_size = xi_idx%end + 1 + ! number of entries in the symmetric btensor plus the jacobian + b_size = (num_dims*(num_dims + 1))/2 + 1 + tensor_size = num_dims**2 + 1 + end if + if (.not. f_is_default(sigma)) then c_idx = sys_size + 1 sys_size = c_idx diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index f30937bb5a..c535120e51 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -649,6 +649,16 @@ contains sys_size = stress_idx%end end if + if (hyperelasticity) then + ! number of entries in the symmetric btensor plus the jacobian + b_size = (num_dims*(num_dims + 1))/2 + 1 + tensor_size = num_dims**2 + 1 + xi_idx%beg = sys_size + 1 + xi_idx%end = sys_size + num_dims + ! adding three more equations for the \xi field and the elastic energy + sys_size = xi_idx%end + 1 + end if + if (.not. f_is_default(sigma)) then c_idx = sys_size + 1 sys_size = c_idx diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 508ec20750..f28a9ba6c0 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -877,6 +877,17 @@ contains sys_size = stress_idx%end end if + if (hyperelasticity) then + ! number of entries in the symmetric btensor plus the jacobian + b_size = (num_dims*(num_dims + 1))/2 + 1 + ! storing the jacobian in the last entry + tensor_size = num_dims**2 + 1 + xi_idx%beg = sys_size + 1 + xi_idx%end = sys_size + num_dims + ! adding three more equations for the \xi field and the elastic energy + sys_size = xi_idx%end + 1 + end if + if (.not. f_is_default(sigma)) then c_idx = sys_size + 1 sys_size = c_idx diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 428492259a..9db7199a63 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -805,11 +805,11 @@ contains call nvtxEndRange !print *, "I got here B" - !call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") - !if (hyperelasticity) then - ! call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) - !end if - !call nvtxEndRange + call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") + if (hyperelasticity) then + call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) + end if + call nvtxEndRange call nvtxStartRange("RHS-MPI") call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 99b14b6ac6..663b8b18e1 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -950,12 +950,12 @@ contains flux_gsrc_vf, & norm_dir, ix, iy, iz) + idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 + #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] if (norm_dir == ${NORM_DIR}$) then - idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 - ! 6-EQUATION MODEL WITH HLLC if (model_eqns == 3) then !ME3 @@ -1294,9 +1294,9 @@ contains ! correction pressure for the cylindrical terms p_Star = xi_M*(pres_L + xi_MP*rho_L*(s_L - & - vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1)))) + & + vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1)))) + & xi_P*(pres_R + xi_PP*rho_R*(s_R - & - vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1)))) + vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1)))) ! Geometrical source flux for cylindrical coordinates #:if (NORM_DIR == 2) diff --git a/submit_test.sh b/submit_test.sh index e0225d8d22..60c65d853f 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -8,8 +8,8 @@ #./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta #./mfc.sh run /scratch/bciv/mcarcanabarbosa/testingpc4f/4testing/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta @@ -17,4 +17,6 @@ #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta +./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar From 0ea271dca53e4461e5c0ee4911e532f827d193ad Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 9 Jul 2024 14:49:30 -0500 Subject: [PATCH 230/380] CTR midterm working code --- src/common/m_phase_change.fpp | 4 ++-- submit_test.sh | 14 ++++++++------ 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 3bbbee7e24..1f0e0f209a 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -350,7 +350,7 @@ contains ns = 0 ! change this relative error metric. 1E4 is arbitrary do while ((DABS(pS - pO) > palpha_eps) .and. & - (DABS((pS - pO)/pO) > palpha_eps/1d1) .or. (ns == 0)) + (DABS((pS - pO)/pO) > palpha_eps/1d2) .or. (ns == 0)) ! increasing counter ns = ns + 1 @@ -440,7 +440,7 @@ contains R2D(1) = 0.0d0; R2D(2) = 0.0d0 DeltamP(1) = 0.0d0; DeltamP(2) = 0.0d0 do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & - .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d1))) & + .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d2))) & .or. (ns == 0)) ! Updating counter for the iterative procedure diff --git a/submit_test.sh b/submit_test.sh index e0225d8d22..991dd7f7f4 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -8,13 +8,15 @@ #./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta - -#./mfc.sh run /scratch/bciv/mcarcanabarbosa/testingpc4f/4testing/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta +#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 00:10:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 04:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta From 2f3058176460fb0d52739a55ff57ca06a159ff7f Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 10 Jul 2024 10:38:22 -0500 Subject: [PATCH 231/380] moved code around --- src/common/m_xi_tensor_calc.f90 | 64 +++++++++++++++++++++++++++- src/simulation/m_riemann_solvers.fpp | 3 ++ submit_test.sh | 7 ++- 3 files changed, 69 insertions(+), 5 deletions(-) diff --git a/src/common/m_xi_tensor_calc.f90 b/src/common/m_xi_tensor_calc.f90 index aa993c8662..ccd5042e79 100644 --- a/src/common/m_xi_tensor_calc.f90 +++ b/src/common/m_xi_tensor_calc.f90 @@ -21,7 +21,8 @@ module m_xi_tensor_calc s_compute_gradient_xi3d_acc, & f_elastic_energy, & s_calculate_btensor, & - s_calculate_btensor_acc + s_calculate_btensor_acc, & + s_calculate_cauchy_from_btensor contains @@ -1774,4 +1775,65 @@ subroutine s_calculate_btensor_acc(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) ! end if end subroutine s_calculate_btensor_acc + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, j, k, l) +#ifdef MFC_SIMULATION + !$acc routine seq +#endif + type(scalar_field), dimension(sys_size), intent(INOUT) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(IN) :: btensor + type(int_bounds_info), intent(IN) :: j, k, l + + real(kind(0d0)), dimension(b_size - 1) :: tensor + real(kind(0d0)) :: trace + integer :: i !< Generic loop iterators + + ! tensor is the symmetric tensor & calculate the trace of the tensor + !trace = btensor(1)%sf(j,k,l) + !if (num_dims == 2) then + ! trace = trace + btensor(3)%sf(j,k,l) + !else + trace = btensor(1)%sf(j, k, l) + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + !end if + + ! invariant calculation, saving it in the q_prim_vf field + !invariant1 = btensor(1)%sf(j, k, l) + !if (num_dims == 2) then + ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) + !elseif (num_dims == 3) then + ! invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + !end if + + ! calculate the deviatoric of the tensor + btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - (1d0/3d0)*trace + !if (num_dims == 2) then + ! btensor(3)%sf(j,k,l) = btensor(3)%sf(j,k,l) - (1d0/3d0)*trace + !else + btensor(4)%sf(j, k, l) = btensor(4)%sf(j, k, l) - (1d0/3d0)*trace + btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - (1d0/3d0)*trace + !end if + ! dividing by the jacobian for neo-Hookean model + ! setting the tensor to the stresses for riemann solver + + !$acc loop seq + do i = 1, b_size - 1 + q_prim_vf(strxb + i)%sf(j, k, l) = btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + end do + + ! compute the invariant without the elastic modulus + ! if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then + q_prim_vf(xiend + 1)%sf(j, k, l) = 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) + ! else + ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 + ! end if + + end subroutine s_calculate_cauchy_from_btensor + end module m_xi_tensor_calc diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 663b8b18e1..542a48948b 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -1097,6 +1097,9 @@ contains ! Mixture left and right shear modulus G_L = G_L + alpha_L(i)*Gs(i) G_R = G_R + alpha_R(i)*Gs(i) + end do + !$acc loop seq + do i = 1, num_dims ! Left and right \xi fields xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) diff --git a/submit_test.sh b/submit_test.sh index 7f1185bb92..1a2f59a11a 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -18,9 +18,8 @@ #./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 00:10:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 04:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - -#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar +./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta From 07563ac7ce2df61934d5ff12f15bd6f168895942 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 10 Jul 2024 11:39:05 -0400 Subject: [PATCH 232/380] added additional changes in preparation for merger --- src/common/m_variables_conversion.fpp | 31 ++++-- src/common/m_xi_tensor_calc.f90 | 140 +++++++++++++------------- src/simulation/m_hyperelastic.f90 | 22 ++-- src/simulation/m_rhs.fpp | 35 ++----- 4 files changed, 117 insertions(+), 111 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 1654d79e6f..f8b98fd60d 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -24,6 +24,7 @@ module m_variables_conversion use m_helper_basic !< Functions to compare floating point numbers use m_helper + ! ========================================================================== implicit none @@ -106,6 +107,11 @@ module m_variables_conversion real(kind(0d0)), allocatable, dimension(:, :, :), public :: pi_inf_sf !< Scalar liquid stiffness function real(kind(0d0)), allocatable, dimension(:, :, :), public :: qv_sf !< Scalar liquid energy reference function + !! The btensor at the cell-interior Gaussian quadrature points. + !! These tensor is needed to be calculated once and make the code DRY. + type(vector_field) :: q_btensor !< + !$acc declare create(q_btensor) + procedure(s_convert_xxxxx_to_mixture_variables), & pointer :: s_convert_to_mixture_variables => null() !< !! Pointer referencing the subroutine s_convert_mixture_to_mixture_variables @@ -675,6 +681,14 @@ contains end if #endif + if (hyperelasticity) then + @:ALLOCATE(q_btensor%vf(1:b_size)) + do i = 1, b_size + @:ALLOCATE(q_btensor%vf(i)%sf(ixb:ixe, iyb:iye, izb:ize)) + end do + @:ACC_SETUP_VFs(q_btensor) + end if + if (bubbles) then #ifdef MFC_SIMULATION @:ALLOCATE_GLOBAL(bubrs(1:nb)) @@ -685,7 +699,6 @@ contains do i = 1, nb bubrs(i) = bub_idx%rs(i) end do - !$acc update device(bubrs) end if @@ -1061,6 +1074,7 @@ contains !G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) !end if + !TODO call s_calculate_cauchy_from_btensor(q_btensor,q_prim_vf, ix, iy, iz) ! end do ! end do !end do @@ -1134,9 +1148,9 @@ contains ! going through hyperelasticity again due to the btensor calculation ! s_calculate_btensor has its own triple nested for loop, with openacc - !if (hyperelasticity) then - !call s_calculate_btensor(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) - !end if + if (hyperelasticity) then + call s_calculate_btensor(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) + end if ! Converting the primitive variables to the conservative variables do l = 0, p @@ -1232,7 +1246,7 @@ contains do i = stress_idx%beg, stress_idx%end q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) ! adding elastic contribution - if (G > 1000) then + if (G > verysmall) then q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) ! extra terms in 2 and 3D @@ -1253,9 +1267,11 @@ contains q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) end do if (G > verysmall) then - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - G*f_elastic_energy(q_btensor, j, k, l) + q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) !+ & + !G*f_elastic_energy(q_btensor, j, k, l) end if + call s_calculate_cauchy_from_btensor(q_btensor,q_prim_vf, ix, iy, iz) + !TODO Multiply the \tau to \rho \tau end if if (.not. f_is_default(sigma)) then @@ -1266,6 +1282,7 @@ contains end do end do + ! deallocating the btensor do l = 1, b_size @:DEALLOCATE(q_btensor(l)%sf) diff --git a/src/common/m_xi_tensor_calc.f90 b/src/common/m_xi_tensor_calc.f90 index aa993c8662..afc70ce324 100644 --- a/src/common/m_xi_tensor_calc.f90 +++ b/src/common/m_xi_tensor_calc.f90 @@ -25,6 +25,37 @@ module m_xi_tensor_calc contains + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + !! neo-Hookean only at this time, will need to be changed later + function f_elastic_energy(btensor, j, k, l) +#ifdef MFC_SIMULATION + !$acc routine seq +#endif + type(scalar_field), dimension(b_size), intent(IN) :: btensor + integer, intent(IN) :: j, k, l + real(kind(0d0)) :: invariant1, f_elastic_energy + + f_elastic_energy = 0d0 + invariant1 = btensor(1)%sf(j, k, l) + !if (num_dims == 2) then + ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) + !elseif (num_dims == 3) then + invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + !end if + + ! compute the invariant without the elastic modulus + f_elastic_energy = 0.5d0*(invariant1 - 3.0d0)/btensor(b_size)%sf(j, k, l) + + end function f_elastic_energy + + !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. !! @param q_prim_vf Primitive variables @@ -497,6 +528,46 @@ subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- end subroutine s_compute_gradient_xi + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_calculate_btensor(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) + + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(INOUT) :: btensor + integer, intent(IN) :: xb, xe, yb, ye, zb, ze + real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb + integer :: j, k, l + + do l = zb, ze + do k = yb, ye + do j = xb, xe + call s_compute_gradient_xi(q_prim_vf, xb, xe, yb, & + ye, zb, ze, j, k, l, tensora, tensorb) + ! 1: 1D, 3: 2D, 6: 3D + btensor(1)%sf(j, k, l) = tensorb(1) + !if (num_dims > 1) then ! 2D + btensor(2)%sf(j, k, l) = tensorb(2) + ! btensor(3)%sf(j,k,l) = tensorb(4) + !end if + !if (num_dims > 2) then ! 3D + btensor(3)%sf(j, k, l) = tensorb(3) + btensor(4)%sf(j, k, l) = tensorb(5) + btensor(5)%sf(j, k, l) = tensorb(6) + btensor(6)%sf(j, k, l) = tensorb(9) + !end if + ! store the determinant at the last entry of the btensor sf + btensor(b_size)%sf(j, k, l) = tensorb(tensor_size) + end do + end do + end do + end subroutine s_calculate_btensor + !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. !! @param q_prim_vf Primitive variables @@ -1196,75 +1267,6 @@ subroutine s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !------- end subroutine s_compute_gradient_xi3d_acc - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - !! neo-Hookean only at this time, will need to be changed later - function f_elastic_energy(btensor, j, k, l) -#ifdef MFC_SIMULATION - !$acc routine seq -#endif - type(scalar_field), dimension(b_size), intent(IN) :: btensor - integer, intent(IN) :: j, k, l - real(kind(0d0)) :: invariant1, f_elastic_energy - - f_elastic_energy = 0d0 - invariant1 = btensor(1)%sf(j, k, l) - !if (num_dims == 2) then - ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) - !elseif (num_dims == 3) then - invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) - !end if - - ! compute the invariant without the elastic modulus - f_elastic_energy = 0.5d0*(invariant1 - 3.0d0)/btensor(b_size)%sf(j, k, l) - - end function f_elastic_energy - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_calculate_btensor(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) - - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(INOUT) :: btensor - integer, intent(IN) :: xb, xe, yb, ye, zb, ze - real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb - integer :: j, k, l - - do l = zb, ze - do k = yb, ye - do j = xb, xe - call s_compute_gradient_xi(q_prim_vf, xb, xe, yb, & - ye, zb, ze, j, k, l, tensora, tensorb) - ! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensorb(1) - !if (num_dims > 1) then ! 2D - btensor(2)%sf(j, k, l) = tensorb(2) - ! btensor(3)%sf(j,k,l) = tensorb(4) - !end if - !if (num_dims > 2) then ! 3D - btensor(3)%sf(j, k, l) = tensorb(3) - btensor(4)%sf(j, k, l) = tensorb(5) - btensor(5)%sf(j, k, l) = tensorb(6) - btensor(6)%sf(j, k, l) = tensorb(9) - !end if - ! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j, k, l) = tensorb(tensor_size) - end do - end do - end do - end subroutine s_calculate_btensor !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. diff --git a/src/simulation/m_hyperelastic.f90 b/src/simulation/m_hyperelastic.f90 index c7c660f186..40dd9455d2 100644 --- a/src/simulation/m_hyperelastic.f90 +++ b/src/simulation/m_hyperelastic.f90 @@ -25,20 +25,20 @@ module m_hyperelastic !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, ix, iy, iz) + subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, j, k, l) type(scalar_field), dimension(sys_size), intent(INOUT) :: q_prim_vf type(scalar_field), dimension(b_size), intent(IN) :: btensor - type(int_bounds_info), intent(IN) :: ix, iy, iz + type(int_bounds_info), intent(IN) :: j, k, l real(kind(0d0)), dimension(b_size - 1) :: tensor real(kind(0d0)) :: trace - integer :: i, j, k, l !< Generic loop iterators + integer :: i !< Generic loop iterators - !$acc parallel loop collapse(3) gang vector default(present) private(trace) - do l = 0, p - do k = 0, n - do j = 0, m + !!!$acc parallel loop collapse(3) gang vector default(present) private(trace) + !do l = 0, p + ! do k = 0, n + ! do j = 0, m ! tensor is the symmetric tensor & calculate the trace of the tensor !trace = btensor(1)%sf(j,k,l) !if (num_dims == 2) then @@ -76,10 +76,10 @@ subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, ix, iy, iz) ! else ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 ! end if - end do - end do - end do - !$acc end parallel loop + ! end do + ! end do + !end do + !!$acc end parallel loop end subroutine s_calculate_cauchy_from_btensor diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 9db7199a63..c235f8125e 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -77,11 +77,6 @@ module m_rhs type(vector_field) :: q_prim_qp !< !$acc declare create(q_prim_qp) - !! The btensor at the cell-interior Gaussian quadrature points. - !! These tensor is needed to be calculated once and make the code DRY. - type(vector_field) :: q_btensor !< - !$acc declare create(q_btensor) - !> @name The first-order spatial derivatives of the primitive variables at cell- !! interior Gaussian quadrature points. These are WENO-reconstructed from !! their respective cell-average values, obtained through the application @@ -254,7 +249,6 @@ contains @:ALLOCATE(q_cons_qp%vf(1:sys_size)) @:ALLOCATE(q_prim_qp%vf(1:sys_size)) - @:ALLOCATE(q_btensor%vf(1:b_size)) do l = 1, sys_size @:ALLOCATE(q_cons_qp%vf(l)%sf(ix%beg:ix%end, iy%beg:iy%end, iz%beg:iz%end)) @@ -280,13 +274,6 @@ contains @:ACC_SETUP_VFs(q_cons_qp, q_prim_qp) - if (hyperelasticity) then - do l = 1, b_size - @:ALLOCATE(q_btensor%vf(l)%sf(ix%beg:ix%end, iy%beg:iy%end, iz%beg:iz%end)) - end do - @:ACC_SETUP_VFs(q_btensor) - end if - do l = 1, cont_idx%end q_prim_qp%vf(l)%sf => q_cons_qp%vf(l)%sf !$acc enter data copyin(q_prim_qp%vf(l)%sf) @@ -796,20 +783,20 @@ contains q_prim_qp%vf, & gm_alpha_qp%vf, & ix, iy, iz) -! call s_convert_conservative_to_primitive_variables( & -! q_cons_qp%vf, & -! q_prim_qp%vf, & -! gm_alpha_qp%vf, & -! ix, iy, iz, & -! q_btensor%vf) + !call s_convert_conservative_to_primitive_variables( & + ! q_cons_qp%vf, & + ! q_prim_qp%vf, & + ! gm_alpha_qp%vf, & + ! ix, iy, iz, & + ! q_btensor%vf) call nvtxEndRange !print *, "I got here B" - call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") - if (hyperelasticity) then - call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) - end if - call nvtxEndRange + !call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") + !if (hyperelasticity) then + ! call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) + !end if + !call nvtxEndRange call nvtxStartRange("RHS-MPI") call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) From 8f8655b43927d1aced8864f32fdb9d96185950a3 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 10 Jul 2024 12:01:57 -0400 Subject: [PATCH 233/380] made necessary changes to streamline code, compiles on CPUs, not tested --- src/common/m_variables_conversion.fpp | 2 +- src/common/m_xi_tensor_calc.f90 | 4 +- src/simulation/m_hyperelastic.f90 | 86 --------------------------- src/simulation/m_rhs.fpp | 2 +- 4 files changed, 4 insertions(+), 90 deletions(-) delete mode 100644 src/simulation/m_hyperelastic.f90 diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index f8b98fd60d..c97285815e 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1270,7 +1270,7 @@ contains q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) !+ & !G*f_elastic_energy(q_btensor, j, k, l) end if - call s_calculate_cauchy_from_btensor(q_btensor,q_prim_vf, ix, iy, iz) + call s_calculate_cauchy_from_btensor(q_btensor,q_prim_vf, j, k, l) !TODO Multiply the \tau to \rho \tau end if diff --git a/src/common/m_xi_tensor_calc.f90 b/src/common/m_xi_tensor_calc.f90 index d33731f098..3b56d159ca 100644 --- a/src/common/m_xi_tensor_calc.f90 +++ b/src/common/m_xi_tensor_calc.f90 @@ -1789,9 +1789,9 @@ subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, j, k, l) #ifdef MFC_SIMULATION !$acc routine seq #endif - type(scalar_field), dimension(sys_size), intent(INOUT) :: q_prim_vf + type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf type(scalar_field), dimension(b_size), intent(IN) :: btensor - type(int_bounds_info), intent(IN) :: j, k, l + integer, intent(IN) :: j, k, l real(kind(0d0)), dimension(b_size - 1) :: tensor real(kind(0d0)) :: trace diff --git a/src/simulation/m_hyperelastic.f90 b/src/simulation/m_hyperelastic.f90 deleted file mode 100644 index 40dd9455d2..0000000000 --- a/src/simulation/m_hyperelastic.f90 +++ /dev/null @@ -1,86 +0,0 @@ -!> -!! @file m_hyperelastic.f90 -!! @brief Contains module m_hyperelastic - -!> @brief This module is used to compute source terms for hyperelastic model -module m_hyperelastic - - ! Dependencies ============================================================= - use m_derived_types !< Definitions of the derived types - - use m_global_parameters !< Definitions of the global parameters - ! ========================================================================== - - implicit none - - private; public :: s_calculate_cauchy_from_btensor - -contains - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, j, k, l) - - type(scalar_field), dimension(sys_size), intent(INOUT) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(IN) :: btensor - type(int_bounds_info), intent(IN) :: j, k, l - - real(kind(0d0)), dimension(b_size - 1) :: tensor - real(kind(0d0)) :: trace - integer :: i !< Generic loop iterators - - !!!$acc parallel loop collapse(3) gang vector default(present) private(trace) - !do l = 0, p - ! do k = 0, n - ! do j = 0, m - ! tensor is the symmetric tensor & calculate the trace of the tensor - !trace = btensor(1)%sf(j,k,l) - !if (num_dims == 2) then - ! trace = trace + btensor(3)%sf(j,k,l) - !else - trace = btensor(1)%sf(j, k, l) + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) - !end if - ! invariant calculation, saving it in the q_prim_vf field - !invariant1 = btensor(1)%sf(j, k, l) - !if (num_dims == 2) then - ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) - !elseif (num_dims == 3) then - ! invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) - !end if - - ! calculate the deviatoric of the tensor - btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - (1d0/3d0)*trace - !if (num_dims == 2) then - ! btensor(3)%sf(j,k,l) = btensor(3)%sf(j,k,l) - (1d0/3d0)*trace - !else - btensor(4)%sf(j, k, l) = btensor(4)%sf(j, k, l) - (1d0/3d0)*trace - btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - (1d0/3d0)*trace - !end if - ! dividing by the jacobian for neo-Hookean model - ! setting the tensor to the stresses for riemann solver - - !$acc loop seq - do i = 1, b_size - 1 - q_prim_vf(strxb + i)%sf(j, k, l) = btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) - end do - - ! compute the invariant without the elastic modulus - ! if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then - q_prim_vf(xiend + 1)%sf(j, k, l) = 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) - ! else - ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 - ! end if - ! end do - ! end do - !end do - !!$acc end parallel loop - - end subroutine s_calculate_cauchy_from_btensor - -end module m_hyperelastic diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index c235f8125e..be1b666790 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -39,7 +39,7 @@ module m_rhs use m_hypoelastic - use m_hyperelastic + !use m_hyperelastic use m_monopole From 5b04d7dbf9274a94c402d6c4a2e53ba56356c97c Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 10 Jul 2024 12:54:14 -0400 Subject: [PATCH 234/380] cleaned up code in conservative to primitive variables, more changes needed, compiles --- src/common/m_variables_conversion.fpp | 50 +++++++-------------------- src/simulation/m_rhs.fpp | 14 -------- 2 files changed, 13 insertions(+), 51 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index c97285815e..7da229c95f 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -849,8 +849,7 @@ contains subroutine s_convert_conservative_to_primitive_variables(qK_cons_vf, & qK_prim_vf, & gm_alphaK_vf, & - ix, iy, iz, & - qK_btensor_vf) + ix, iy, iz) type(scalar_field), dimension(sys_size), intent(in) :: qK_cons_vf type(scalar_field), dimension(sys_size), intent(inout) :: qK_prim_vf @@ -860,8 +859,6 @@ contains type(int_bounds_info), optional, intent(in) :: ix, iy, iz - type(scalar_field), optional, dimension(b_size), intent(INOUT) :: qK_btensor_vf - real(kind(0d0)), dimension(num_fluids) :: alpha_K, alpha_rho_K real(kind(0d0)), dimension(2) :: Re_K real(kind(0d0)) :: rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K @@ -886,9 +883,7 @@ contains real(kind(0.d0)) :: ntmp -#ifdef MFC_POST_PROCESS type(scalar_field), dimension(b_size) :: q_btensor -#endif #:if MFC_CASE_OPTIMIZATION #ifndef MFC_SIMULATION @@ -906,6 +901,12 @@ contains end if #:endif + if (hyperelasticity) then + do l = 1, b_size + allocate (q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) + end do + end if + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) do l = izb, ize do k = iyb, iye @@ -1052,9 +1053,12 @@ contains !print *, 'I got here AA' -#ifdef MFC_SIMULATION if (hyperelasticity) then - call s_calculate_btensor_acc(qK_prim_vf, qK_btensor_vf, 0, m, 0, n, 0, p) +#ifdef MFC_SIMULATION + call s_calculate_btensor_acc(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) +#else + call s_calculate_btensor(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) +#endif !print *, 'I got here AAA' !!$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) !do l = izb, ize @@ -1069,7 +1073,7 @@ contains !call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & ! alpha_rho_K, Re_K, j, k, l, G_K, Gs) !rho_K = max(rho_K, sgm_eps) - !if (G_K > 1d-3) then + !if (G_K > verysmall) then ! qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & !G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) @@ -1080,34 +1084,6 @@ contains !end do !!$acc end parallel loop end if -#endif - -#ifdef MFC_POST_PROCESS - do l = 1, b_size - allocate (q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) - end do - - if (hyperelasticity) then - call s_calculate_btensor(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) - do l = 0, p - do k = 0, n - do j = 0, m - do i = 1, num_fluids - alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) - alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) - end do - ! If pre-processing, use non acc mixture subroutines - !call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & - ! rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) - !if ( G_K > 1000 ) then - ! !qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) ! - & - ! !G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K - !end if - end do - end do - end do - end if -#endif end subroutine s_convert_conservative_to_primitive_variables ! --------- diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index be1b666790..39e6d7221d 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -39,8 +39,6 @@ module m_rhs use m_hypoelastic - !use m_hyperelastic - use m_monopole use m_viscous @@ -783,21 +781,9 @@ contains q_prim_qp%vf, & gm_alpha_qp%vf, & ix, iy, iz) - !call s_convert_conservative_to_primitive_variables( & - ! q_cons_qp%vf, & - ! q_prim_qp%vf, & - ! gm_alpha_qp%vf, & - ! ix, iy, iz, & - ! q_btensor%vf) call nvtxEndRange !print *, "I got here B" - !call nvtxStartRange("RHS-UPDATE CAUCHY TENSOR") - !if (hyperelasticity) then - ! call s_calculate_cauchy_from_btensor(q_btensor%vf,q_prim_qp%vf, ix, iy, iz) - !end if - !call nvtxEndRange - call nvtxStartRange("RHS-MPI") call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) call nvtxEndRange From bfb2752c7b6341af3570f39bdc4a7f25689c2876 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 10 Jul 2024 13:56:36 -0400 Subject: [PATCH 235/380] test suite passes on CPUs, testing GPUs --- src/common/m_phase_change.fpp | 4 +-- src/simulation/m_riemann_solvers.fpp | 37 +++++++++++++++------------- 2 files changed, 22 insertions(+), 19 deletions(-) diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 1f0e0f209a..c13fa233c6 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -350,7 +350,7 @@ contains ns = 0 ! change this relative error metric. 1E4 is arbitrary do while ((DABS(pS - pO) > palpha_eps) .and. & - (DABS((pS - pO)/pO) > palpha_eps/1d2) .or. (ns == 0)) + (DABS((pS - pO)/pO) > palpha_eps/1d4) .or. (ns == 0)) ! increasing counter ns = ns + 1 @@ -440,7 +440,7 @@ contains R2D(1) = 0.0d0; R2D(2) = 0.0d0 DeltamP(1) = 0.0d0; DeltamP(2) = 0.0d0 do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & - .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d2))) & + .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) & .or. (ns == 0)) ! Updating counter for the iterative procedure diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 542a48948b..151bfc8390 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -888,7 +888,6 @@ contains real(kind(0d0)) :: qv_L, qv_R real(kind(0d0)) :: c_L, c_R real(kind(0d0)), dimension(2) :: Re_L, Re_R - real(kind(0d0)), dimension(3) :: xi_field_L, xi_field_R real(kind(0d0)) :: rho_avg real(kind(0d0)), dimension(num_dims) :: vel_avg @@ -1098,12 +1097,6 @@ contains G_L = G_L + alpha_L(i)*Gs(i) G_R = G_R + alpha_R(i)*Gs(i) end do - !$acc loop seq - do i = 1, num_dims - ! Left and right \xi fields - xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) - xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) - end do ! Elastic contribution to energy if G large enough if (G_L < verysmall) G_L = 0d0; if (G_R < verysmall) G_R = 0d0; @@ -1268,13 +1261,6 @@ contains xi_P*(vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(dir_idx(i)))) end do - ! SURFACE TENSION FLUX. need to check - if (.not. f_is_default(sigma)) then - flux_rs${XYZ}$_vf(j, k, l, c_idx) = & - (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & - xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S - end if - ! INTERNAL ENERGIES ADVECTION FLUX. ! K-th pressure and velocity in preparation for the internal energy flux vel_K_Star = vel_L(idx1)*(1d0 - xi_MP) + xi_MP*vel_R(idx1) + & @@ -1295,11 +1281,28 @@ contains flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) + ! REFERENCE MAP FLUX. + if (hyperelasticity) then + !$acc loop seq + do i = xibeg, xiend + flux_rs${XYZ}$_vf(j, k, l, i) = & + xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) + end do + end if + + ! SURFACE TENSION FLUX. need to check + if (.not. f_is_default(sigma)) then + flux_rs${XYZ}$_vf(j, k, l, c_idx) = & + (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S + end if + ! correction pressure for the cylindrical terms p_Star = xi_M*(pres_L + xi_MP*rho_L*(s_L - & - vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1)))) + & - xi_P*(pres_R + xi_PP*rho_R*(s_R - & - vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1)))) + vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1)))) + & + xi_P*(pres_R + xi_PP*rho_R*(s_R - & + vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1)))) ! Geometrical source flux for cylindrical coordinates #:if (NORM_DIR == 2) From ebb1d2e8f0d1b7f3509cc4f2d2e69aac0b368543 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 11 Jul 2024 11:43:56 -0400 Subject: [PATCH 236/380] refactoring hyperelasticity mostly complete, not yet testing, compiles on CPUs, passes CPU test suite --- src/common/m_hyperelastic.f90 | 123 ++++++++++++++++++ src/common/m_variables_conversion.fpp | 50 +++---- .../{m_xi_tensor_calc.f90 => m_xi_tensor.f90} | 4 +- 3 files changed, 151 insertions(+), 26 deletions(-) create mode 100644 src/common/m_hyperelastic.f90 rename src/common/{m_xi_tensor_calc.f90 => m_xi_tensor.f90} (99%) diff --git a/src/common/m_hyperelastic.f90 b/src/common/m_hyperelastic.f90 new file mode 100644 index 0000000000..db279ef7fa --- /dev/null +++ b/src/common/m_hyperelastic.f90 @@ -0,0 +1,123 @@ +!> +!! @file m_xi_tensor_calc.f90 +!! @brief Contains module m_hyperelastic + +!> @brief This module consists of subroutines used in the calculation +!! of the cauchy tensor + +module m_hyperelastic + + ! Dependencies ============================================================= + use m_derived_types !< Definitions of the derived types + + use m_global_parameters !< Definitions of the global parameters + ! ========================================================================== + + implicit none + + private; public :: s_compute_cauchy_solver, & + s_initialize_hyperelastic_module, & + s_finalize_hyperelastic_module + + !> @name Abstract interface for creating function pointers + !> @{ + abstract interface + + !> @name Abstract subroutine for the infinite relaxation solver + !> @{ + subroutine s_abstract_hyperelastic_solver(btensor, q_prim_vf, j, k, l) + + import :: scalar_field, sys_size, b_size + type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(IN) :: btensor + integer, intent(IN) :: j, k, l + + end subroutine + !> @} + + end interface + !> @} + + procedure(s_abstract_hyperelastic_solver), pointer :: s_compute_cauchy_solver => null() + +contains + + subroutine s_initialize_hyperelastic_module() + + ! Associating procedural pointer to the subroutine that will be + ! utilized to calculate the solution of a given Riemann problem + !if (hyper_model == 1) then + s_compute_cauchy_solver => s_neoHookean_cauchy_solver + !elseif (riemann_solver == 2) then + ! s_compute_cauchy_solver => s_Mooney_Rivlin_cauchy_solver + !end if + + end subroutine + + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, j, k, l) +#ifdef MFC_SIMULATION + !$acc routine seq +#endif + type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(IN) :: btensor + integer, intent(IN) :: j, k, l + + real(kind(0d0)), dimension(b_size - 1) :: tensor + real(kind(0d0)) :: trace + integer :: i !< Generic loop iterators + + ! tensor is the symmetric tensor & calculate the trace of the tensor + !trace = btensor(1)%sf(j,k,l) + !if (num_dims == 2) then + ! trace = trace + btensor(3)%sf(j,k,l) + !else + trace = btensor(1)%sf(j, k, l) + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + !end if + + ! invariant calculation, saving it in the q_prim_vf field + !invariant1 = btensor(1)%sf(j, k, l) + !if (num_dims == 2) then + ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) + !elseif (num_dims == 3) then + ! invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + !end if + + ! calculate the deviatoric of the tensor + btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - (1d0/3d0)*trace + !if (num_dims == 2) then + ! btensor(3)%sf(j,k,l) = btensor(3)%sf(j,k,l) - (1d0/3d0)*trace + !else + btensor(4)%sf(j, k, l) = btensor(4)%sf(j, k, l) - (1d0/3d0)*trace + btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - (1d0/3d0)*trace + !end if + ! dividing by the jacobian for neo-Hookean model + ! setting the tensor to the stresses for riemann solver + + !$acc loop seq + do i = 1, b_size - 1 + q_prim_vf(strxb + i)%sf(j, k, l) = btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + end do + + ! compute the invariant without the elastic modulus + ! if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then + q_prim_vf(xiend + 1)%sf(j, k, l) = 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) + ! else + ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 + ! end if + end subroutine s_neoHookean_cauchy_solver + + subroutine s_finalize_hyperelastic_module() + ! Disassociating procedural pointer to the subroutine which was + ! utilized to calculate the solution of a given Riemann problem + s_compute_cauchy_solver => null() + end subroutine + +end module m_hyperelastic diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 7da229c95f..2e65b7c8d4 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -19,7 +19,9 @@ module m_variables_conversion use m_mpi_proxy !< Message passing interface (MPI) module proxy - use m_xi_tensor_calc !< Using reference map matrix calculations + use m_xi_tensor !< Using reference map matrix calculations + + use m_hyperelastic !< Using hyperelastic Cauchy tensor calculations use m_helper_basic !< Functions to compare floating point numbers @@ -1060,29 +1062,29 @@ contains call s_calculate_btensor(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) #endif !print *, 'I got here AAA' - !!$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) - !do l = izb, ize - ! do k = iyb, iye - ! do j = ixb, ixe + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe !!$acc loop seq - !do i = 1, num_fluids - ! alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) - ! alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) - !end do - ! If in simulation, use acc mixture subroutines - !call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & - ! alpha_rho_K, Re_K, j, k, l, G_K, Gs) - !rho_K = max(rho_K, sgm_eps) - !if (G_K > verysmall) then - ! qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & - !G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K - !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) - !end if - !TODO call s_calculate_cauchy_from_btensor(q_btensor,q_prim_vf, ix, iy, iz) - ! end do - ! end do - !end do - !!$acc end parallel loop + !do i = 1, num_fluids + ! alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) + ! alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) + !end do + ! If in simulation, use acc mixture subroutines + !call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & + ! alpha_rho_K, Re_K, j, k, l, G_K, Gs) + !rho_K = max(rho_K, sgm_eps) + !if (G_K > verysmall) then + ! qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & + ! G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K + !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) + !end if + call s_compute_cauchy_solver(q_btensor,qK_prim_vf, j, k, l) + end do + end do + end do + !$acc end parallel loop end if end subroutine s_convert_conservative_to_primitive_variables ! --------- @@ -1246,7 +1248,7 @@ contains q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) !+ & !G*f_elastic_energy(q_btensor, j, k, l) end if - call s_calculate_cauchy_from_btensor(q_btensor,q_prim_vf, j, k, l) + call s_compute_cauchy_solver(q_btensor,q_prim_vf, j, k, l) !TODO Multiply the \tau to \rho \tau end if diff --git a/src/common/m_xi_tensor_calc.f90 b/src/common/m_xi_tensor.f90 similarity index 99% rename from src/common/m_xi_tensor_calc.f90 rename to src/common/m_xi_tensor.f90 index 3b56d159ca..3e7221af89 100644 --- a/src/common/m_xi_tensor_calc.f90 +++ b/src/common/m_xi_tensor.f90 @@ -5,7 +5,7 @@ !> @brief This module consists of subroutines used in the calculation of matrix !! operations for the reference map tensor -module m_xi_tensor_calc +module m_xi_tensor ! Dependencies ============================================================= use m_derived_types !< Definitions of the derived types @@ -1838,4 +1838,4 @@ subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, j, k, l) end subroutine s_calculate_cauchy_from_btensor -end module m_xi_tensor_calc +end module m_xi_tensor From c7ffbd1daab89140f58847d386d3a3260d8c8ea1 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 11 Jul 2024 11:59:19 -0500 Subject: [PATCH 237/380] code compiles and passes test suite on Delta GPUs --- src/common/m_variables_conversion.fpp | 53 ++++++++++++++++----------- 1 file changed, 31 insertions(+), 22 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 2e65b7c8d4..8c1ac168a1 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1031,12 +1031,11 @@ contains end do end if - if ( hyperelasticity ) then - !$acc loop seq - do i = xibeg, xiend - qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K - !print *, 'i ::',i,',j,k,l ::',j,k,l,', qprim ::',qK_prim_vf(i)%sf(j,k,l) - end do + if (hyperelasticity) then + !$acc loop seq + do i = xibeg, xiend + qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K + end do end if !$acc loop seq @@ -1066,20 +1065,20 @@ contains do l = izb, ize do k = iyb, iye do j = ixb, ixe - !!$acc loop seq - !do i = 1, num_fluids - ! alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) - ! alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) - !end do + !$acc loop seq + do i = 1, num_fluids + alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) + alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) + end do ! If in simulation, use acc mixture subroutines - !call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & - ! alpha_rho_K, Re_K, j, k, l, G_K, Gs) - !rho_K = max(rho_K, sgm_eps) - !if (G_K > verysmall) then - ! qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & - ! G_K*f_elastic_energy(qK_btensor_vf, j, k, l)/gamma_K + call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & + alpha_rho_K, Re_K, j, k, l, G_K, Gs) + rho_K = max(rho_K, sgm_eps) + if (G_K > verysmall) then + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) - !end if + end if call s_compute_cauchy_solver(q_btensor,qK_prim_vf, j, k, l) end do end do @@ -1124,7 +1123,7 @@ contains @:ALLOCATE(q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) end do - ! going through hyperelasticity again due to the btensor calculation + ! btensor calculation ! s_calculate_btensor has its own triple nested for loop, with openacc if (hyperelasticity) then call s_calculate_btensor(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) @@ -1220,6 +1219,13 @@ contains end do end if + + if (elasticity) then + do i = stress_idx%beg, stress_idx%end + q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) + end do + end if + if (hypoelasticity) then do i = stress_idx%beg, stress_idx%end q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) @@ -1245,11 +1251,14 @@ contains q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) end do if (G > verysmall) then - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) !+ & - !G*f_elastic_energy(q_btensor, j, k, l) + q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & + G*f_elastic_energy(q_btensor, j, k, l) end if call s_compute_cauchy_solver(q_btensor,q_prim_vf, j, k, l) - !TODO Multiply the \tau to \rho \tau + ! Multiply the \tau to \rho \tau + do i = stress_idx%beg, stress_idx%end + q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) + end do end if if (.not. f_is_default(sigma)) then From 0ad76886e268e33b524c0a3913bfa1cd0b6a27e8 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 11 Jul 2024 18:09:27 -0400 Subject: [PATCH 238/380] reworked \tau evaluation in the common code for hyperelasticity, compiles and tests on CPUs --- src/common/m_hyperelastic.f90 | 18 ++++++++++-------- src/common/m_variables_conversion.fpp | 8 ++------ src/simulation/m_riemann_solvers.fpp | 4 ++-- 3 files changed, 14 insertions(+), 16 deletions(-) diff --git a/src/common/m_hyperelastic.f90 b/src/common/m_hyperelastic.f90 index db279ef7fa..538e014dfe 100644 --- a/src/common/m_hyperelastic.f90 +++ b/src/common/m_hyperelastic.f90 @@ -25,13 +25,14 @@ module m_hyperelastic !> @name Abstract subroutine for the infinite relaxation solver !> @{ - subroutine s_abstract_hyperelastic_solver(btensor, q_prim_vf, j, k, l) + subroutine s_abstract_hyperelastic_solver(btensor, q_prim_vf, G, j, k, l) import :: scalar_field, sys_size, b_size type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(IN) :: btensor - integer, intent(IN) :: j, k, l - + type(scalar_field), dimension(b_size), intent(in) :: btensor + real(kind(0d0)), intent(in) :: G + integer, intent(in) :: j, k, l + end subroutine !> @} @@ -62,13 +63,14 @@ subroutine s_initialize_hyperelastic_module() !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, j, k, l) + subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) #ifdef MFC_SIMULATION !$acc routine seq #endif type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(IN) :: btensor - integer, intent(IN) :: j, k, l + type(scalar_field), dimension(b_size), intent(in) :: btensor + integer, intent(in) :: j, k, l + real(kind(0d0)), intent(in) :: G real(kind(0d0)), dimension(b_size - 1) :: tensor real(kind(0d0)) :: trace @@ -103,7 +105,7 @@ subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, j, k, l) !$acc loop seq do i = 1, b_size - 1 - q_prim_vf(strxb + i)%sf(j, k, l) = btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + q_prim_vf(strxb + i)%sf(j, k, l) = G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) end do ! compute the invariant without the elastic modulus diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 8c1ac168a1..2a608a16e2 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1079,7 +1079,7 @@ contains G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) end if - call s_compute_cauchy_solver(q_btensor,qK_prim_vf, j, k, l) + call s_compute_cauchy_solver(q_btensor, qK_prim_vf, G_K, j, k, l) end do end do end do @@ -1228,7 +1228,6 @@ contains if (hypoelasticity) then do i = stress_idx%beg, stress_idx%end - q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) ! adding elastic contribution if (G > verysmall) then q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & @@ -1247,14 +1246,11 @@ contains ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 if (hyperelasticity) then ! adding the elastic contribution - do i = xibeg, xiend - q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) - end do if (G > verysmall) then q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & G*f_elastic_energy(q_btensor, j, k, l) end if - call s_compute_cauchy_solver(q_btensor,q_prim_vf, j, k, l) + call s_compute_cauchy_solver(q_btensor,q_prim_vf, G, j, k, l) ! Multiply the \tau to \rho \tau do i = stress_idx%beg, stress_idx%end q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 151bfc8390..d277cc6e1f 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -1105,8 +1105,8 @@ contains !$acc loop seq do i = 1, b_size - 1 tau_e_L(i) = 0d0; tau_e_R(i) = 0d0; - !tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - !tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + !tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + !tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do end if From 62b7f56674bee1312a1205f8853db853aaae7c97 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 11 Jul 2024 20:20:40 -0400 Subject: [PATCH 239/380] debugged pre and post-process on CPUs, testing on GPUs --- src/common/m_hyperelastic.f90 | 9 +++++---- src/common/m_variables_conversion.fpp | 2 +- src/post_process/m_start_up.f90 | 4 ++++ src/pre_process/m_start_up.fpp | 4 ++++ submit_test.sh | 9 +++++++-- 5 files changed, 21 insertions(+), 7 deletions(-) diff --git a/src/common/m_hyperelastic.f90 b/src/common/m_hyperelastic.f90 index 538e014dfe..fcd4deff11 100644 --- a/src/common/m_hyperelastic.f90 +++ b/src/common/m_hyperelastic.f90 @@ -74,6 +74,7 @@ subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) real(kind(0d0)), dimension(b_size - 1) :: tensor real(kind(0d0)) :: trace + real(kind(0d0)) :: f13 = 1d0/3d0 integer :: i !< Generic loop iterators ! tensor is the symmetric tensor & calculate the trace of the tensor @@ -93,12 +94,12 @@ subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) !end if ! calculate the deviatoric of the tensor - btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - (1d0/3d0)*trace + btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace !if (num_dims == 2) then ! btensor(3)%sf(j,k,l) = btensor(3)%sf(j,k,l) - (1d0/3d0)*trace !else - btensor(4)%sf(j, k, l) = btensor(4)%sf(j, k, l) - (1d0/3d0)*trace - btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - (1d0/3d0)*trace + btensor(4)%sf(j, k, l) = btensor(4)%sf(j, k, l) - f13*trace + btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace !end if ! dividing by the jacobian for neo-Hookean model ! setting the tensor to the stresses for riemann solver @@ -110,7 +111,7 @@ subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) ! compute the invariant without the elastic modulus ! if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then - q_prim_vf(xiend + 1)%sf(j, k, l) = 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) + ! q_prim_vf(xiend + 1)%sf(j, k, l) = 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) ! else ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 ! end if diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 2a608a16e2..3533d4c53e 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1126,7 +1126,7 @@ contains ! btensor calculation ! s_calculate_btensor has its own triple nested for loop, with openacc if (hyperelasticity) then - call s_calculate_btensor(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) + !call s_calculate_btensor(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) end if ! Converting the primitive variables to the conservative variables diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index b54f8737c0..f3e8abd210 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -19,6 +19,8 @@ module m_start_up use m_variables_conversion !< Subroutines to change the state variables from !! one form to another + use m_hyperelastic !< Hyperelasticity module for RMT + use m_data_input !< Procedures reading raw simulation data to fill !! the conservative, primitive and grid variables @@ -679,6 +681,7 @@ subroutine s_initialize_modules call s_initialize_data_input_module() call s_initialize_derived_variables_module() call s_initialize_data_output_module() + if (hyperelasticity) call s_initialize_hyperelastic_module() ! Associate pointers for serial or parallel I/O if (parallel_io .neqv. .true.) then @@ -726,6 +729,7 @@ subroutine s_finalize_modules call s_finalize_data_output_module() call s_finalize_derived_variables_module() call s_finalize_data_input_module() + if (hyperelasticity) call s_finalize_hyperelastic_module() call s_finalize_variables_conversion_module() if (num_procs > 1) call s_finalize_mpi_proxy_module() call s_finalize_global_parameters_module() diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index fa185d2e24..29a8c7f06c 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -33,6 +33,8 @@ module m_start_up use m_phase_change !< Phase-change module + use m_hyperelastic !< Hyperelasticity module for RMT + use m_helper_basic !< Functions to compare floating point numbers use m_helper @@ -780,6 +782,7 @@ contains call s_initialize_initial_condition_module() call s_initialize_assign_variables_module() if (relax) call s_initialize_phasechange_module() + if (hyperelasticity) call s_initialize_hyperelastic_module() ! Associate pointers for serial or parallel I/O if (parallel_io .neqv. .true.) then @@ -929,6 +932,7 @@ contains call s_finalize_global_parameters_module() call s_finalize_assign_variables_module() if (relax) call s_finalize_relaxation_solver_module() + if (hyperelasticity) call s_finalize_hyperelastic_module() ! Finalization of the MPI environment call s_mpi_finalize() diff --git a/submit_test.sh b/submit_test.sh index 1a2f59a11a..a3d0cfde85 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -20,6 +20,11 @@ #./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 04:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta + +./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +#./mfc.sh run /users/mrodrig97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar +./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar From 04564ec941808eae7d1c5c82c4400400c7b13e30 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 11 Jul 2024 23:01:13 -0400 Subject: [PATCH 240/380] debugged pre and post_process, now investigating btensor calc and cauchy tensor calc --- src/common/m_variables_conversion.fpp | 19 +++++++++++-------- src/post_process/m_start_up.f90 | 2 +- src/pre_process/m_assign_variables.f90 | 2 +- 3 files changed, 13 insertions(+), 10 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 3533d4c53e..4365114c3e 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1032,6 +1032,10 @@ contains end if if (hyperelasticity) then + !$acc loop seq + do i = strxb, strxe + qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K + end do !$acc loop seq do i = xibeg, xiend qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K @@ -1075,11 +1079,11 @@ contains alpha_rho_K, Re_K, j, k, l, G_K, Gs) rho_K = max(rho_K, sgm_eps) if (G_K > verysmall) then - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & + !G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) end if - call s_compute_cauchy_solver(q_btensor, qK_prim_vf, G_K, j, k, l) + !call s_compute_cauchy_solver(q_btensor, qK_prim_vf, G_K, j, k, l) end do end do end do @@ -1219,7 +1223,6 @@ contains end do end if - if (elasticity) then do i = stress_idx%beg, stress_idx%end q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) @@ -1247,12 +1250,12 @@ contains if (hyperelasticity) then ! adding the elastic contribution if (G > verysmall) then - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - G*f_elastic_energy(q_btensor, j, k, l) + q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) !+ & + !G*f_elastic_energy(q_btensor, j, k, l) end if - call s_compute_cauchy_solver(q_btensor,q_prim_vf, G, j, k, l) + !call s_compute_cauchy_solver(q_btensor,q_prim_vf, G, j, k, l) ! Multiply the \tau to \rho \tau - do i = stress_idx%beg, stress_idx%end + do i = xibeg, xiend q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) end do end if diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index f3e8abd210..beaaa06261 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -319,7 +319,7 @@ subroutine s_save_data(t_step, varname, pres, c, H) end if ! ---------------------------------------------------------------------- ! Adding the elastic shear stresses to the formatted database file ----- - if (hypoelasticity .or. hyperelasticity) then + if (elasticity) then do i = 1, stress_idx%end - stress_idx%beg + 1 if (prim_vars_wrt) then q_sf = q_prim_vf(i - 1 + stress_idx%beg)%sf( & diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 index 8b094de4a3..4a49c46abe 100644 --- a/src/pre_process/m_assign_variables.f90 +++ b/src/pre_process/m_assign_variables.f90 @@ -479,7 +479,7 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & ! assigning the reference map to the q_prim vector field do i = 1, num_dims q_prim_vf(i + xibeg - 1)%sf(j, k, l) = eta*xi_cart(i) + & - (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1) + (1d0 - eta)*orig_prim_vf(i + xibeg - 1) end do end if From f001949e7cb748630f4d8024206aed2cda3f215b Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 12 Jul 2024 00:03:39 -0400 Subject: [PATCH 241/380] debugged issue for the cauchy tensor update --- src/common/m_hyperelastic.f90 | 6 +++++- src/common/m_variables_conversion.fpp | 10 +++++----- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/src/common/m_hyperelastic.f90 b/src/common/m_hyperelastic.f90 index fcd4deff11..3930dbdd98 100644 --- a/src/common/m_hyperelastic.f90 +++ b/src/common/m_hyperelastic.f90 @@ -106,7 +106,11 @@ subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) !$acc loop seq do i = 1, b_size - 1 - q_prim_vf(strxb + i)%sf(j, k, l) = G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + q_prim_vf(strxb + i - 1)%sf(j, k, l) = G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + + if (q_prim_vf(strxb +i)%sf(j,k,l) /= q_prim_vf(strxb + i)%sf(j,k,l)) then + print *, 'error with the code' + end if end do ! compute the invariant without the elastic modulus diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 4365114c3e..fa0a932b2c 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1060,9 +1060,9 @@ contains if (hyperelasticity) then #ifdef MFC_SIMULATION - call s_calculate_btensor_acc(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) + !call s_calculate_btensor_acc(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) #else - call s_calculate_btensor(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) + call s_calculate_btensor_acc(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) #endif !print *, 'I got here AAA' !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) @@ -1083,7 +1083,7 @@ contains !G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) end if - !call s_compute_cauchy_solver(q_btensor, qK_prim_vf, G_K, j, k, l) + call s_compute_cauchy_solver(q_btensor, qK_prim_vf, G_K, j, k, l) end do end do end do @@ -1130,7 +1130,7 @@ contains ! btensor calculation ! s_calculate_btensor has its own triple nested for loop, with openacc if (hyperelasticity) then - !call s_calculate_btensor(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) + call s_calculate_btensor_acc(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) end if ! Converting the primitive variables to the conservative variables @@ -1253,7 +1253,7 @@ contains q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) !+ & !G*f_elastic_energy(q_btensor, j, k, l) end if - !call s_compute_cauchy_solver(q_btensor,q_prim_vf, G, j, k, l) + call s_compute_cauchy_solver(q_btensor,q_prim_vf, G, j, k, l) ! Multiply the \tau to \rho \tau do i = xibeg, xiend q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) From 81a3ae7ea7f811752be2b1856a0d7afd76b02d10 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 14 Jul 2024 10:16:02 -0400 Subject: [PATCH 242/380] last check of the code, before moving xi calcs to simulation and out of pre and post process --- src/common/m_hyperelastic.f90 | 16 ++++----- src/common/m_variables_conversion.fpp | 50 ++++++++++++--------------- src/common/m_xi_tensor.f90 | 11 +++--- 3 files changed, 35 insertions(+), 42 deletions(-) diff --git a/src/common/m_hyperelastic.f90 b/src/common/m_hyperelastic.f90 index 3930dbdd98..50d21e586f 100644 --- a/src/common/m_hyperelastic.f90 +++ b/src/common/m_hyperelastic.f90 @@ -106,19 +106,17 @@ subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) !$acc loop seq do i = 1, b_size - 1 - q_prim_vf(strxb + i - 1)%sf(j, k, l) = G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) - - if (q_prim_vf(strxb +i)%sf(j,k,l) /= q_prim_vf(strxb + i)%sf(j,k,l)) then - print *, 'error with the code' - end if + q_prim_vf(strxb + i - 1)%sf(j, k, l) = & + G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) end do ! compute the invariant without the elastic modulus - ! if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then - ! q_prim_vf(xiend + 1)%sf(j, k, l) = 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) - ! else + if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then + q_prim_vf(xiend + 1)%sf(j, k, l) = & + 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) + else ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 - ! end if + end if end subroutine s_neoHookean_cauchy_solver subroutine s_finalize_hyperelastic_module() diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index fa0a932b2c..5f03c7730e 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -883,7 +883,7 @@ contains integer :: i, j, k, l, q !< Generic loop iterators - real(kind(0.d0)) :: ntmp + real(kind(0d0)) :: ntmp type(scalar_field), dimension(b_size) :: q_btensor @@ -1017,7 +1017,7 @@ contains qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & /rho_K ! subtracting elastic contribution for pressure calculation - if (G_K > 1000) then !TODO: check if stable for >0 + if (G_K .gt. verysmall) then !TODO: check if stable for >0 qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K ! extra terms in 2 and 3D @@ -1059,11 +1059,7 @@ contains !print *, 'I got here AA' if (hyperelasticity) then -#ifdef MFC_SIMULATION - !call s_calculate_btensor_acc(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) -#else call s_calculate_btensor_acc(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) -#endif !print *, 'I got here AAA' !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) do l = izb, ize @@ -1078,12 +1074,14 @@ contains call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & alpha_rho_K, Re_K, j, k, l, G_K, Gs) rho_K = max(rho_K, sgm_eps) - if (G_K > verysmall) then - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & + if (G_K .gt. verysmall) then + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & !G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) + call s_compute_cauchy_solver(q_btensor, qK_prim_vf, G_K, j, k, l) + else + call s_compute_cauchy_solver(q_btensor, qK_prim_vf, 0d0, j, k, l) end if - call s_compute_cauchy_solver(q_btensor, qK_prim_vf, G_K, j, k, l) end do end do end do @@ -1130,7 +1128,7 @@ contains ! btensor calculation ! s_calculate_btensor has its own triple nested for loop, with openacc if (hyperelasticity) then - call s_calculate_btensor_acc(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) + call s_calculate_btensor_acc(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) end if ! Converting the primitive variables to the conservative variables @@ -1223,16 +1221,11 @@ contains end do end if - if (elasticity) then - do i = stress_idx%beg, stress_idx%end - q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) - end do - end if - if (hypoelasticity) then - do i = stress_idx%beg, stress_idx%end + do i = strxb, strxe + q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) ! adding elastic contribution - if (G > verysmall) then + if (G .gt. verysmall) then q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) ! extra terms in 2 and 3D @@ -1249,12 +1242,18 @@ contains ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 if (hyperelasticity) then ! adding the elastic contribution - if (G > verysmall) then - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) !+ & - !G*f_elastic_energy(q_btensor, j, k, l) + if (G .gt. verysmall) then + q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) !+ & + !G*f_elastic_energy(q_btensor, j, k, l) + !call s_compute_cauchy_solver(q_btensor,q_prim_vf, G, j, k, l) + else + call s_compute_cauchy_solver(q_btensor,q_prim_vf, 0d0, j, k, l) end if - call s_compute_cauchy_solver(q_btensor,q_prim_vf, G, j, k, l) - ! Multiply the \tau to \rho \tau + ! Multiply \tau to \rho \tau + do i = strxb, strxe + q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) + end do + ! Multiply \xi to \rho \xi do i = xibeg, xiend q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) end do @@ -1267,22 +1266,17 @@ contains end do end do end do - - ! deallocating the btensor do l = 1, b_size @:DEALLOCATE(q_btensor(l)%sf) end do #else - if (proc_rank == 0) then call s_mpi_abort('Conversion from primitive to '// & 'conservative variables not '// & 'implemented. Exiting ...') end if - #endif - end subroutine s_convert_primitive_to_conservative_variables !> The following subroutine handles the conversion between diff --git a/src/common/m_xi_tensor.f90 b/src/common/m_xi_tensor.f90 index 3e7221af89..a6988f204b 100644 --- a/src/common/m_xi_tensor.f90 +++ b/src/common/m_xi_tensor.f90 @@ -1282,14 +1282,15 @@ subroutine s_calculate_btensor_acc(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor integer, intent(in) :: xb, xe, yb, ye, zb, ze + integer :: j, k, l real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb - integer :: j, k, l, i + integer :: i ! if (num_dims == 1) then -!! !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) -! do l = izb, ize -! do k = iyb, iye -! do j = ixb, ixe + !!$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) + !!do l = izb, ize + ! do k = iyb, iye + ! do j = ixb, ixe ! call s_compute_gradient_xi1d_acc(q_prim_vf, ixb, ixe, iyb, & ! iye, izb, ize, j, k, l, tensora, tensorb) ! !! 1: 1D, 3: 2D, 6: 3D From b1556d857cc84caaf37f17ee669fe0a3f32531a7 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 14 Jul 2024 18:37:38 -0400 Subject: [PATCH 243/380] hypoelasticity can now do grid stretching, building up hyper to do the same --- src/simulation/m_global_parameters.fpp | 10 ++- src/simulation/m_hypoelastic.fpp | 116 +++++++++++++------------ src/simulation/m_start_up.fpp | 3 +- src/simulation/m_viscous.fpp | 2 - submit_test.sh | 9 +- 5 files changed, 77 insertions(+), 63 deletions(-) diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index f28a9ba6c0..73410511fe 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -306,6 +306,7 @@ module m_global_parameters !! The finite-difference number is given by MAX(1, fd_order/2). Essentially, !! it is a measure of the half-size of the finite-difference stencil for the !! selected order of accuracy. + !$acc declare create(fd_order,fd_number) logical :: probe_wrt logical :: integral_wrt @@ -1030,6 +1031,12 @@ contains buff_size = weno_polyn + 2 end if + if (elasticity) then + fd_order = 4 + fd_number = max(1, fd_order/2) + !buff_size = buff_size + fd_number + end if + ! Configuring Coordinate Direction Indexes ========================= if (bubbles) then ix%beg = -buff_size; iy%beg = 0; iz%beg = 0 @@ -1059,7 +1066,8 @@ contains if (p > 0) then startz = -buff_size end if - + + !$acc update device(fd_order,fd_number) !$acc update device(startx, starty, startz) if (cyl_coord .neqv. .true.) then ! Cartesian grid diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index 8311339b5a..9260963ca6 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -15,6 +15,8 @@ module m_hypoelastic use m_mpi_proxy !< Message passing interface (MPI) module proxy + use m_helper + ! ========================================================================== implicit none @@ -46,6 +48,10 @@ module m_hypoelastic real(kind(0d0)), allocatable, dimension(:, :, :) :: rho_K_field, G_K_field !$acc declare create(rho_K_field, G_K_field) + real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_x + real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_y + real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_z + !$acc declare create(fd_coeff_x,fd_coeff_y,fd_coeff_z) #endif contains @@ -70,6 +76,28 @@ contains end do !$acc update device(Gs) + @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) + if (n > 0) then + @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) + end if + if (p > 0) then + @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) + end if + + ! Computing centered finite difference coefficients + call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & + fd_number, fd_order) + + if (n > 0) then + call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & + fd_number, fd_order) + end if + if (p > 0) then + call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & + fd_number, fd_order) + end if + !$acc update device(fd_coeff_x,fd_coeff_y,fd_coeff_z) + end subroutine s_initialize_hypoelastic_module !> The purpose of this procedure is to compute the source terms @@ -85,7 +113,7 @@ contains real(kind(0d0)) :: rho_K, G_K - integer :: i, k, l, q !< Loop variables + integer :: i, k, l, q, r !< Loop variables integer :: ndirs !< Number of coordinate directions ndirs = 1; if (n > 0) ndirs = 2; if (p > 0) ndirs = 3 @@ -94,43 +122,33 @@ contains ! calculate velocity gradients + rho_K and G_K ! TODO: re-organize these loops one by one for GPU efficiency if possible? - !$acc parallel loop collapse(3) gang vector default(present) + !$acc parallel loop collapse(4) gang vector default(present) do q = 0, p do l = 0, n do k = 0, m - du_dx(k, l, q) = & - (q_prim_vf(momxb)%sf(k - 2, l, q) & - - 8d0*q_prim_vf(momxb)%sf(k - 1, l, q) & - + 8d0*q_prim_vf(momxb)%sf(k + 1, l, q) & - - q_prim_vf(momxb)%sf(k + 2, l, q)) & - /(12d0*dx(k)) + du_dx(k, l, q) = 0d0 + do r = -fd_number, fd_number + du_dx(k, l, q) = du_dx(k, l, q) & + + q_prim_vf(momxb)%sf(k + r, l, q)*fd_coeff_x(r, k) + end do end do end do end do if (ndirs > 1) then - !$acc parallel loop collapse(3) gang vector default(present) + !$acc parallel loop collapse(4) gang vector default(present) do q = 0, p do l = 0, n do k = 0, m - du_dy(k, l, q) = & - (q_prim_vf(momxb)%sf(k, l - 2, q) & - - 8d0*q_prim_vf(momxb)%sf(k, l - 1, q) & - + 8d0*q_prim_vf(momxb)%sf(k, l + 1, q) & - - q_prim_vf(momxb)%sf(k, l + 2, q)) & - /(12d0*dy(l)) - dv_dx(k, l, q) = & - (q_prim_vf(momxb + 1)%sf(k - 2, l, q) & - - 8d0*q_prim_vf(momxb + 1)%sf(k - 1, l, q) & - + 8d0*q_prim_vf(momxb + 1)%sf(k + 1, l, q) & - - q_prim_vf(momxb + 1)%sf(k + 2, l, q)) & - /(12d0*dx(k)) - dv_dy(k, l, q) = & - (q_prim_vf(momxb + 1)%sf(k, l - 2, q) & - - 8d0*q_prim_vf(momxb + 1)%sf(k, l - 1, q) & - + 8d0*q_prim_vf(momxb + 1)%sf(k, l + 1, q) & - - q_prim_vf(momxb + 1)%sf(k, l + 2, q)) & - /(12d0*dy(l)) + du_dy(k, l, q) = 0d0; dv_dx(k, l, q) = 0d0; dv_dy(k, l, q) = 0d0; + do r = -fd_number, fd_number + du_dy(k, l, q) = du_dy(k, l, q) & + + q_prim_vf(momxb)%sf(k, l + r, q)*fd_coeff_y(r, l) + dv_dx(k, l, q) = dv_dx(k, l, q) & + + q_prim_vf(momxb + 1)%sf(k + r, l, q)*fd_coeff_x(r, k) + dv_dy(k, l, q) = dv_dy(k, l, q) & + + q_prim_vf(momxb + 1)%sf(k, l + r, q)*fd_coeff_y(r, l) + end do end do end do end do @@ -141,36 +159,20 @@ contains do q = 0, p do l = 0, n do k = 0, m - du_dz(k, l, q) = & - (q_prim_vf(momxb)%sf(k, l, q - 2) & - - 8d0*q_prim_vf(momxb)%sf(k, l, q - 1) & - + 8d0*q_prim_vf(momxb)%sf(k, l, q + 1) & - - q_prim_vf(momxb)%sf(k, l, q + 2)) & - /(12d0*dz(q)) - dv_dz(k, l, q) = & - (q_prim_vf(momxb + 1)%sf(k, l, q - 2) & - - 8d0*q_prim_vf(momxb + 1)%sf(k, l, q - 1) & - + 8d0*q_prim_vf(momxb + 1)%sf(k, l, q + 1) & - - q_prim_vf(momxb + 1)%sf(k, l, q + 2)) & - /(12d0*dz(q)) - dw_dx(k, l, q) = & - (q_prim_vf(momxe)%sf(k - 2, l, q) & - - 8d0*q_prim_vf(momxe)%sf(k - 1, l, q) & - + 8d0*q_prim_vf(momxe)%sf(k + 1, l, q) & - - q_prim_vf(momxe)%sf(k + 2, l, q)) & - /(12d0*dx(k)) - dw_dy(k, l, q) = & - (q_prim_vf(momxe)%sf(k, l - 2, q) & - - 8d0*q_prim_vf(momxe)%sf(k, l - 1, q) & - + 8d0*q_prim_vf(momxe)%sf(k, l + 1, q) & - - q_prim_vf(momxe)%sf(k, l + 2, q)) & - /(12d0*dy(l)) - dw_dz(k, l, q) = & - (q_prim_vf(momxe)%sf(k, l, q - 2) & - - 8d0*q_prim_vf(momxe)%sf(k, l, q - 1) & - + 8d0*q_prim_vf(momxe)%sf(k, l, q + 1) & - - q_prim_vf(momxe)%sf(k, l, q + 2)) & - /(12d0*dz(q)) + du_dz(k, l, q) = 0d0; dv_dz(k, l, q) = 0d0; dw_dx(k, l, q) = 0d0; + dw_dy(k, l, q) = 0d0; dw_dz(k, l, q) = 0d0; + do r = -fd_number, fd_number + du_dz(k, l, q) = du_dz(k, l, q) & + + q_prim_vf(momxb)%sf(k, l, q + r)*fd_coeff_z(r, q) + dv_dz(k, l, q) = dv_dz(k, l, q) & + + q_prim_vf(momxb + 1)%sf(k, l, q + r)*fd_coeff_z(r, q) + dw_dx(k, l, q) = dw_dx(k, l, q) & + + q_prim_vf(momxe)%sf(k + r, l, q)*fd_coeff_x(r, k) + dw_dy(k, l, q) = dw_dy(k, l, q) & + + q_prim_vf(momxe)%sf(k, l + r, q)*fd_coeff_y(r, l) + dw_dz(k, l, q) = dw_dz(k, l, q) & + + q_prim_vf(momxe)%sf(k, l, q + r)*fd_coeff_z(r, q) + end do end do end do end do diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 3951d6b6a3..f17e59f640 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -1274,7 +1274,6 @@ contains call acc_present_dump() #endif - if (hypoelasticity) call s_initialize_hypoelastic_module() if (relax) call s_initialize_phasechange_module() call s_initialize_data_output_module() call s_initialize_derived_variables_module() @@ -1316,6 +1315,8 @@ contains call s_initialize_cbc_module() call s_initialize_derived_variables() + if (hypoelasticity) call s_initialize_hypoelastic_module() + end subroutine s_initialize_modules subroutine s_initialize_mpi_domain diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp index 0019779e55..5bdf4b8497 100644 --- a/src/simulation/m_viscous.fpp +++ b/src/simulation/m_viscous.fpp @@ -12,8 +12,6 @@ module m_viscous use m_global_parameters !< Definitions of the global parameters use m_weno - - use m_helper ! ========================================================================== private; public s_get_viscous, & diff --git a/submit_test.sh b/submit_test.sh index a3d0cfde85..ad94805dbc 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -24,7 +24,12 @@ #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar #./mfc.sh run /users/mrodrig97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar -./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar +#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar + +./mfc.sh run /users/mrodri97/hMFC/tests/9EB947DB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +./mfc.sh run /users/mrodri97/hMFC/tests/9EB947DB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar + + From 2f30499d02d6ba82cf4ca9c91409842436807f25 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 14 Jul 2024 18:40:11 -0400 Subject: [PATCH 244/380] improved hypo for acc and fixed shear modulus limit --- src/simulation/m_hypoelastic.fpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index 9260963ca6..638dd4abed 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -155,7 +155,7 @@ contains ! 3D if (ndirs == 3) then - !$acc parallel loop collapse(3) gang vector default(present) + !$acc parallel loop collapse(4) gang vector default(present) do q = 0, p do l = 0, n do k = 0, m @@ -192,7 +192,7 @@ contains G_K_field(k, l, q) = G_K !TODO: take this out if not needed - if (G_K < 1000) then + if (G_K < verysmall) then G_K_field(k, l, q) = 0 end if end do From 7491445105a6a03e9d1664794df1c84757f2923d Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 14 Jul 2024 20:50:19 -0500 Subject: [PATCH 245/380] data issue, checking on Oscar --- src/common/m_helper.fpp | 7 ++--- src/simulation/m_hypoelastic.fpp | 53 +++++++++++++++++++++++++++----- submit_test.sh | 4 +-- 3 files changed, 50 insertions(+), 14 deletions(-) diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp index b6d4872973..a2b770828d 100644 --- a/src/common/m_helper.fpp +++ b/src/common/m_helper.fpp @@ -73,8 +73,8 @@ contains lE = q end if - if (allocated(fd_coeff_s)) deallocate (fd_coeff_s) - allocate (fd_coeff_s(-fd_number_in:fd_number_in, lb:lE)) + if (allocated(fd_coeff_s)) deallocate(fd_coeff_s) + allocate(fd_coeff_s(-fd_number_in:fd_number_in, lb:lE)) ! Computing the 1st order finite-difference coefficients if (fd_order_in == 1) then @@ -83,7 +83,6 @@ contains fd_coeff_s(0, i) = -1d0/(s_cc(i + 1) - s_cc(i)) fd_coeff_s(1, i) = -fd_coeff_s(0, i) end do - ! Computing the 2nd order finite-difference coefficients elseif (fd_order_in == 2) then do i = lB, lE @@ -91,7 +90,6 @@ contains fd_coeff_s(0, i) = 0d0 fd_coeff_s(1, i) = -fd_coeff_s(-1, i) end do - ! Computing the 4th order finite-difference coefficients else do i = lB, lE @@ -101,7 +99,6 @@ contains fd_coeff_s(1, i) = -fd_coeff_s(-1, i) fd_coeff_s(2, i) = -fd_coeff_s(-2, i) end do - end if end subroutine s_compute_finite_difference_coefficients diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index 638dd4abed..88116676ed 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -58,7 +58,7 @@ contains subroutine s_initialize_hypoelastic_module - integer :: i + integer :: i, k, r @:ALLOCATE_GLOBAL(Gs(1:num_fluids)) @:ALLOCATE_GLOBAL(rho_K_field(0:m,0:n,0:p), G_K_field(0:m,0:n,0:p)) @@ -87,16 +87,25 @@ contains ! Computing centered finite difference coefficients call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & fd_number, fd_order) - + !!!!$acc update device(fd_coeff_x) if (n > 0) then call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & fd_number, fd_order) + !!!$acc update device(fd_coeff_y) end if if (p > 0) then call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & fd_number, fd_order) + !!!$acc update device(fd_coeff_z) end if - !$acc update device(fd_coeff_x,fd_coeff_y,fd_coeff_z) + + !!!!$acc loop seq + do k = 0, m + print *, 'x_cc :: ',x_cc(k) + do r = -fd_number, fd_number + print *, 'fd_co :: ',fd_coeff_x(r,k) + end do + end do end subroutine s_initialize_hypoelastic_module @@ -122,11 +131,20 @@ contains ! calculate velocity gradients + rho_K and G_K ! TODO: re-organize these loops one by one for GPU efficiency if possible? + !$acc parallel loop collapse(3) gang vector default(present) + do q = 0, p + do l = 0, n + do k = 0, m + du_dx(k, l, q) = 0d0; + end do + end do + end do + !$acc end parallel loop + !$acc parallel loop collapse(4) gang vector default(present) do q = 0, p do l = 0, n do k = 0, m - du_dx(k, l, q) = 0d0 do r = -fd_number, fd_number du_dx(k, l, q) = du_dx(k, l, q) & + q_prim_vf(momxb)%sf(k + r, l, q)*fd_coeff_x(r, k) @@ -134,13 +152,23 @@ contains end do end do end do + !$acc end parallel loop if (ndirs > 1) then + !$acc parallel loop collapse(3) gang vector default(present) + do q = 0, p + do l = 0, n + do k = 0, m + du_dy(k, l, q) = 0d0; dv_dx(k, l, q) = 0d0; dv_dy(k, l, q) = 0d0; + end do + end do + end do + !$acc end parallel loop + !$acc parallel loop collapse(4) gang vector default(present) do q = 0, p do l = 0, n do k = 0, m - du_dy(k, l, q) = 0d0; dv_dx(k, l, q) = 0d0; dv_dy(k, l, q) = 0d0; do r = -fd_number, fd_number du_dy(k, l, q) = du_dy(k, l, q) & + q_prim_vf(momxb)%sf(k, l + r, q)*fd_coeff_y(r, l) @@ -152,15 +180,25 @@ contains end do end do end do + !$acc end parallel loop ! 3D if (ndirs == 3) then + !$acc parallel loop collapse(3) gang vector default(present) + do q = 0, p + do l = 0, n + do k = 0, m + du_dz(k, l, q) = 0d0; dv_dz(k, l, q) = 0d0; dw_dx(k, l, q) = 0d0; + dw_dy(k, l, q) = 0d0; dw_dz(k, l, q) = 0d0; + end do + end do + end do + !$acc end parallel loop + !$acc parallel loop collapse(4) gang vector default(present) do q = 0, p do l = 0, n do k = 0, m - du_dz(k, l, q) = 0d0; dv_dz(k, l, q) = 0d0; dw_dx(k, l, q) = 0d0; - dw_dy(k, l, q) = 0d0; dw_dz(k, l, q) = 0d0; do r = -fd_number, fd_number du_dz(k, l, q) = du_dz(k, l, q) & + q_prim_vf(momxb)%sf(k, l, q + r)*fd_coeff_z(r, q) @@ -176,6 +214,7 @@ contains end do end do end do + !$acc end parallel loop end if end if diff --git a/submit_test.sh b/submit_test.sh index ad94805dbc..c544960d23 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -28,8 +28,8 @@ #./mfc.sh run /users/mrodrig97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar -./mfc.sh run /users/mrodri97/hMFC/tests/9EB947DB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -./mfc.sh run /users/mrodri97/hMFC/tests/9EB947DB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar +./mfc.sh run /u/rodrigu1/hMFC/tests/9EB947DB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run /u/rodrigu1/hMFC/tests/9EB947DB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta From b9c0102ee0efff9a2f060bc715813771455dfe6c Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 14 Jul 2024 21:34:43 -0500 Subject: [PATCH 246/380] fixed the ACC commands for grid stretching of hypo --- src/simulation/m_hypoelastic.fpp | 53 ++++++++++++++------------------ 1 file changed, 23 insertions(+), 30 deletions(-) diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index 88116676ed..e4342e508c 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -87,26 +87,18 @@ contains ! Computing centered finite difference coefficients call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & fd_number, fd_order) - !!!!$acc update device(fd_coeff_x) + !$acc update device(fd_coeff_x) if (n > 0) then call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & fd_number, fd_order) - !!!$acc update device(fd_coeff_y) + !$acc update device(fd_coeff_y) end if if (p > 0) then call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & fd_number, fd_order) - !!!$acc update device(fd_coeff_z) + !$acc update device(fd_coeff_z) end if - !!!!$acc loop seq - do k = 0, m - print *, 'x_cc :: ',x_cc(k) - do r = -fd_number, fd_number - print *, 'fd_co :: ',fd_coeff_x(r,k) - end do - end do - end subroutine s_initialize_hypoelastic_module !> The purpose of this procedure is to compute the source terms @@ -140,19 +132,19 @@ contains end do end do !$acc end parallel loop - - !$acc parallel loop collapse(4) gang vector default(present) - do q = 0, p + + do r = -fd_number, fd_number + !$acc parallel loop collapse(3) gang vector default(present) + do q = 0, p do l = 0, n do k = 0, m - do r = -fd_number, fd_number - du_dx(k, l, q) = du_dx(k, l, q) & - + q_prim_vf(momxb)%sf(k + r, l, q)*fd_coeff_x(r, k) - end do + du_dx(k, l, q) = du_dx(k, l, q) & + + q_prim_vf(momxb)%sf(k + r, l, q)*fd_coeff_x(r, k) end do end do - end do + end do !$acc end parallel loop + end do if (ndirs > 1) then !$acc parallel loop collapse(3) gang vector default(present) @@ -165,25 +157,26 @@ contains end do !$acc end parallel loop - !$acc parallel loop collapse(4) gang vector default(present) - do q = 0, p + do r = -fd_number, fd_number + !$acc parallel loop collapse(3) gang vector default(present) + do q = 0, p do l = 0, n do k = 0, m - do r = -fd_number, fd_number du_dy(k, l, q) = du_dy(k, l, q) & + q_prim_vf(momxb)%sf(k, l + r, q)*fd_coeff_y(r, l) dv_dx(k, l, q) = dv_dx(k, l, q) & + q_prim_vf(momxb + 1)%sf(k + r, l, q)*fd_coeff_x(r, k) dv_dy(k, l, q) = dv_dy(k, l, q) & + q_prim_vf(momxb + 1)%sf(k, l + r, q)*fd_coeff_y(r, l) - end do end do - end do + end do + end do + !$acc end parallel loop end do - !$acc end parallel loop ! 3D if (ndirs == 3) then + !$acc parallel loop collapse(3) gang vector default(present) do q = 0, p do l = 0, n @@ -195,11 +188,11 @@ contains end do !$acc end parallel loop - !$acc parallel loop collapse(4) gang vector default(present) - do q = 0, p + do r = -fd_number, fd_number + !$acc parallel loop collapse(3) gang vector default(present) + do q = 0, p do l = 0, n do k = 0, m - do r = -fd_number, fd_number du_dz(k, l, q) = du_dz(k, l, q) & + q_prim_vf(momxb)%sf(k, l, q + r)*fd_coeff_z(r, q) dv_dz(k, l, q) = dv_dz(k, l, q) & @@ -210,11 +203,11 @@ contains + q_prim_vf(momxe)%sf(k, l + r, q)*fd_coeff_y(r, l) dw_dz(k, l, q) = dw_dz(k, l, q) & + q_prim_vf(momxe)%sf(k, l, q + r)*fd_coeff_z(r, q) - end do end do end do + end do + !$acc end parallel loop end do - !$acc end parallel loop end if end if From d223e410ab88fdd969dcc459de4b33c17f1b7231 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 14 Jul 2024 22:50:15 -0500 Subject: [PATCH 247/380] merging RMT code into hyperelastic module in simulation, not yet done towards compilation --- src/simulation/m_hyperelastic.fpp | 2030 +++++++++++++++++++++++++++++ src/simulation/m_rhs.fpp | 2 + 2 files changed, 2032 insertions(+) create mode 100644 src/simulation/m_hyperelastic.fpp diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp new file mode 100644 index 0000000000..723438b101 --- /dev/null +++ b/src/simulation/m_hyperelastic.fpp @@ -0,0 +1,2030 @@ +!> +!! @file m_hyperelastic.f90 +!! @brief Contains module m_hyperelastic + +!> @brief This module consists of subroutines used in the calculation +!! of the cauchy tensor + +module m_hyperelastic + + ! Dependencies ============================================================= + use m_derived_types !< Definitions of the derived types + + use m_global_parameters !< Definitions of the global parameters + ! ========================================================================== + + implicit none + + private; public :: s_compute_cauchy_solver, & + s_initialize_hyperelastic_module, & + s_finalize_hyperelastic_module + + !> @name Abstract interface for creating function pointers + !> @{ + abstract interface + + !> @name Abstract subroutine for the infinite relaxation solver + !> @{ + subroutine s_abstract_hyperelastic_solver(btensor, q_prim_vf, G, j, k, l) + + import :: scalar_field, sys_size, b_size + type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(in) :: btensor + real(kind(0d0)), intent(in) :: G + integer, intent(in) :: j, k, l + + end subroutine + !> @} + + end interface + !> @} + + procedure(s_abstract_hyperelastic_solver), pointer :: s_compute_cauchy_solver => null() + + + + + + + + + + type(scalar_field), dimension(b_size) :: q_btensor + type(scalar_field), dimension(b_size) :: q_btensor + + !! The btensor at the cell-interior Gaussian quadrature points. + !! These tensor is needed to be calculated once and make the code DRY. + type(vector_field) :: q_btensor !< + !$acc declare create(q_btensor) + + if (hyperelasticity) then + do l = 1, b_size + allocate (q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) + end do + end if + + if (hyperelasticity) then + @:ALLOCATE(q_btensor%vf(1:b_size)) + do i = 1, b_size + @:ALLOCATE(q_btensor%vf(i)%sf(ixb:ixe, iyb:iye, izb:ize)) + end do + @:ACC_SETUP_VFs(q_btensor) + end if + + if (hyperelasticity) then + call s_calculate_btensor_acc(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) + !print *, 'I got here AAA' + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe + !$acc loop seq + do i = 1, num_fluids + alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) + alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) + end do + ! If in simulation, use acc mixture subroutines + call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & + alpha_rho_K, Re_K, j, k, l, G_K, Gs) + rho_K = max(rho_K, sgm_eps) + if (G_K .gt. verysmall) then + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & + !G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K + !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) + call s_compute_cauchy_solver(q_btensor, qK_prim_vf, G_K, j, k, l) + else + call s_compute_cauchy_solver(q_btensor, qK_prim_vf, 0d0, j, k, l) + end if + end do + end do + end do + !$acc end parallel loop + end if + +contains + + subroutine s_initialize_hyperelastic_module() + + ! Associating procedural pointer to the subroutine that will be + ! utilized to calculate the solution of a given Riemann problem + !if (hyper_model == 1) then + s_compute_cauchy_solver => s_neoHookean_cauchy_solver + !elseif (riemann_solver == 2) then + ! s_compute_cauchy_solver => s_Mooney_Rivlin_cauchy_solver + !end if + + end subroutine + + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) +#ifdef MFC_SIMULATION + !$acc routine seq +#endif + type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(in) :: btensor + integer, intent(in) :: j, k, l + real(kind(0d0)), intent(in) :: G + + real(kind(0d0)), dimension(b_size - 1) :: tensor + real(kind(0d0)) :: trace + real(kind(0d0)) :: f13 = 1d0/3d0 + integer :: i !< Generic loop iterators + + ! tensor is the symmetric tensor & calculate the trace of the tensor + !trace = btensor(1)%sf(j,k,l) + !if (num_dims == 2) then + ! trace = trace + btensor(3)%sf(j,k,l) + !else + trace = btensor(1)%sf(j, k, l) + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + !end if + + ! invariant calculation, saving it in the q_prim_vf field + !invariant1 = btensor(1)%sf(j, k, l) + !if (num_dims == 2) then + ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) + !elseif (num_dims == 3) then + ! invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + !end if + + ! calculate the deviatoric of the tensor + btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace + !if (num_dims == 2) then + ! btensor(3)%sf(j,k,l) = btensor(3)%sf(j,k,l) - (1d0/3d0)*trace + !else + btensor(4)%sf(j, k, l) = btensor(4)%sf(j, k, l) - f13*trace + btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace + !end if + ! dividing by the jacobian for neo-Hookean model + ! setting the tensor to the stresses for riemann solver + + !$acc loop seq + do i = 1, b_size - 1 + q_prim_vf(strxb + i - 1)%sf(j, k, l) = & + G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + end do + + ! compute the invariant without the elastic modulus + if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then + q_prim_vf(xiend + 1)%sf(j, k, l) = & + 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) + else + ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 + end if + end subroutine s_neoHookean_cauchy_solver + + subroutine s_finalize_hyperelastic_module() + ! Disassociating procedural pointer to the subroutine which was + ! utilized to calculate the solution of a given Riemann problem + s_compute_cauchy_solver => null() + end subroutine + +end module m_hyperelastic +!> +!! @file m_xi_tensor_calc.f90 +!! @brief Contains module m_xi_tensor_calc + +!> @brief This module consists of subroutines used in the calculation of matrix +!! operations for the reference map tensor + +module m_xi_tensor + + ! Dependencies ============================================================= + use m_derived_types !< Definitions of the derived types + + use m_global_parameters !< Definitions of the global parameters + ! ========================================================================== + + implicit none + + private; public :: s_compute_gradient_xi, & + s_compute_gradient_xi1d_acc, & + s_compute_gradient_xi2d_acc, & + s_compute_gradient_xi3d_acc, & + f_elastic_energy, & + s_calculate_btensor, & + s_calculate_btensor_acc, & + s_calculate_cauchy_from_btensor + +contains + + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + !! neo-Hookean only at this time, will need to be changed later + function f_elastic_energy(btensor, j, k, l) +#ifdef MFC_SIMULATION + !$acc routine seq +#endif + type(scalar_field), dimension(b_size), intent(IN) :: btensor + integer, intent(IN) :: j, k, l + real(kind(0d0)) :: invariant1, f_elastic_energy + + f_elastic_energy = 0d0 + invariant1 = btensor(1)%sf(j, k, l) + !if (num_dims == 2) then + ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) + !elseif (num_dims == 3) then + invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + !end if + + ! compute the invariant without the elastic modulus + f_elastic_energy = 0.5d0*(invariant1 - 3.0d0)/btensor(b_size)%sf(j, k, l) + + end function f_elastic_energy + + + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- + zb, ze, j, k, l, tensora, tensorb) + + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora, tensorb + integer, intent(IN) :: xb, xe, yb, ye, zb, ze + integer, intent(IN) :: j, k, l + + real(kind(0d0)) :: determinant + integer :: i + ! STEP 1: computing the grad_xi tensor + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz + if (j == xb) then + ! dxix/dx + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + else if (j == xb + 1) then + ! dxix/dx + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + q_prim_vf(xibeg)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == xe - 1) then + ! dxix/dx + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - q_prim_vf(xibeg)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == xe) then + ! dxix/dx + tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxix/dx + tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + if (num_dims > 1) then + if (j == xb) then + ! dxiy / dx + tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + else if (j == xb + 1) then + ! dxiy / dx + tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == xe - 1) then + ! dxiy / dx + tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == xe) then + ! dxiy / dx + tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxiy / dx + tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + if (k == yb) then + ! dxix / dy + tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + else if (k == yb + 1) then + ! dxix / dy + tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + q_prim_vf(xibeg)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye - 1) then + ! dxix / dy + tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - q_prim_vf(xibeg)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye) then + ! dxix / dy + tensora(3) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxix / dy + tensora(3) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + if (k == yb) then + ! dxiy / dy + tensora(4) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + else if (k == yb + 1) then + ! dxiy / dy + tensora(4) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye - 1) then + ! dxiy / dy + tensora(4) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye) then + ! dxiy / dy + tensora(4) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxiy / dy + tensora(4) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + end if + + ! 3D + if (num_dims > 2) then + ! using results from upper if statement to map form 2x2 to 3x3 tensor + tensora(5) = tensora(4) + tensora(4) = tensora(3) + + if (l == zb) then + ! dxix / dz + tensora(7) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xibeg)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xibeg)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == zb + 1) then + ! dxix / dz + tensora(7) = (-3d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & + + q_prim_vf(xibeg)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze - 1) then + ! dxix / dz + tensora(7) = (3d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & + - q_prim_vf(xibeg)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze) then + ! dxix / dz + tensora(7) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xibeg)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xibeg)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxix / dz + tensora(7) = (q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - q_prim_vf(xibeg)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if + + if (l == zb) then + ! dxiy / dz + tensora(8) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == zb + 1) then + ! dxiy / dz + tensora(8) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & + + q_prim_vf(xibeg + 1)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze - 1) then + ! dxiy / dz + tensora(8) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - q_prim_vf(xibeg + 1)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze) then + ! dxiy / dz + tensora(8) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxiy / dz + tensora(8) = (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if + + if (j == xb) then + ! dxiz / dx + tensora(3) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + else if (j == xb + 1) then + ! dxiz / dx + tensora(3) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + q_prim_vf(xiend)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == xe - 1) then + ! dxiz / dx + tensora(3) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - q_prim_vf(xiend)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == xe) then + ! dxiz / dx + tensora(3) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxiz / dx + tensora(3) = (q_prim_vf(xiend)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - q_prim_vf(xiend)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + if (k == yb) then + ! dxiz / dy + tensora(6) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + else if (k == yb + 1) then + ! dxiz / dy + tensora(6) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + q_prim_vf(xiend)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye - 1) then + ! dxiz / dy + tensora(6) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - q_prim_vf(xiend)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == ye) then + ! dxiz / dy + tensora(6) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxiz / dy + tensora(6) = (q_prim_vf(xiend)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - q_prim_vf(xiend)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + if (l == zb) then + ! dxiz / dz + tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xiend)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xiend)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xiend)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == zb + 1) then + ! dxiz / dz + tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xiend)%sf(j, k, l + 2) & + + q_prim_vf(xiend)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze - 1) then + ! dxiz / dz + tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xiend)%sf(j, k, l - 2) & + - q_prim_vf(xiend)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze) then + ! dxiz / dz + tensora(9) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xiend)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xiend)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xiend)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxiz / dz + tensora(9) = (q_prim_vf(xiend)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - q_prim_vf(xiend)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if + end if + + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + if (num_dims == 1) then + tensorb(1) = 1 + elseif (num_dims == 2) then + tensorb(1) = tensora(4) + tensorb(2) = -tensora(3) + tensorb(3) = -tensora(2) + tensorb(4) = tensora(1) + elseif (num_dims == 3) then + tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) + tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) + tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) + tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) + tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) + tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) + tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) + tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) + tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) + end if + + ! STEP 2b: computing the determinant of the grad_xi tensor + if (num_dims == 1) then + determinant = tensora(1) + elseif (num_dims == 2) then + determinant = tensora(1)*tensora(4) - tensora(2)*tensora(3) + else + determinant = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + end if + ! error checking + !if (determinant == 0) then + ! print *, 'determinant :: ', determinant + ! print *, 'ERROR: Determinant was zero' + ! stop + !end if + if (determinant < 0d0 .or. determinant > 2d0) then + print *, 'i, j, k :: ', j, ' ', k, ' ', l, ',det ::', tensorb(tensor_size) + ! stop + end if + + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/determinant + end do + + ! STEP 3: computing F tranpose F + tensorb(1) = tensora(1)**2 + if (num_dims == 2) then + tensorb(1) = tensorb(1) + tensora(3)**2 + tensorb(2) = tensora(1)*tensora(2) + tensora(3)*tensora(4) + tensorb(3) = tensorb(2) + tensorb(4) = tensora(2)**2 + tensora(4)**2 + elseif (num_dims == 3) then + tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 + tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 + tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) + tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) + tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) + tensorb(4) = tensorb(2) + tensorb(7) = tensorb(3) + tensorb(8) = tensorb(6) + end if + ! STEP 4: store the determinant of F in the last entry of the tensor + tensorb(tensor_size) = determinant + + end subroutine s_compute_gradient_xi + + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_calculate_btensor(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) + + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(INOUT) :: btensor + integer, intent(IN) :: xb, xe, yb, ye, zb, ze + real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb + integer :: j, k, l + + do l = zb, ze + do k = yb, ye + do j = xb, xe + call s_compute_gradient_xi(q_prim_vf, xb, xe, yb, & + ye, zb, ze, j, k, l, tensora, tensorb) + ! 1: 1D, 3: 2D, 6: 3D + btensor(1)%sf(j, k, l) = tensorb(1) + !if (num_dims > 1) then ! 2D + btensor(2)%sf(j, k, l) = tensorb(2) + ! btensor(3)%sf(j,k,l) = tensorb(4) + !end if + !if (num_dims > 2) then ! 3D + btensor(3)%sf(j, k, l) = tensorb(3) + btensor(4)%sf(j, k, l) = tensorb(5) + btensor(5)%sf(j, k, l) = tensorb(6) + btensor(6)%sf(j, k, l) = tensorb(9) + !end if + ! store the determinant at the last entry of the btensor sf + btensor(b_size)%sf(j, k, l) = tensorb(tensor_size) + end do + end do + end do + end subroutine s_calculate_btensor + + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_compute_gradient_xi1d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- + izb, ize, j, k, l, tensora, tensorb) + !$acc routine seq + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb + integer, intent(IN) :: ixb, ixe, iyb, iye, izb, ize + integer, intent(IN) :: j, k, l + integer :: i + + ! STEP 1: computing the grad_xi tensor + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz + if (j == ixb) then + ! dxix/dx + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + else if (j == ixb + 1) then + ! dxix/dx + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + q_prim_vf(xibeg)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe - 1) then + ! dxix/dx + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - q_prim_vf(xibeg)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe) then + ! dxix/dx + tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxix/dx + tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = 1 + + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1) + + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse + + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do + + ! STEP 3: computing F tranpose F + tensorb(1) = tensora(1)**2 + ! STEP 4: store the determinant of F in the last entry of the tensor + !tensorb(tensor_size) = determinant + + end subroutine s_compute_gradient_xi1d_acc + + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_compute_gradient_xi2d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- + izb, ize, j, k, l, tensora, tensorb) + !$acc routine seq + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb + integer, intent(IN) :: ixb, ixe, iyb, iye, izb, ize + integer, intent(IN) :: j, k, l + integer :: i + + ! STEP 1: computing the grad_xi tensor + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz + if (j == ixb) then + ! dxix/dx + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + else if (j == ixb + 1) then + ! dxix/dx + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + q_prim_vf(xibeg)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe - 1) then + ! dxix/dx + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - q_prim_vf(xibeg)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe) then + ! dxix/dx + tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxix/dx + tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + ! 2D + if (j == ixb) then + ! dxiy / dx + tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + else if (j == ixb + 1) then + ! dxiy / dx + tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe - 1) then + ! dxiy / dx + tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe) then + ! dxiy / dx + tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxiy / dx + tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + end if + + if (k == iyb) then + ! dxix / dy + tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + else if (k == iyb + 1) then + ! dxix / dy + tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + q_prim_vf(xibeg)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye - 1) then + ! dxix / dy + tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - q_prim_vf(xibeg)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye) then + ! dxix / dy + tensora(3) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxix / dy + tensora(3) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + if (k == iyb) then + ! dxiy / dy + tensora(4) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + else if (k == iyb + 1) then + ! dxiy / dy + tensora(4) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye - 1) then + ! dxiy / dy + tensora(4) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye) then + ! dxiy / dy + tensora(4) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxiy / dy + tensora(4) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = tensora(4) + tensorb(2) = -tensora(3) + tensorb(3) = -tensora(2) + tensorb(4) = tensora(1) + + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1)*tensora(4) - tensora(2)*tensora(3) + + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do + ! STEP 3: computing F tranpose F + tensorb(1) = tensora(1)**2 + tensorb(1) = tensorb(1) + tensora(3)**2 + tensorb(2) = tensora(1)*tensora(2) + tensora(3)*tensora(4) + tensorb(3) = tensorb(2) + tensorb(4) = tensora(2)**2 + tensora(4)**2 + + ! STEP 4: store the determinant of F in the last entry of the tensor + + end subroutine s_compute_gradient_xi2d_acc + + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- + izb, ize, j, k, l, tensora, tensorb) + !$acc routine seq + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora + real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb + integer, intent(IN) :: ixb, ixe + integer, intent(IN) :: iyb, iye + integer, intent(IN) :: izb, ize + integer, intent(IN) :: j, k, l + + integer :: i + + ! STEP 1: computing the grad_xi tensor + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz + + ! 1D + if (j == ixb) then + ! dxix/dx + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + ! dxiy / dx + tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + ! dxiz / dx + tensora(7) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + + else if (j == ixb + 1) then + ! dxix/dx + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + q_prim_vf(xibeg)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(7) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + q_prim_vf(xiend)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + + else if (j == ixe - 1) then + ! dxix/dx + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - q_prim_vf(xibeg)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(7) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - q_prim_vf(xiend)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else if (j == ixe) then + ! dxix/dx + tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(7) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + else + ! dxix/dx + tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(7) = (q_prim_vf(xiend)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - q_prim_vf(xiend)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + + end if + + ! 2D + if (k == iyb) then + ! dxix / dy + tensora(4) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + ! dxiy / dy + tensora(5) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + ! dxiz / dy + tensora(8) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + + else if (k == iyb + 1) then + ! dxix / dy + tensora(4) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + q_prim_vf(xibeg)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(8) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + q_prim_vf(xiend)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye - 1) then + ! dxix / dy + tensora(4) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - q_prim_vf(xibeg)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(8) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - q_prim_vf(xiend)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else if (k == iye) then + ! dxix / dy + tensora(4) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(8) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxix / dy + tensora(4) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(8) = (q_prim_vf(xiend)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - q_prim_vf(xiend)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + ! 3D + if (l == izb) then + ! dxix / dz + tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xibeg)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xibeg)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiy / dz + tensora(6) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiz / dz + tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xiend)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xiend)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xiend)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == izb + 1) then + ! dxix / dz + tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & + + q_prim_vf(xibeg)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & + + q_prim_vf(xibeg + 1)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xiend)%sf(j, k, l + 2) & + + q_prim_vf(xiend)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ize - 1) then + ! dxix / dz + tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & + - q_prim_vf(xibeg)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - q_prim_vf(xibeg + 1)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xiend)%sf(j, k, l - 2) & + - q_prim_vf(xiend)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ize) then + ! dxix / dz + tensora(3) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xibeg)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xibeg)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xiend)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xiend)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xiend)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxix / dz + tensora(3) = (q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - q_prim_vf(xibeg)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(6) = (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (q_prim_vf(xiend)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - q_prim_vf(xiend)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if + + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) + tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) + tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) + tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) + tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) + tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) + tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) + tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) + tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) + + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse + ! STEP 4: store the determinant of F in the last entry of the tensor + + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do + + ! STEP 3: computing F tranpose F + tensorb(1) = tensora(1)**2 + tensorb(1) = tensorb(1) + tensora(4)**2 + tensora(7)**2 + tensorb(5) = tensora(2) + tensora(5)**2 + tensora(8)**2 + tensorb(9) = tensora(3) + tensora(6)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(2) + tensora(4)*tensora(5) + tensora(7)*tensora(8) + tensorb(3) = tensora(1)*tensora(3) + tensora(4)*tensora(6) + tensora(7)*tensora(9) + tensorb(6) = tensora(2)*tensora(3) + tensora(5)*tensora(6) + tensora(8)*tensora(9) + tensorb(4) = tensorb(2) + tensorb(7) = tensorb(3) + tensorb(8) = tensorb(4) + + end subroutine s_compute_gradient_xi3d_acc + + + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_calculate_btensor_acc(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) + + type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(inout) :: btensor + integer, intent(in) :: xb, xe, yb, ye, zb, ze + integer :: j, k, l + real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb + integer :: i + +! if (num_dims == 1) then + !!$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) + !!do l = izb, ize + ! do k = iyb, iye + ! do j = ixb, ixe +! call s_compute_gradient_xi1d_acc(q_prim_vf, ixb, ixe, iyb, & +! iye, izb, ize, j, k, l, tensora, tensorb) +! !! 1: 1D, 3: 2D, 6: 3D +! btensor(1)%sf(j, k, l) = tensorb(1) +! !! store the determinant at the last entry of the btensor sf +! btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) +! end do +! end do +! end do +! !$acc end parallel loop +! else if (num_dims == 2) then ! 2D +! !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) +! do l = izb, ize +! do k = iyb, iye +! do j = ixb, ixe +! call s_compute_gradient_xi2d_acc(q_prim_vf, ixb, ixe, iyb, & +! iye, izb, ize, j, k, l, tensora, tensorb) +! !! 1: 1D, 3: 2D, 6: 3D +! btensor(1)%sf(j, k, l) = tensorb(1) +! btensor(2)%sf(j,k,l) = tensorb(2) +! btensor(3)%sf(j,k,l) = tensorb(4) +! !! store the determinant at the last entry of the btensor sf +! btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) +! end do +! end do +! end do +! !$acc end parallel loop +! else ! 3D + + !print *,'I got here AAAA' + !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) + do l = zb, ze + do k = yb, ye + do j = xb, xe + ! STEP 1: computing the grad_xi tensor + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz + + ! 1D + if (j == xb) then + ! dxix/dx + !print *, ' grid check xb :: ',q_prim_vf(xibeg)%sf(j, k, l) + tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + ! dxiy / dx + tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + ! dxiz / dx + tensora(3) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & + - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l)) & + /(12d0*(x_cb(j + 1) - x_cb(j))) + !print *, ' grid check xb :: ',tensora(1),tensora(2),tensora(7) + + else if (j == xb + 1) then + !print *, ' grid check xb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix/dx + tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & + + q_prim_vf(xibeg)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & + + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(3) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & + + q_prim_vf(xiend)%sf(j + 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + !print *, ' grid check xb1 :: ',tensora(1),tensora(2),tensora(7) + + else if (j == xe - 1) then + !print *, ' grid check xe1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix/dx + tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - q_prim_vf(xibeg)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(3) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - q_prim_vf(xiend)%sf(j - 3, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + !print *, ' grid check xe1 :: ',tensora(1),tensora(2),tensora(7) + + else if (j == xe) then + !print *, ' grid check xe :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix/dx + tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(3) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & + - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & + + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + !print *, ' grid check xe :: ',tensora(1),tensora(2),tensora(7) + + else + ! dxix/dx + tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & + - q_prim_vf(xibeg)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiy / dx + tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & + - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + ! dxiz / dx + tensora(3) = (q_prim_vf(xiend)%sf(j - 2, k, l) & + - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & + + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & + - q_prim_vf(xiend)%sf(j + 2, k, l)) & + /(12d0*(x_cb(j) - x_cb(j - 1))) + + end if + + ! 2D + if (k == yb) then + !print *, ' grid check yb :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix / dy + tensora(4) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + ! dxiy / dy + tensora(5) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + ! dxiz / dy + tensora(6) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & + - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l)) & + /(12d0*(y_cb(k + 1) - y_cb(k))) + !print *, ' grid check yb :: ',tensora(4),tensora(5),tensora(8) + + else if (k == yb + 1) then + !print *, ' grid check yb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix / dy + tensora(4) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & + + q_prim_vf(xibeg)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & + + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(6) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & + + q_prim_vf(xiend)%sf(j, k + 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + !print *, ' grid check yb1 :: ',tensora(4),tensora(5),tensora(8) + + else if (k == ye - 1) then + !print *, ' grid check ye1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix / dy + tensora(4) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - q_prim_vf(xibeg)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(6) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - q_prim_vf(xiend)%sf(j, k - 3, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + !print *, ' grid check yb1 :: ',tensora(4),tensora(5),tensora(8) + + else if (k == ye) then + !print *, ' grid check ye :: ',q_prim_vf(xibeg+1)%sf(j, k, l) + + ! dxix / dy + tensora(4) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(6) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & + - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & + + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + else + ! dxix / dy + tensora(4) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & + - q_prim_vf(xibeg)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiy / dy + tensora(5) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & + - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + ! dxiz / dy + tensora(6) = (q_prim_vf(xiend)%sf(j, k - 2, l) & + - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & + + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & + - q_prim_vf(xiend)%sf(j, k + 2, l)) & + /(12d0*(y_cb(k) - y_cb(k - 1))) + end if + + ! 3D + if (l == zb) then + !print *, ' grid check zb :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix / dz + tensora(7) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xibeg)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xibeg)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiy / dz + tensora(8) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + ! dxiz / dz + tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & + + 48d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - 36d0*q_prim_vf(xiend)%sf(j, k, l + 2) & + + 16d0*q_prim_vf(xiend)%sf(j, k, l + 3) & + - 3d0*q_prim_vf(xiend)%sf(j, k, l + 4)) & + /(12d0*(z_cb(l + 1) - z_cb(l))) + else if (l == zb + 1) then + !print *, ' grid check zb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) + + ! dxix / dz + tensora(7) = (-3d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & + + q_prim_vf(xibeg)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(8) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + + 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & + + q_prim_vf(xibeg + 1)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + - 10d0*q_prim_vf(xiend)%sf(j, k, l) & + + 18d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - 6d0*q_prim_vf(xiend)%sf(j, k, l + 2) & + + q_prim_vf(xiend)%sf(j, k, l + 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze - 1) then + !print *, ' grid check ze1 :: ',q_prim_vf(xiend)%sf(j, k, l) + + ! dxix / dz + tensora(7) = (3d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & + - q_prim_vf(xibeg)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(8) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - q_prim_vf(xibeg + 1)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + + 10d0*q_prim_vf(xiend)%sf(j, k, l) & + - 18d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 6d0*q_prim_vf(xiend)%sf(j, k, l - 2) & + - q_prim_vf(xiend)%sf(j, k, l - 3)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else if (l == ze) then + !print *, ' grid check ze :: ',q_prim_vf(xiend)%sf(j, k, l) + + ! dxix / dz + tensora(7) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xibeg)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xibeg)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(8) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & + - 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & + - 48d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 36d0*q_prim_vf(xiend)%sf(j, k, l - 2) & + - 16d0*q_prim_vf(xiend)%sf(j, k, l - 3) & + + 3d0*q_prim_vf(xiend)%sf(j, k, l - 4)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + else + ! dxix / dz + tensora(7) = (q_prim_vf(xibeg)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & + - q_prim_vf(xibeg)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiy / dz + tensora(8) = (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & + - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + ! dxiz / dz + tensora(9) = (q_prim_vf(xiend)%sf(j, k, l - 2) & + - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & + + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & + - q_prim_vf(xiend)%sf(j, k, l + 2)) & + /(12d0*(z_cb(l) - z_cb(l - 1))) + end if + + !print *, 'I got here AAAAA' + + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) + tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) + tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) + tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) + tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) + tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) + tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) + tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) + tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) + + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + + !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 3d0 ) then + ! print *, 'j, k, l :: ', j, k, l + ! do i = 1, 9 + ! print *,'i :: ',i,', ten :: ',tensorb(i) + ! end do + ! print *, 'det : ',tensorb(tensor_size) + ! tensorb(tensor_size) = 1d0 + !end if + + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse + ! STEP 4: store the determinant of F in the last entry of the tensor + + !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 2d0 ) then + tensorb(tensor_size) = 1d0 + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = 0d0 + end do + tensorb(1) = 1d0 + tensorb(5) = 1d0 + tensorb(9) = 1d0 + !end if + + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do + !print *, 'I got here A6' + ! STEP 3: computing F tranpose F + !tensorb(1) = tensora(1)**2 + tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 + tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 + tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) + tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) + tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) + tensorb(4) = tensorb(2) + tensorb(7) = tensorb(3) + tensorb(8) = tensorb(6) + !print *, 'I got here A7' + !call s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, & + !iye, izb, ize, j, k, l, tensora, tensorb) + !! 1: 1D, 3: 2D, 6: 3D + btensor(1)%sf(j, k, l) = tensorb(1) + btensor(2)%sf(j, k, l) = tensorb(2) + btensor(3)%sf(j, k, l) = tensorb(3) + btensor(4)%sf(j, k, l) = tensorb(5) + btensor(5)%sf(j, k, l) = tensorb(6) + btensor(6)%sf(j, k, l) = tensorb(9) + !print *, 'I got here A8' + !! store the determinant at the last entry of the btensor sf + btensor(b_size)%sf(j, k, l) = tensorb(tensor_size) + end do + end do + end do + !$acc end parallel loop + !print *, 'I got here A9' +! end if + end subroutine s_calculate_btensor_acc + + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, j, k, l) +#ifdef MFC_SIMULATION + !$acc routine seq +#endif + type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(IN) :: btensor + integer, intent(IN) :: j, k, l + + real(kind(0d0)), dimension(b_size - 1) :: tensor + real(kind(0d0)) :: trace + integer :: i !< Generic loop iterators + + ! tensor is the symmetric tensor & calculate the trace of the tensor + !trace = btensor(1)%sf(j,k,l) + !if (num_dims == 2) then + ! trace = trace + btensor(3)%sf(j,k,l) + !else + trace = btensor(1)%sf(j, k, l) + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + !end if + + ! invariant calculation, saving it in the q_prim_vf field + !invariant1 = btensor(1)%sf(j, k, l) + !if (num_dims == 2) then + ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) + !elseif (num_dims == 3) then + ! invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + !end if + + ! calculate the deviatoric of the tensor + btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - (1d0/3d0)*trace + !if (num_dims == 2) then + ! btensor(3)%sf(j,k,l) = btensor(3)%sf(j,k,l) - (1d0/3d0)*trace + !else + btensor(4)%sf(j, k, l) = btensor(4)%sf(j, k, l) - (1d0/3d0)*trace + btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - (1d0/3d0)*trace + !end if + ! dividing by the jacobian for neo-Hookean model + ! setting the tensor to the stresses for riemann solver + + !$acc loop seq + do i = 1, b_size - 1 + q_prim_vf(strxb + i)%sf(j, k, l) = btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + end do + + ! compute the invariant without the elastic modulus + ! if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then + q_prim_vf(xiend + 1)%sf(j, k, l) = 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) + ! else + ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 + ! end if + + end subroutine s_calculate_cauchy_from_btensor + +end module m_xi_tensor diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 39e6d7221d..65c9510ee3 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -39,6 +39,8 @@ module m_rhs use m_hypoelastic + use m_hyperelastic + use m_monopole use m_viscous From c4779cb3cd09b12b25a458154d07d4f49a115f01 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 15 Jul 2024 02:31:41 -0500 Subject: [PATCH 248/380] upgraded RMT hyperelastic code, need to integrate to m_rhs --- src/common/m_hyperelastic.f90 | 128 -- src/common/m_variables_conversion.fpp | 84 - src/common/m_xi_tensor.f90 | 1842 ---------------------- src/post_process/m_start_up.f90 | 4 - src/pre_process/m_start_up.fpp | 4 - src/simulation/m_hyperelastic.fpp | 2100 +++---------------------- src/simulation/m_hypoelastic.fpp | 9 +- src/simulation/m_start_up.fpp | 3 + 8 files changed, 215 insertions(+), 3959 deletions(-) delete mode 100644 src/common/m_hyperelastic.f90 delete mode 100644 src/common/m_xi_tensor.f90 diff --git a/src/common/m_hyperelastic.f90 b/src/common/m_hyperelastic.f90 deleted file mode 100644 index 50d21e586f..0000000000 --- a/src/common/m_hyperelastic.f90 +++ /dev/null @@ -1,128 +0,0 @@ -!> -!! @file m_xi_tensor_calc.f90 -!! @brief Contains module m_hyperelastic - -!> @brief This module consists of subroutines used in the calculation -!! of the cauchy tensor - -module m_hyperelastic - - ! Dependencies ============================================================= - use m_derived_types !< Definitions of the derived types - - use m_global_parameters !< Definitions of the global parameters - ! ========================================================================== - - implicit none - - private; public :: s_compute_cauchy_solver, & - s_initialize_hyperelastic_module, & - s_finalize_hyperelastic_module - - !> @name Abstract interface for creating function pointers - !> @{ - abstract interface - - !> @name Abstract subroutine for the infinite relaxation solver - !> @{ - subroutine s_abstract_hyperelastic_solver(btensor, q_prim_vf, G, j, k, l) - - import :: scalar_field, sys_size, b_size - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(in) :: btensor - real(kind(0d0)), intent(in) :: G - integer, intent(in) :: j, k, l - - end subroutine - !> @} - - end interface - !> @} - - procedure(s_abstract_hyperelastic_solver), pointer :: s_compute_cauchy_solver => null() - -contains - - subroutine s_initialize_hyperelastic_module() - - ! Associating procedural pointer to the subroutine that will be - ! utilized to calculate the solution of a given Riemann problem - !if (hyper_model == 1) then - s_compute_cauchy_solver => s_neoHookean_cauchy_solver - !elseif (riemann_solver == 2) then - ! s_compute_cauchy_solver => s_Mooney_Rivlin_cauchy_solver - !end if - - end subroutine - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) -#ifdef MFC_SIMULATION - !$acc routine seq -#endif - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(in) :: btensor - integer, intent(in) :: j, k, l - real(kind(0d0)), intent(in) :: G - - real(kind(0d0)), dimension(b_size - 1) :: tensor - real(kind(0d0)) :: trace - real(kind(0d0)) :: f13 = 1d0/3d0 - integer :: i !< Generic loop iterators - - ! tensor is the symmetric tensor & calculate the trace of the tensor - !trace = btensor(1)%sf(j,k,l) - !if (num_dims == 2) then - ! trace = trace + btensor(3)%sf(j,k,l) - !else - trace = btensor(1)%sf(j, k, l) + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) - !end if - - ! invariant calculation, saving it in the q_prim_vf field - !invariant1 = btensor(1)%sf(j, k, l) - !if (num_dims == 2) then - ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) - !elseif (num_dims == 3) then - ! invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) - !end if - - ! calculate the deviatoric of the tensor - btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace - !if (num_dims == 2) then - ! btensor(3)%sf(j,k,l) = btensor(3)%sf(j,k,l) - (1d0/3d0)*trace - !else - btensor(4)%sf(j, k, l) = btensor(4)%sf(j, k, l) - f13*trace - btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace - !end if - ! dividing by the jacobian for neo-Hookean model - ! setting the tensor to the stresses for riemann solver - - !$acc loop seq - do i = 1, b_size - 1 - q_prim_vf(strxb + i - 1)%sf(j, k, l) = & - G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) - end do - - ! compute the invariant without the elastic modulus - if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then - q_prim_vf(xiend + 1)%sf(j, k, l) = & - 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) - else - ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 - end if - end subroutine s_neoHookean_cauchy_solver - - subroutine s_finalize_hyperelastic_module() - ! Disassociating procedural pointer to the subroutine which was - ! utilized to calculate the solution of a given Riemann problem - s_compute_cauchy_solver => null() - end subroutine - -end module m_hyperelastic diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 5f03c7730e..5652470ac6 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -19,10 +19,6 @@ module m_variables_conversion use m_mpi_proxy !< Message passing interface (MPI) module proxy - use m_xi_tensor !< Using reference map matrix calculations - - use m_hyperelastic !< Using hyperelastic Cauchy tensor calculations - use m_helper_basic !< Functions to compare floating point numbers use m_helper @@ -109,11 +105,6 @@ module m_variables_conversion real(kind(0d0)), allocatable, dimension(:, :, :), public :: pi_inf_sf !< Scalar liquid stiffness function real(kind(0d0)), allocatable, dimension(:, :, :), public :: qv_sf !< Scalar liquid energy reference function - !! The btensor at the cell-interior Gaussian quadrature points. - !! These tensor is needed to be calculated once and make the code DRY. - type(vector_field) :: q_btensor !< - !$acc declare create(q_btensor) - procedure(s_convert_xxxxx_to_mixture_variables), & pointer :: s_convert_to_mixture_variables => null() !< !! Pointer referencing the subroutine s_convert_mixture_to_mixture_variables @@ -178,13 +169,6 @@ contains end if - if (hyperelasticity .and. present(G)) then - ! calculate elastic contribution to Energy - E_e = 0d0 - pres = (energy - 0.5d0*(mom**2.d0)/rho - pi_inf - qv - E_e)/gamma - - end if - end subroutine s_compute_pressure !> This subroutine is designed for the gamma/pi_inf model @@ -683,14 +667,6 @@ contains end if #endif - if (hyperelasticity) then - @:ALLOCATE(q_btensor%vf(1:b_size)) - do i = 1, b_size - @:ALLOCATE(q_btensor%vf(i)%sf(ixb:ixe, iyb:iye, izb:ize)) - end do - @:ACC_SETUP_VFs(q_btensor) - end if - if (bubbles) then #ifdef MFC_SIMULATION @:ALLOCATE_GLOBAL(bubrs(1:nb)) @@ -885,8 +861,6 @@ contains real(kind(0d0)) :: ntmp - type(scalar_field), dimension(b_size) :: q_btensor - #:if MFC_CASE_OPTIMIZATION #ifndef MFC_SIMULATION if (bubbles) then @@ -903,12 +877,6 @@ contains end if #:endif - if (hyperelasticity) then - do l = 1, b_size - allocate (q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) - end do - end if - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) do l = izb, ize do k = iyb, iye @@ -1058,36 +1026,6 @@ contains !print *, 'I got here AA' - if (hyperelasticity) then - call s_calculate_btensor_acc(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) - !print *, 'I got here AAA' - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe - !$acc loop seq - do i = 1, num_fluids - alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) - alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) - end do - ! If in simulation, use acc mixture subroutines - call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & - alpha_rho_K, Re_K, j, k, l, G_K, Gs) - rho_K = max(rho_K, sgm_eps) - if (G_K .gt. verysmall) then - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & - !G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K - !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) - call s_compute_cauchy_solver(q_btensor, qK_prim_vf, G_K, j, k, l) - else - call s_compute_cauchy_solver(q_btensor, qK_prim_vf, 0d0, j, k, l) - end if - end do - end do - end do - !$acc end parallel loop - end if - end subroutine s_convert_conservative_to_primitive_variables ! --------- !> The following procedure handles the conversion between @@ -1103,7 +1041,6 @@ contains type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf - type(scalar_field), dimension(b_size) :: q_btensor ! Density, specific heat ratio function, liquid stiffness function ! and dynamic pressure, as defined in the incompressible flow sense, @@ -1121,16 +1058,6 @@ contains integer :: i, j, k, l, q !< Generic loop iterators #ifndef MFC_SIMULATION - do l = 1, b_size - @:ALLOCATE(q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) - end do - - ! btensor calculation - ! s_calculate_btensor has its own triple nested for loop, with openacc - if (hyperelasticity) then - call s_calculate_btensor_acc(q_prim_vf, q_btensor, 0, m, 0, n, 0, p) - end if - ! Converting the primitive variables to the conservative variables do l = 0, p do k = 0, n @@ -1242,13 +1169,6 @@ contains ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 if (hyperelasticity) then ! adding the elastic contribution - if (G .gt. verysmall) then - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) !+ & - !G*f_elastic_energy(q_btensor, j, k, l) - !call s_compute_cauchy_solver(q_btensor,q_prim_vf, G, j, k, l) - else - call s_compute_cauchy_solver(q_btensor,q_prim_vf, 0d0, j, k, l) - end if ! Multiply \tau to \rho \tau do i = strxb, strxe q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) @@ -1266,10 +1186,6 @@ contains end do end do end do - ! deallocating the btensor - do l = 1, b_size - @:DEALLOCATE(q_btensor(l)%sf) - end do #else if (proc_rank == 0) then call s_mpi_abort('Conversion from primitive to '// & diff --git a/src/common/m_xi_tensor.f90 b/src/common/m_xi_tensor.f90 deleted file mode 100644 index a6988f204b..0000000000 --- a/src/common/m_xi_tensor.f90 +++ /dev/null @@ -1,1842 +0,0 @@ -!> -!! @file m_xi_tensor_calc.f90 -!! @brief Contains module m_xi_tensor_calc - -!> @brief This module consists of subroutines used in the calculation of matrix -!! operations for the reference map tensor - -module m_xi_tensor - - ! Dependencies ============================================================= - use m_derived_types !< Definitions of the derived types - - use m_global_parameters !< Definitions of the global parameters - ! ========================================================================== - - implicit none - - private; public :: s_compute_gradient_xi, & - s_compute_gradient_xi1d_acc, & - s_compute_gradient_xi2d_acc, & - s_compute_gradient_xi3d_acc, & - f_elastic_energy, & - s_calculate_btensor, & - s_calculate_btensor_acc, & - s_calculate_cauchy_from_btensor - -contains - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - !! neo-Hookean only at this time, will need to be changed later - function f_elastic_energy(btensor, j, k, l) -#ifdef MFC_SIMULATION - !$acc routine seq -#endif - type(scalar_field), dimension(b_size), intent(IN) :: btensor - integer, intent(IN) :: j, k, l - real(kind(0d0)) :: invariant1, f_elastic_energy - - f_elastic_energy = 0d0 - invariant1 = btensor(1)%sf(j, k, l) - !if (num_dims == 2) then - ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) - !elseif (num_dims == 3) then - invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) - !end if - - ! compute the invariant without the elastic modulus - f_elastic_energy = 0.5d0*(invariant1 - 3.0d0)/btensor(b_size)%sf(j, k, l) - - end function f_elastic_energy - - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- - zb, ze, j, k, l, tensora, tensorb) - - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora, tensorb - integer, intent(IN) :: xb, xe, yb, ye, zb, ze - integer, intent(IN) :: j, k, l - - real(kind(0d0)) :: determinant - integer :: i - ! STEP 1: computing the grad_xi tensor - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - if (j == xb) then - ! dxix/dx - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == xb + 1) then - ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + q_prim_vf(xibeg)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == xe - 1) then - ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - q_prim_vf(xibeg)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == xe) then - ! dxix/dx - tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxix/dx - tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - if (num_dims > 1) then - if (j == xb) then - ! dxiy / dx - tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == xb + 1) then - ! dxiy / dx - tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == xe - 1) then - ! dxiy / dx - tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == xe) then - ! dxiy / dx - tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxiy / dx - tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - if (k == yb) then - ! dxix / dy - tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - else if (k == yb + 1) then - ! dxix / dy - tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + q_prim_vf(xibeg)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye - 1) then - ! dxix / dy - tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - q_prim_vf(xibeg)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye) then - ! dxix / dy - tensora(3) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxix / dy - tensora(3) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - if (k == yb) then - ! dxiy / dy - tensora(4) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - else if (k == yb + 1) then - ! dxiy / dy - tensora(4) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye - 1) then - ! dxiy / dy - tensora(4) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye) then - ! dxiy / dy - tensora(4) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxiy / dy - tensora(4) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - end if - - ! 3D - if (num_dims > 2) then - ! using results from upper if statement to map form 2x2 to 3x3 tensor - tensora(5) = tensora(4) - tensora(4) = tensora(3) - - if (l == zb) then - ! dxix / dz - tensora(7) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xibeg)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xibeg)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == zb + 1) then - ! dxix / dz - tensora(7) = (-3d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & - + q_prim_vf(xibeg)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze - 1) then - ! dxix / dz - tensora(7) = (3d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & - - q_prim_vf(xibeg)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze) then - ! dxix / dz - tensora(7) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xibeg)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xibeg)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxix / dz - tensora(7) = (q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - q_prim_vf(xibeg)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - - if (l == zb) then - ! dxiy / dz - tensora(8) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == zb + 1) then - ! dxiy / dz - tensora(8) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & - + q_prim_vf(xibeg + 1)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze - 1) then - ! dxiy / dz - tensora(8) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - q_prim_vf(xibeg + 1)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze) then - ! dxiy / dz - tensora(8) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxiy / dz - tensora(8) = (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - - if (j == xb) then - ! dxiz / dx - tensora(3) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == xb + 1) then - ! dxiz / dx - tensora(3) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + q_prim_vf(xiend)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == xe - 1) then - ! dxiz / dx - tensora(3) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - q_prim_vf(xiend)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == xe) then - ! dxiz / dx - tensora(3) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxiz / dx - tensora(3) = (q_prim_vf(xiend)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - q_prim_vf(xiend)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - if (k == yb) then - ! dxiz / dy - tensora(6) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - else if (k == yb + 1) then - ! dxiz / dy - tensora(6) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + q_prim_vf(xiend)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye - 1) then - ! dxiz / dy - tensora(6) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - q_prim_vf(xiend)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye) then - ! dxiz / dy - tensora(6) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxiz / dy - tensora(6) = (q_prim_vf(xiend)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - if (l == zb) then - ! dxiz / dz - tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xiend)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xiend)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xiend)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == zb + 1) then - ! dxiz / dz - tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xiend)%sf(j, k, l + 2) & - + q_prim_vf(xiend)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze - 1) then - ! dxiz / dz - tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xiend)%sf(j, k, l - 2) & - - q_prim_vf(xiend)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze) then - ! dxiz / dz - tensora(9) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xiend)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xiend)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xiend)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxiz / dz - tensora(9) = (q_prim_vf(xiend)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - q_prim_vf(xiend)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - end if - - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - if (num_dims == 1) then - tensorb(1) = 1 - elseif (num_dims == 2) then - tensorb(1) = tensora(4) - tensorb(2) = -tensora(3) - tensorb(3) = -tensora(2) - tensorb(4) = tensora(1) - elseif (num_dims == 3) then - tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) - tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) - tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) - tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) - tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) - tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) - tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) - tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) - tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) - end if - - ! STEP 2b: computing the determinant of the grad_xi tensor - if (num_dims == 1) then - determinant = tensora(1) - elseif (num_dims == 2) then - determinant = tensora(1)*tensora(4) - tensora(2)*tensora(3) - else - determinant = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & - + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - end if - ! error checking - !if (determinant == 0) then - ! print *, 'determinant :: ', determinant - ! print *, 'ERROR: Determinant was zero' - ! stop - !end if - if (determinant < 0d0 .or. determinant > 2d0) then - print *, 'i, j, k :: ', j, ' ', k, ' ', l, ',det ::', tensorb(tensor_size) - ! stop - end if - - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/determinant - end do - - ! STEP 3: computing F tranpose F - tensorb(1) = tensora(1)**2 - if (num_dims == 2) then - tensorb(1) = tensorb(1) + tensora(3)**2 - tensorb(2) = tensora(1)*tensora(2) + tensora(3)*tensora(4) - tensorb(3) = tensorb(2) - tensorb(4) = tensora(2)**2 + tensora(4)**2 - elseif (num_dims == 3) then - tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 - tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 - tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) - tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) - tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) - tensorb(4) = tensorb(2) - tensorb(7) = tensorb(3) - tensorb(8) = tensorb(6) - end if - ! STEP 4: store the determinant of F in the last entry of the tensor - tensorb(tensor_size) = determinant - - end subroutine s_compute_gradient_xi - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_calculate_btensor(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) - - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(INOUT) :: btensor - integer, intent(IN) :: xb, xe, yb, ye, zb, ze - real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb - integer :: j, k, l - - do l = zb, ze - do k = yb, ye - do j = xb, xe - call s_compute_gradient_xi(q_prim_vf, xb, xe, yb, & - ye, zb, ze, j, k, l, tensora, tensorb) - ! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensorb(1) - !if (num_dims > 1) then ! 2D - btensor(2)%sf(j, k, l) = tensorb(2) - ! btensor(3)%sf(j,k,l) = tensorb(4) - !end if - !if (num_dims > 2) then ! 3D - btensor(3)%sf(j, k, l) = tensorb(3) - btensor(4)%sf(j, k, l) = tensorb(5) - btensor(5)%sf(j, k, l) = tensorb(6) - btensor(6)%sf(j, k, l) = tensorb(9) - !end if - ! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j, k, l) = tensorb(tensor_size) - end do - end do - end do - end subroutine s_calculate_btensor - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_compute_gradient_xi1d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- - izb, ize, j, k, l, tensora, tensorb) - !$acc routine seq - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb - integer, intent(IN) :: ixb, ixe, iyb, iye, izb, ize - integer, intent(IN) :: j, k, l - integer :: i - - ! STEP 1: computing the grad_xi tensor - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - if (j == ixb) then - ! dxix/dx - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == ixb + 1) then - ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + q_prim_vf(xibeg)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe - 1) then - ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - q_prim_vf(xibeg)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe) then - ! dxix/dx - tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxix/dx - tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = 1 - - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1) - - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse - - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - - ! STEP 3: computing F tranpose F - tensorb(1) = tensora(1)**2 - ! STEP 4: store the determinant of F in the last entry of the tensor - !tensorb(tensor_size) = determinant - - end subroutine s_compute_gradient_xi1d_acc - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_compute_gradient_xi2d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- - izb, ize, j, k, l, tensora, tensorb) - !$acc routine seq - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb - integer, intent(IN) :: ixb, ixe, iyb, iye, izb, ize - integer, intent(IN) :: j, k, l - integer :: i - - ! STEP 1: computing the grad_xi tensor - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - if (j == ixb) then - ! dxix/dx - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == ixb + 1) then - ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + q_prim_vf(xibeg)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe - 1) then - ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - q_prim_vf(xibeg)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe) then - ! dxix/dx - tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxix/dx - tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - ! 2D - if (j == ixb) then - ! dxiy / dx - tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == ixb + 1) then - ! dxiy / dx - tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe - 1) then - ! dxiy / dx - tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe) then - ! dxiy / dx - tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxiy / dx - tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - if (k == iyb) then - ! dxix / dy - tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - else if (k == iyb + 1) then - ! dxix / dy - tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + q_prim_vf(xibeg)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye - 1) then - ! dxix / dy - tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - q_prim_vf(xibeg)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye) then - ! dxix / dy - tensora(3) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxix / dy - tensora(3) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - if (k == iyb) then - ! dxiy / dy - tensora(4) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - else if (k == iyb + 1) then - ! dxiy / dy - tensora(4) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye - 1) then - ! dxiy / dy - tensora(4) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye) then - ! dxiy / dy - tensora(4) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxiy / dy - tensora(4) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = tensora(4) - tensorb(2) = -tensora(3) - tensorb(3) = -tensora(2) - tensorb(4) = tensora(1) - - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*tensora(4) - tensora(2)*tensora(3) - - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - ! STEP 3: computing F tranpose F - tensorb(1) = tensora(1)**2 - tensorb(1) = tensorb(1) + tensora(3)**2 - tensorb(2) = tensora(1)*tensora(2) + tensora(3)*tensora(4) - tensorb(3) = tensorb(2) - tensorb(4) = tensora(2)**2 + tensora(4)**2 - - ! STEP 4: store the determinant of F in the last entry of the tensor - - end subroutine s_compute_gradient_xi2d_acc - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- - izb, ize, j, k, l, tensora, tensorb) - !$acc routine seq - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb - integer, intent(IN) :: ixb, ixe - integer, intent(IN) :: iyb, iye - integer, intent(IN) :: izb, ize - integer, intent(IN) :: j, k, l - - integer :: i - - ! STEP 1: computing the grad_xi tensor - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - - ! 1D - if (j == ixb) then - ! dxix/dx - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - ! dxiy / dx - tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - ! dxiz / dx - tensora(7) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - - else if (j == ixb + 1) then - ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + q_prim_vf(xibeg)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(7) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + q_prim_vf(xiend)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - - else if (j == ixe - 1) then - ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - q_prim_vf(xibeg)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(7) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - q_prim_vf(xiend)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe) then - ! dxix/dx - tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(7) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxix/dx - tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(7) = (q_prim_vf(xiend)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - q_prim_vf(xiend)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - - end if - - ! 2D - if (k == iyb) then - ! dxix / dy - tensora(4) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - ! dxiy / dy - tensora(5) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - ! dxiz / dy - tensora(8) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - - else if (k == iyb + 1) then - ! dxix / dy - tensora(4) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + q_prim_vf(xibeg)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(8) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + q_prim_vf(xiend)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye - 1) then - ! dxix / dy - tensora(4) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - q_prim_vf(xibeg)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(8) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - q_prim_vf(xiend)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye) then - ! dxix / dy - tensora(4) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(8) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxix / dy - tensora(4) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(8) = (q_prim_vf(xiend)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - ! 3D - if (l == izb) then - ! dxix / dz - tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xibeg)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xibeg)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiy / dz - tensora(6) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiz / dz - tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xiend)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xiend)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xiend)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == izb + 1) then - ! dxix / dz - tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & - + q_prim_vf(xibeg)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & - + q_prim_vf(xibeg + 1)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xiend)%sf(j, k, l + 2) & - + q_prim_vf(xiend)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize - 1) then - ! dxix / dz - tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & - - q_prim_vf(xibeg)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - q_prim_vf(xibeg + 1)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xiend)%sf(j, k, l - 2) & - - q_prim_vf(xiend)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize) then - ! dxix / dz - tensora(3) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xibeg)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xibeg)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xiend)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xiend)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xiend)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxix / dz - tensora(3) = (q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - q_prim_vf(xibeg)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (q_prim_vf(xiend)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - q_prim_vf(xiend)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) - tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) - tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) - tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) - tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) - tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) - tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) - tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) - tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) - - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & - + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse - ! STEP 4: store the determinant of F in the last entry of the tensor - - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - - ! STEP 3: computing F tranpose F - tensorb(1) = tensora(1)**2 - tensorb(1) = tensorb(1) + tensora(4)**2 + tensora(7)**2 - tensorb(5) = tensora(2) + tensora(5)**2 + tensora(8)**2 - tensorb(9) = tensora(3) + tensora(6)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(2) + tensora(4)*tensora(5) + tensora(7)*tensora(8) - tensorb(3) = tensora(1)*tensora(3) + tensora(4)*tensora(6) + tensora(7)*tensora(9) - tensorb(6) = tensora(2)*tensora(3) + tensora(5)*tensora(6) + tensora(8)*tensora(9) - tensorb(4) = tensorb(2) - tensorb(7) = tensorb(3) - tensorb(8) = tensorb(4) - - end subroutine s_compute_gradient_xi3d_acc - - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_calculate_btensor_acc(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) - - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(inout) :: btensor - integer, intent(in) :: xb, xe, yb, ye, zb, ze - integer :: j, k, l - real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb - integer :: i - -! if (num_dims == 1) then - !!$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) - !!do l = izb, ize - ! do k = iyb, iye - ! do j = ixb, ixe -! call s_compute_gradient_xi1d_acc(q_prim_vf, ixb, ixe, iyb, & -! iye, izb, ize, j, k, l, tensora, tensorb) -! !! 1: 1D, 3: 2D, 6: 3D -! btensor(1)%sf(j, k, l) = tensorb(1) -! !! store the determinant at the last entry of the btensor sf -! btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) -! end do -! end do -! end do -! !$acc end parallel loop -! else if (num_dims == 2) then ! 2D -! !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) -! do l = izb, ize -! do k = iyb, iye -! do j = ixb, ixe -! call s_compute_gradient_xi2d_acc(q_prim_vf, ixb, ixe, iyb, & -! iye, izb, ize, j, k, l, tensora, tensorb) -! !! 1: 1D, 3: 2D, 6: 3D -! btensor(1)%sf(j, k, l) = tensorb(1) -! btensor(2)%sf(j,k,l) = tensorb(2) -! btensor(3)%sf(j,k,l) = tensorb(4) -! !! store the determinant at the last entry of the btensor sf -! btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) -! end do -! end do -! end do -! !$acc end parallel loop -! else ! 3D - - !print *,'I got here AAAA' - !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) - do l = zb, ze - do k = yb, ye - do j = xb, xe - ! STEP 1: computing the grad_xi tensor - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - - ! 1D - if (j == xb) then - ! dxix/dx - !print *, ' grid check xb :: ',q_prim_vf(xibeg)%sf(j, k, l) - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - ! dxiy / dx - tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - ! dxiz / dx - tensora(3) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - !print *, ' grid check xb :: ',tensora(1),tensora(2),tensora(7) - - else if (j == xb + 1) then - !print *, ' grid check xb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + q_prim_vf(xibeg)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(3) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + q_prim_vf(xiend)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - !print *, ' grid check xb1 :: ',tensora(1),tensora(2),tensora(7) - - else if (j == xe - 1) then - !print *, ' grid check xe1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - q_prim_vf(xibeg)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(3) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - q_prim_vf(xiend)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - !print *, ' grid check xe1 :: ',tensora(1),tensora(2),tensora(7) - - else if (j == xe) then - !print *, ' grid check xe :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix/dx - tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(3) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - !print *, ' grid check xe :: ',tensora(1),tensora(2),tensora(7) - - else - ! dxix/dx - tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(3) = (q_prim_vf(xiend)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - q_prim_vf(xiend)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - - end if - - ! 2D - if (k == yb) then - !print *, ' grid check yb :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dy - tensora(4) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - ! dxiy / dy - tensora(5) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - ! dxiz / dy - tensora(6) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - !print *, ' grid check yb :: ',tensora(4),tensora(5),tensora(8) - - else if (k == yb + 1) then - !print *, ' grid check yb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dy - tensora(4) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + q_prim_vf(xibeg)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(6) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + q_prim_vf(xiend)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - !print *, ' grid check yb1 :: ',tensora(4),tensora(5),tensora(8) - - else if (k == ye - 1) then - !print *, ' grid check ye1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dy - tensora(4) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - q_prim_vf(xibeg)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(6) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - q_prim_vf(xiend)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - !print *, ' grid check yb1 :: ',tensora(4),tensora(5),tensora(8) - - else if (k == ye) then - !print *, ' grid check ye :: ',q_prim_vf(xibeg+1)%sf(j, k, l) - - ! dxix / dy - tensora(4) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(6) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxix / dy - tensora(4) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(6) = (q_prim_vf(xiend)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - ! 3D - if (l == zb) then - !print *, ' grid check zb :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dz - tensora(7) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xibeg)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xibeg)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiy / dz - tensora(8) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiz / dz - tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xiend)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xiend)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xiend)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == zb + 1) then - !print *, ' grid check zb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dz - tensora(7) = (-3d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & - + q_prim_vf(xibeg)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(8) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & - + q_prim_vf(xibeg + 1)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xiend)%sf(j, k, l + 2) & - + q_prim_vf(xiend)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze - 1) then - !print *, ' grid check ze1 :: ',q_prim_vf(xiend)%sf(j, k, l) - - ! dxix / dz - tensora(7) = (3d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & - - q_prim_vf(xibeg)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(8) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - q_prim_vf(xibeg + 1)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xiend)%sf(j, k, l - 2) & - - q_prim_vf(xiend)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze) then - !print *, ' grid check ze :: ',q_prim_vf(xiend)%sf(j, k, l) - - ! dxix / dz - tensora(7) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xibeg)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xibeg)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(8) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xiend)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xiend)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xiend)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxix / dz - tensora(7) = (q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - q_prim_vf(xibeg)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(8) = (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (q_prim_vf(xiend)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - q_prim_vf(xiend)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - - !print *, 'I got here AAAAA' - - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) - tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) - tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) - tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) - tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) - tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) - tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) - tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) - tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) - - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & - + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - - !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 3d0 ) then - ! print *, 'j, k, l :: ', j, k, l - ! do i = 1, 9 - ! print *,'i :: ',i,', ten :: ',tensorb(i) - ! end do - ! print *, 'det : ',tensorb(tensor_size) - ! tensorb(tensor_size) = 1d0 - !end if - - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse - ! STEP 4: store the determinant of F in the last entry of the tensor - - !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 2d0 ) then - tensorb(tensor_size) = 1d0 - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = 0d0 - end do - tensorb(1) = 1d0 - tensorb(5) = 1d0 - tensorb(9) = 1d0 - !end if - - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - !print *, 'I got here A6' - ! STEP 3: computing F tranpose F - !tensorb(1) = tensora(1)**2 - tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 - tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 - tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) - tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) - tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) - tensorb(4) = tensorb(2) - tensorb(7) = tensorb(3) - tensorb(8) = tensorb(6) - !print *, 'I got here A7' - !call s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, & - !iye, izb, ize, j, k, l, tensora, tensorb) - !! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensorb(1) - btensor(2)%sf(j, k, l) = tensorb(2) - btensor(3)%sf(j, k, l) = tensorb(3) - btensor(4)%sf(j, k, l) = tensorb(5) - btensor(5)%sf(j, k, l) = tensorb(6) - btensor(6)%sf(j, k, l) = tensorb(9) - !print *, 'I got here A8' - !! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j, k, l) = tensorb(tensor_size) - end do - end do - end do - !$acc end parallel loop - !print *, 'I got here A9' -! end if - end subroutine s_calculate_btensor_acc - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, j, k, l) -#ifdef MFC_SIMULATION - !$acc routine seq -#endif - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(IN) :: btensor - integer, intent(IN) :: j, k, l - - real(kind(0d0)), dimension(b_size - 1) :: tensor - real(kind(0d0)) :: trace - integer :: i !< Generic loop iterators - - ! tensor is the symmetric tensor & calculate the trace of the tensor - !trace = btensor(1)%sf(j,k,l) - !if (num_dims == 2) then - ! trace = trace + btensor(3)%sf(j,k,l) - !else - trace = btensor(1)%sf(j, k, l) + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) - !end if - - ! invariant calculation, saving it in the q_prim_vf field - !invariant1 = btensor(1)%sf(j, k, l) - !if (num_dims == 2) then - ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) - !elseif (num_dims == 3) then - ! invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) - !end if - - ! calculate the deviatoric of the tensor - btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - (1d0/3d0)*trace - !if (num_dims == 2) then - ! btensor(3)%sf(j,k,l) = btensor(3)%sf(j,k,l) - (1d0/3d0)*trace - !else - btensor(4)%sf(j, k, l) = btensor(4)%sf(j, k, l) - (1d0/3d0)*trace - btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - (1d0/3d0)*trace - !end if - ! dividing by the jacobian for neo-Hookean model - ! setting the tensor to the stresses for riemann solver - - !$acc loop seq - do i = 1, b_size - 1 - q_prim_vf(strxb + i)%sf(j, k, l) = btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) - end do - - ! compute the invariant without the elastic modulus - ! if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then - q_prim_vf(xiend + 1)%sf(j, k, l) = 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) - ! else - ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 - ! end if - - end subroutine s_calculate_cauchy_from_btensor - -end module m_xi_tensor diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index beaaa06261..6a75ce8cda 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -19,8 +19,6 @@ module m_start_up use m_variables_conversion !< Subroutines to change the state variables from !! one form to another - use m_hyperelastic !< Hyperelasticity module for RMT - use m_data_input !< Procedures reading raw simulation data to fill !! the conservative, primitive and grid variables @@ -681,7 +679,6 @@ subroutine s_initialize_modules call s_initialize_data_input_module() call s_initialize_derived_variables_module() call s_initialize_data_output_module() - if (hyperelasticity) call s_initialize_hyperelastic_module() ! Associate pointers for serial or parallel I/O if (parallel_io .neqv. .true.) then @@ -729,7 +726,6 @@ subroutine s_finalize_modules call s_finalize_data_output_module() call s_finalize_derived_variables_module() call s_finalize_data_input_module() - if (hyperelasticity) call s_finalize_hyperelastic_module() call s_finalize_variables_conversion_module() if (num_procs > 1) call s_finalize_mpi_proxy_module() call s_finalize_global_parameters_module() diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index 29a8c7f06c..fa185d2e24 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -33,8 +33,6 @@ module m_start_up use m_phase_change !< Phase-change module - use m_hyperelastic !< Hyperelasticity module for RMT - use m_helper_basic !< Functions to compare floating point numbers use m_helper @@ -782,7 +780,6 @@ contains call s_initialize_initial_condition_module() call s_initialize_assign_variables_module() if (relax) call s_initialize_phasechange_module() - if (hyperelasticity) call s_initialize_hyperelastic_module() ! Associate pointers for serial or parallel I/O if (parallel_io .neqv. .true.) then @@ -932,7 +929,6 @@ contains call s_finalize_global_parameters_module() call s_finalize_assign_variables_module() if (relax) call s_finalize_relaxation_solver_module() - if (hyperelasticity) call s_finalize_hyperelastic_module() ! Finalization of the MPI environment call s_mpi_finalize() diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 723438b101..210107b553 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -2,20 +2,28 @@ !! @file m_hyperelastic.f90 !! @brief Contains module m_hyperelastic +#:include 'macros.fpp' + !> @brief This module consists of subroutines used in the calculation !! of the cauchy tensor module m_hyperelastic ! Dependencies ============================================================= + use m_derived_types !< Definitions of the derived types use m_global_parameters !< Definitions of the global parameters + + use m_variables_conversion !< State variables type conversion procedures + + use m_helper + ! ========================================================================== implicit none - private; public :: s_compute_cauchy_solver, & + private; public :: s_hyperelastic_rmt_stress_update, & s_initialize_hyperelastic_module, & s_finalize_hyperelastic_module @@ -25,11 +33,12 @@ module m_hyperelastic !> @name Abstract subroutine for the infinite relaxation solver !> @{ - subroutine s_abstract_hyperelastic_solver(btensor, q_prim_vf, G, j, k, l) + subroutine s_abstract_hyperelastic_solver(btensor, q_prim_vf, elastic_ene, G, j, k, l) import :: scalar_field, sys_size, b_size - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(in) :: btensor + type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(inout) :: btensor + real(kind(0d0)), intent(out) :: elastic_ene real(kind(0d0)), intent(in) :: G integer, intent(in) :: j, k, l @@ -41,80 +50,27 @@ module m_hyperelastic procedure(s_abstract_hyperelastic_solver), pointer :: s_compute_cauchy_solver => null() - - - - - - - - - type(scalar_field), dimension(b_size) :: q_btensor - type(scalar_field), dimension(b_size) :: q_btensor - !! The btensor at the cell-interior Gaussian quadrature points. !! These tensor is needed to be calculated once and make the code DRY. - type(vector_field) :: q_btensor !< - !$acc declare create(q_btensor) + type(vector_field) :: btensor !< + !$acc declare create(btensor) - if (hyperelasticity) then - do l = 1, b_size - allocate (q_btensor(l)%sf(ixb:ixe, iyb:iye, izb:ize)) - end do - end if +#ifdef CRAY_ACC_WAR + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), allocatable, dimension(:, :), fd_coeff_x, fd_coeff_y, fd_coeff_z) + !$acc declare link(fd_coeff_x,fd_coeff_y,fd_coeff_z) - if (hyperelasticity) then - @:ALLOCATE(q_btensor%vf(1:b_size)) - do i = 1, b_size - @:ALLOCATE(q_btensor%vf(i)%sf(ixb:ixe, iyb:iye, izb:ize)) - end do - @:ACC_SETUP_VFs(q_btensor) - end if +#else - if (hyperelasticity) then - call s_calculate_btensor_acc(qK_prim_vf, q_btensor, 0, m, 0, n, 0, p) - !print *, 'I got here AAA' - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, rho_K, gamma_K, pi_inf_K, qv_K, G_K) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe - !$acc loop seq - do i = 1, num_fluids - alpha_rho_K(i) = qK_cons_vf(i)%sf(j, k, l) - alpha_K(i) = qK_cons_vf(advxb + i - 1)%sf(j, k, l) - end do - ! If in simulation, use acc mixture subroutines - call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & - alpha_rho_K, Re_K, j, k, l, G_K, Gs) - rho_K = max(rho_K, sgm_eps) - if (G_K .gt. verysmall) then - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) !- & - !G_K*f_elastic_energy(q_btensor, j, k, l)/gamma_K - !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) - call s_compute_cauchy_solver(q_btensor, qK_prim_vf, G_K, j, k, l) - else - call s_compute_cauchy_solver(q_btensor, qK_prim_vf, 0d0, j, k, l) - end if - end do - end do - end do - !$acc end parallel loop - end if + real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_x + real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_y + real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_z + !$acc declare create(fd_coeff_x,fd_coeff_y,fd_coeff_z) + real(kind(0d0)), allocatable, dimension(:) :: Gs + !$acc declare create(Gs) +#endif contains - subroutine s_initialize_hyperelastic_module() - - ! Associating procedural pointer to the subroutine that will be - ! utilized to calculate the solution of a given Riemann problem - !if (hyper_model == 1) then - s_compute_cauchy_solver => s_neoHookean_cauchy_solver - !elseif (riemann_solver == 2) then - ! s_compute_cauchy_solver => s_Mooney_Rivlin_cauchy_solver - !end if - - end subroutine - !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. !! @param q_prim_vf Primitive variables @@ -123,601 +79,55 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) -#ifdef MFC_SIMULATION - !$acc routine seq -#endif - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(in) :: btensor - integer, intent(in) :: j, k, l - real(kind(0d0)), intent(in) :: G - - real(kind(0d0)), dimension(b_size - 1) :: tensor - real(kind(0d0)) :: trace - real(kind(0d0)) :: f13 = 1d0/3d0 - integer :: i !< Generic loop iterators - - ! tensor is the symmetric tensor & calculate the trace of the tensor - !trace = btensor(1)%sf(j,k,l) - !if (num_dims == 2) then - ! trace = trace + btensor(3)%sf(j,k,l) - !else - trace = btensor(1)%sf(j, k, l) + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) - !end if - - ! invariant calculation, saving it in the q_prim_vf field - !invariant1 = btensor(1)%sf(j, k, l) - !if (num_dims == 2) then - ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) - !elseif (num_dims == 3) then - ! invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) - !end if - - ! calculate the deviatoric of the tensor - btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace - !if (num_dims == 2) then - ! btensor(3)%sf(j,k,l) = btensor(3)%sf(j,k,l) - (1d0/3d0)*trace - !else - btensor(4)%sf(j, k, l) = btensor(4)%sf(j, k, l) - f13*trace - btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace - !end if - ! dividing by the jacobian for neo-Hookean model - ! setting the tensor to the stresses for riemann solver - - !$acc loop seq - do i = 1, b_size - 1 - q_prim_vf(strxb + i - 1)%sf(j, k, l) = & - G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + subroutine s_initialize_hyperelastic_module() + integer :: i !< generic iterator + + @:ALLOCATE(btensor%vf(1:b_size)) + do i = 1, b_size + @:ALLOCATE(btensor%vf(i)%sf(0:m, 0:n, 0:p)) end do + @:ACC_SETUP_VFs(btensor) - ! compute the invariant without the elastic modulus - if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then - q_prim_vf(xiend + 1)%sf(j, k, l) = & - 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) - else - ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 - end if - end subroutine s_neoHookean_cauchy_solver + @:ALLOCATE(Gs(1:num_fluids)) + do i = 1, num_fluids + Gs(i) = fluid_pp(i)%G + end do + !$acc update device(Gs) - subroutine s_finalize_hyperelastic_module() - ! Disassociating procedural pointer to the subroutine which was + ! Associating procedural pointer to the subroutine that will be ! utilized to calculate the solution of a given Riemann problem - s_compute_cauchy_solver => null() - end subroutine - -end module m_hyperelastic -!> -!! @file m_xi_tensor_calc.f90 -!! @brief Contains module m_xi_tensor_calc - -!> @brief This module consists of subroutines used in the calculation of matrix -!! operations for the reference map tensor - -module m_xi_tensor - - ! Dependencies ============================================================= - use m_derived_types !< Definitions of the derived types - - use m_global_parameters !< Definitions of the global parameters - ! ========================================================================== - - implicit none - - private; public :: s_compute_gradient_xi, & - s_compute_gradient_xi1d_acc, & - s_compute_gradient_xi2d_acc, & - s_compute_gradient_xi3d_acc, & - f_elastic_energy, & - s_calculate_btensor, & - s_calculate_btensor_acc, & - s_calculate_cauchy_from_btensor - -contains - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - !! neo-Hookean only at this time, will need to be changed later - function f_elastic_energy(btensor, j, k, l) -#ifdef MFC_SIMULATION - !$acc routine seq -#endif - type(scalar_field), dimension(b_size), intent(IN) :: btensor - integer, intent(IN) :: j, k, l - real(kind(0d0)) :: invariant1, f_elastic_energy - - f_elastic_energy = 0d0 - invariant1 = btensor(1)%sf(j, k, l) - !if (num_dims == 2) then - ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) - !elseif (num_dims == 3) then - invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + !if (hyper_model == 1) then + s_compute_cauchy_solver => s_neoHookean_cauchy_solver + !elseif (riemann_solver == 2) then + ! s_compute_cauchy_solver => s_Mooney_Rivlin_cauchy_solver !end if - ! compute the invariant without the elastic modulus - f_elastic_energy = 0.5d0*(invariant1 - 3.0d0)/btensor(b_size)%sf(j, k, l) - - end function f_elastic_energy - - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_compute_gradient_xi(q_prim_vf, xb, xe, yb, ye, & !--------- - zb, ze, j, k, l, tensora, tensorb) - - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora, tensorb - integer, intent(IN) :: xb, xe, yb, ye, zb, ze - integer, intent(IN) :: j, k, l - - real(kind(0d0)) :: determinant - integer :: i - ! STEP 1: computing the grad_xi tensor - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - if (j == xb) then - ! dxix/dx - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == xb + 1) then - ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + q_prim_vf(xibeg)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == xe - 1) then - ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - q_prim_vf(xibeg)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == xe) then - ! dxix/dx - tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxix/dx - tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - if (num_dims > 1) then - if (j == xb) then - ! dxiy / dx - tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == xb + 1) then - ! dxiy / dx - tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == xe - 1) then - ! dxiy / dx - tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == xe) then - ! dxiy / dx - tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxiy / dx - tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - if (k == yb) then - ! dxix / dy - tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - else if (k == yb + 1) then - ! dxix / dy - tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + q_prim_vf(xibeg)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye - 1) then - ! dxix / dy - tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - q_prim_vf(xibeg)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye) then - ! dxix / dy - tensora(3) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxix / dy - tensora(3) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - if (k == yb) then - ! dxiy / dy - tensora(4) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - else if (k == yb + 1) then - ! dxiy / dy - tensora(4) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye - 1) then - ! dxiy / dy - tensora(4) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye) then - ! dxiy / dy - tensora(4) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxiy / dy - tensora(4) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - + @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) + if (n > 0) then + @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) end if - - ! 3D - if (num_dims > 2) then - ! using results from upper if statement to map form 2x2 to 3x3 tensor - tensora(5) = tensora(4) - tensora(4) = tensora(3) - - if (l == zb) then - ! dxix / dz - tensora(7) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xibeg)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xibeg)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == zb + 1) then - ! dxix / dz - tensora(7) = (-3d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & - + q_prim_vf(xibeg)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze - 1) then - ! dxix / dz - tensora(7) = (3d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & - - q_prim_vf(xibeg)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze) then - ! dxix / dz - tensora(7) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xibeg)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xibeg)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxix / dz - tensora(7) = (q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - q_prim_vf(xibeg)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - - if (l == zb) then - ! dxiy / dz - tensora(8) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == zb + 1) then - ! dxiy / dz - tensora(8) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & - + q_prim_vf(xibeg + 1)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze - 1) then - ! dxiy / dz - tensora(8) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - q_prim_vf(xibeg + 1)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze) then - ! dxiy / dz - tensora(8) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxiy / dz - tensora(8) = (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - - if (j == xb) then - ! dxiz / dx - tensora(3) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == xb + 1) then - ! dxiz / dx - tensora(3) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + q_prim_vf(xiend)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == xe - 1) then - ! dxiz / dx - tensora(3) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - q_prim_vf(xiend)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == xe) then - ! dxiz / dx - tensora(3) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxiz / dx - tensora(3) = (q_prim_vf(xiend)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - q_prim_vf(xiend)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - if (k == yb) then - ! dxiz / dy - tensora(6) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - else if (k == yb + 1) then - ! dxiz / dy - tensora(6) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + q_prim_vf(xiend)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye - 1) then - ! dxiz / dy - tensora(6) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - q_prim_vf(xiend)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == ye) then - ! dxiz / dy - tensora(6) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxiz / dy - tensora(6) = (q_prim_vf(xiend)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - if (l == zb) then - ! dxiz / dz - tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xiend)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xiend)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xiend)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == zb + 1) then - ! dxiz / dz - tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xiend)%sf(j, k, l + 2) & - + q_prim_vf(xiend)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze - 1) then - ! dxiz / dz - tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xiend)%sf(j, k, l - 2) & - - q_prim_vf(xiend)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze) then - ! dxiz / dz - tensora(9) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xiend)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xiend)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xiend)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxiz / dz - tensora(9) = (q_prim_vf(xiend)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - q_prim_vf(xiend)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if + if (p > 0) then + @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) end if - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - if (num_dims == 1) then - tensorb(1) = 1 - elseif (num_dims == 2) then - tensorb(1) = tensora(4) - tensorb(2) = -tensora(3) - tensorb(3) = -tensora(2) - tensorb(4) = tensora(1) - elseif (num_dims == 3) then - tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) - tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) - tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) - tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) - tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) - tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) - tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) - tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) - tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) + ! Computing centered finite difference coefficients + call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & + fd_number, fd_order) + !$acc update device(fd_coeff_x) + if (n > 0) then + call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & + fd_number, fd_order) + !$acc update device(fd_coeff_y) end if - - ! STEP 2b: computing the determinant of the grad_xi tensor - if (num_dims == 1) then - determinant = tensora(1) - elseif (num_dims == 2) then - determinant = tensora(1)*tensora(4) - tensora(2)*tensora(3) - else - determinant = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & - + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - end if - ! error checking - !if (determinant == 0) then - ! print *, 'determinant :: ', determinant - ! print *, 'ERROR: Determinant was zero' - ! stop - !end if - if (determinant < 0d0 .or. determinant > 2d0) then - print *, 'i, j, k :: ', j, ' ', k, ' ', l, ',det ::', tensorb(tensor_size) - ! stop + if (p > 0) then + call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & + fd_number, fd_order) + !$acc update device(fd_coeff_z) end if - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/determinant - end do + end subroutine s_initialize_hyperelastic_module - ! STEP 3: computing F tranpose F - tensorb(1) = tensora(1)**2 - if (num_dims == 2) then - tensorb(1) = tensorb(1) + tensora(3)**2 - tensorb(2) = tensora(1)*tensora(2) + tensora(3)*tensora(4) - tensorb(3) = tensorb(2) - tensorb(4) = tensora(2)**2 + tensora(4)**2 - elseif (num_dims == 3) then - tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 - tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 - tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) - tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) - tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) - tensorb(4) = tensorb(2) - tensorb(7) = tensorb(3) - tensorb(8) = tensorb(6) - end if - ! STEP 4: store the determinant of F in the last entry of the tensor - tensorb(tensor_size) = determinant - - end subroutine s_compute_gradient_xi - - !> The following subroutine handles the calculation of the btensor. + !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. !! @param q_prim_vf Primitive variables !! @param btensor is the output @@ -725,1248 +135,118 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_calculate_btensor(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) - - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(INOUT) :: btensor - integer, intent(IN) :: xb, xe, yb, ye, zb, ze + subroutine s_hyperelastic_rmt_stress_update(q_prim_vf,q_cons_vf) + type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf + type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb - integer :: j, k, l - - do l = zb, ze - do k = yb, ye - do j = xb, xe - call s_compute_gradient_xi(q_prim_vf, xb, xe, yb, & - ye, zb, ze, j, k, l, tensora, tensorb) - ! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensorb(1) - !if (num_dims > 1) then ! 2D - btensor(2)%sf(j, k, l) = tensorb(2) - ! btensor(3)%sf(j,k,l) = tensorb(4) - !end if - !if (num_dims > 2) then ! 3D - btensor(3)%sf(j, k, l) = tensorb(3) - btensor(4)%sf(j, k, l) = tensorb(5) - btensor(5)%sf(j, k, l) = tensorb(6) - btensor(6)%sf(j, k, l) = tensorb(9) - !end if - ! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j, k, l) = tensorb(tensor_size) - end do - end do - end do - end subroutine s_calculate_btensor - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_compute_gradient_xi1d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- - izb, ize, j, k, l, tensora, tensorb) - !$acc routine seq - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb - integer, intent(IN) :: ixb, ixe, iyb, iye, izb, ize - integer, intent(IN) :: j, k, l - integer :: i - - ! STEP 1: computing the grad_xi tensor - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - if (j == ixb) then - ! dxix/dx - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == ixb + 1) then - ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + q_prim_vf(xibeg)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe - 1) then - ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - q_prim_vf(xibeg)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe) then - ! dxix/dx - tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxix/dx - tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = 1 - - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1) - - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse - - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - - ! STEP 3: computing F tranpose F - tensorb(1) = tensora(1)**2 - ! STEP 4: store the determinant of F in the last entry of the tensor - !tensorb(tensor_size) = determinant - - end subroutine s_compute_gradient_xi1d_acc - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_compute_gradient_xi2d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- - izb, ize, j, k, l, tensora, tensorb) - !$acc routine seq - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb - integer, intent(IN) :: ixb, ixe, iyb, iye, izb, ize - integer, intent(IN) :: j, k, l - integer :: i - ! STEP 1: computing the grad_xi tensor - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - if (j == ixb) then - ! dxix/dx - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == ixb + 1) then - ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + q_prim_vf(xibeg)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe - 1) then - ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - q_prim_vf(xibeg)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe) then - ! dxix/dx - tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxix/dx - tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - ! 2D - if (j == ixb) then - ! dxiy / dx - tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - else if (j == ixb + 1) then - ! dxiy / dx - tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe - 1) then - ! dxiy / dx - tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe) then - ! dxiy / dx - tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxiy / dx - tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - end if - - if (k == iyb) then - ! dxix / dy - tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - else if (k == iyb + 1) then - ! dxix / dy - tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + q_prim_vf(xibeg)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye - 1) then - ! dxix / dy - tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - q_prim_vf(xibeg)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye) then - ! dxix / dy - tensora(3) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxix / dy - tensora(3) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - if (k == iyb) then - ! dxiy / dy - tensora(4) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - else if (k == iyb + 1) then - ! dxiy / dy - tensora(4) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye - 1) then - ! dxiy / dy - tensora(4) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye) then - ! dxiy / dy - tensora(4) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxiy / dy - tensora(4) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = tensora(4) - tensorb(2) = -tensora(3) - tensorb(3) = -tensora(2) - tensorb(4) = tensora(1) - - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*tensora(4) - tensora(2)*tensora(3) - - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - ! STEP 3: computing F tranpose F - tensorb(1) = tensora(1)**2 - tensorb(1) = tensorb(1) + tensora(3)**2 - tensorb(2) = tensora(1)*tensora(2) + tensora(3)*tensora(4) - tensorb(3) = tensorb(2) - tensorb(4) = tensora(2)**2 + tensora(4)**2 - - ! STEP 4: store the determinant of F in the last entry of the tensor - - end subroutine s_compute_gradient_xi2d_acc - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, iye, & !--------- - izb, ize, j, k, l, tensora, tensorb) - !$acc routine seq - type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensora - real(kind(0d0)), dimension(tensor_size), intent(INOUT) :: tensorb - integer, intent(IN) :: ixb, ixe - integer, intent(IN) :: iyb, iye - integer, intent(IN) :: izb, ize - integer, intent(IN) :: j, k, l - - integer :: i + real(kind(0d0)), dimension(num_fluids) :: alpha_K, alpha_rho_K + real(kind(0d0)), dimension(2) :: Re_K + real(kind(0d0)) :: rho_K, gamma_K, pi_inf_K, qv_K + real(kind(0d0)) :: G_K, elastic_ene + integer :: j, k, l, i, r ! STEP 1: computing the grad_xi tensor ! grad_xi definition / organization ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - ! 1D - if (j == ixb) then - ! dxix/dx - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - ! dxiy / dx - tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - ! dxiz / dx - tensora(7) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - - else if (j == ixb + 1) then - ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + q_prim_vf(xibeg)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(7) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + q_prim_vf(xiend)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - - else if (j == ixe - 1) then - ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - q_prim_vf(xibeg)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(7) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - q_prim_vf(xiend)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else if (j == ixe) then - ! dxix/dx - tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(7) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - else - ! dxix/dx - tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(7) = (q_prim_vf(xiend)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - q_prim_vf(xiend)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - - end if - - ! 2D - if (k == iyb) then - ! dxix / dy - tensora(4) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - ! dxiy / dy - tensora(5) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - ! dxiz / dy - tensora(8) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - - else if (k == iyb + 1) then - ! dxix / dy - tensora(4) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + q_prim_vf(xibeg)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(8) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + q_prim_vf(xiend)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye - 1) then - ! dxix / dy - tensora(4) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - q_prim_vf(xibeg)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(8) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - q_prim_vf(xiend)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else if (k == iye) then - ! dxix / dy - tensora(4) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(8) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxix / dy - tensora(4) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(8) = (q_prim_vf(xiend)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - ! 3D - if (l == izb) then - ! dxix / dz - tensora(3) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xibeg)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xibeg)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiy / dz - tensora(6) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiz / dz - tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xiend)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xiend)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xiend)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == izb + 1) then - ! dxix / dz - tensora(3) = (-3d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & - + q_prim_vf(xibeg)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & - + q_prim_vf(xibeg + 1)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xiend)%sf(j, k, l + 2) & - + q_prim_vf(xiend)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize - 1) then - ! dxix / dz - tensora(3) = (3d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & - - q_prim_vf(xibeg)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - q_prim_vf(xibeg + 1)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xiend)%sf(j, k, l - 2) & - - q_prim_vf(xiend)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ize) then - ! dxix / dz - tensora(3) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xibeg)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xibeg)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xiend)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xiend)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xiend)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxix / dz - tensora(3) = (q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - q_prim_vf(xibeg)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(6) = (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (q_prim_vf(xiend)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - q_prim_vf(xiend)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) - tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) - tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) - tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) - tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) - tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) - tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) - tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) - tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) - - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & - + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse - ! STEP 4: store the determinant of F in the last entry of the tensor - - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - - ! STEP 3: computing F tranpose F - tensorb(1) = tensora(1)**2 - tensorb(1) = tensorb(1) + tensora(4)**2 + tensora(7)**2 - tensorb(5) = tensora(2) + tensora(5)**2 + tensora(8)**2 - tensorb(9) = tensora(3) + tensora(6)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(2) + tensora(4)*tensora(5) + tensora(7)*tensora(8) - tensorb(3) = tensora(1)*tensora(3) + tensora(4)*tensora(6) + tensora(7)*tensora(9) - tensorb(6) = tensora(2)*tensora(3) + tensora(5)*tensora(6) + tensora(8)*tensora(9) - tensorb(4) = tensorb(2) - tensorb(7) = tensorb(3) - tensorb(8) = tensorb(4) - - end subroutine s_compute_gradient_xi3d_acc - - - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_calculate_btensor_acc(q_prim_vf, btensor, xb, xe, yb, ye, zb, ze) - - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(inout) :: btensor - integer, intent(in) :: xb, xe, yb, ye, zb, ze - integer :: j, k, l - real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb - integer :: i - -! if (num_dims == 1) then - !!$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) - !!do l = izb, ize - ! do k = iyb, iye - ! do j = ixb, ixe -! call s_compute_gradient_xi1d_acc(q_prim_vf, ixb, ixe, iyb, & -! iye, izb, ize, j, k, l, tensora, tensorb) -! !! 1: 1D, 3: 2D, 6: 3D -! btensor(1)%sf(j, k, l) = tensorb(1) -! !! store the determinant at the last entry of the btensor sf -! btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) -! end do -! end do -! end do -! !$acc end parallel loop -! else if (num_dims == 2) then ! 2D -! !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) -! do l = izb, ize -! do k = iyb, iye -! do j = ixb, ixe -! call s_compute_gradient_xi2d_acc(q_prim_vf, ixb, ixe, iyb, & -! iye, izb, ize, j, k, l, tensora, tensorb) -! !! 1: 1D, 3: 2D, 6: 3D -! btensor(1)%sf(j, k, l) = tensorb(1) -! btensor(2)%sf(j,k,l) = tensorb(2) -! btensor(3)%sf(j,k,l) = tensorb(4) -! !! store the determinant at the last entry of the btensor sf -! btensor(b_size)%sf(j,k,l) = tensorb(tensor_size) -! end do -! end do -! end do -! !$acc end parallel loop -! else ! 3D - - !print *,'I got here AAAA' - !$acc parallel loop collapse(3) gang vector default(present) private(tensora,tensorb) - do l = zb, ze - do k = yb, ye - do j = xb, xe - ! STEP 1: computing the grad_xi tensor - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - - ! 1D - if (j == xb) then - ! dxix/dx - !print *, ' grid check xb :: ',q_prim_vf(xibeg)%sf(j, k, l) - tensora(1) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - ! dxiy / dx - tensora(2) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - ! dxiz / dx - tensora(3) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 36d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + 16d0*q_prim_vf(xiend)%sf(j + 3, k, l) & - - 3d0*q_prim_vf(xiend)%sf(j + 4, k, l)) & - /(12d0*(x_cb(j + 1) - x_cb(j))) - !print *, ' grid check xb :: ',tensora(1),tensora(2),tensora(7) - - else if (j == xb + 1) then - !print *, ' grid check xb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix/dx - tensora(1) = (-3d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg)%sf(j + 2, k, l) & - + q_prim_vf(xibeg)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (-3d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j + 2, k, l) & - + q_prim_vf(xibeg + 1)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(3) = (-3d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - 6d0*q_prim_vf(xiend)%sf(j + 2, k, l) & - + q_prim_vf(xiend)%sf(j + 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - !print *, ' grid check xb1 :: ',tensora(1),tensora(2),tensora(7) - - else if (j == xe - 1) then - !print *, ' grid check xe1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix/dx - tensora(1) = (3d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - q_prim_vf(xibeg)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (3d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - q_prim_vf(xibeg + 1)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(3) = (3d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 6d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - q_prim_vf(xiend)%sf(j - 3, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - !print *, ' grid check xe1 :: ',tensora(1),tensora(2),tensora(7) - - else if (j == xe) then - !print *, ' grid check xe :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix/dx - tensora(1) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(3) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 36d0*q_prim_vf(xiend)%sf(j - 2, k, l) & - - 16d0*q_prim_vf(xiend)%sf(j - 3, k, l) & - + 3d0*q_prim_vf(xiend)%sf(j - 4, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - !print *, ' grid check xe :: ',tensora(1),tensora(2),tensora(7) - - else - ! dxix/dx - tensora(1) = (q_prim_vf(xibeg)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg)%sf(j + 1, k, l) & - - q_prim_vf(xibeg)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiy / dx - tensora(2) = (q_prim_vf(xibeg + 1)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j + 1, k, l) & - - q_prim_vf(xibeg + 1)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - ! dxiz / dx - tensora(3) = (q_prim_vf(xiend)%sf(j - 2, k, l) & - - 8d0*q_prim_vf(xiend)%sf(j - 1, k, l) & - + 8d0*q_prim_vf(xiend)%sf(j + 1, k, l) & - - q_prim_vf(xiend)%sf(j + 2, k, l)) & - /(12d0*(x_cb(j) - x_cb(j - 1))) - - end if - - ! 2D - if (k == yb) then - !print *, ' grid check yb :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dy - tensora(4) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - ! dxiy / dy - tensora(5) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - ! dxiz / dy - tensora(6) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 36d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + 16d0*q_prim_vf(xiend)%sf(j, k + 3, l) & - - 3d0*q_prim_vf(xiend)%sf(j, k + 4, l)) & - /(12d0*(y_cb(k + 1) - y_cb(k))) - !print *, ' grid check yb :: ',tensora(4),tensora(5),tensora(8) - - else if (k == yb + 1) then - !print *, ' grid check yb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dy - tensora(4) = (-3d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg)%sf(j, k + 2, l) & - + q_prim_vf(xibeg)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j, k + 2, l) & - + q_prim_vf(xibeg + 1)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(6) = (-3d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - 6d0*q_prim_vf(xiend)%sf(j, k + 2, l) & - + q_prim_vf(xiend)%sf(j, k + 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - !print *, ' grid check yb1 :: ',tensora(4),tensora(5),tensora(8) - - else if (k == ye - 1) then - !print *, ' grid check ye1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dy - tensora(4) = (3d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - q_prim_vf(xibeg)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - q_prim_vf(xibeg + 1)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(6) = (3d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 6d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - q_prim_vf(xiend)%sf(j, k - 3, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - !print *, ' grid check yb1 :: ',tensora(4),tensora(5),tensora(8) - - else if (k == ye) then - !print *, ' grid check ye :: ',q_prim_vf(xibeg+1)%sf(j, k, l) - - ! dxix / dy - tensora(4) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(6) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 36d0*q_prim_vf(xiend)%sf(j, k - 2, l) & - - 16d0*q_prim_vf(xiend)%sf(j, k - 3, l) & - + 3d0*q_prim_vf(xiend)%sf(j, k - 4, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - else - ! dxix / dy - tensora(4) = (q_prim_vf(xibeg)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg)%sf(j, k + 1, l) & - - q_prim_vf(xibeg)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiy / dy - tensora(5) = (q_prim_vf(xibeg + 1)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k + 1, l) & - - q_prim_vf(xibeg + 1)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - ! dxiz / dy - tensora(6) = (q_prim_vf(xiend)%sf(j, k - 2, l) & - - 8d0*q_prim_vf(xiend)%sf(j, k - 1, l) & - + 8d0*q_prim_vf(xiend)%sf(j, k + 1, l) & - - q_prim_vf(xiend)%sf(j, k + 2, l)) & - /(12d0*(y_cb(k) - y_cb(k - 1))) - end if - - ! 3D - if (l == zb) then - !print *, ' grid check zb :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dz - tensora(7) = (-25d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xibeg)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xibeg)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiy / dz - tensora(8) = (-25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - ! dxiz / dz - tensora(9) = (-25d0*q_prim_vf(xiend)%sf(j, k, l) & - + 48d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - 36d0*q_prim_vf(xiend)%sf(j, k, l + 2) & - + 16d0*q_prim_vf(xiend)%sf(j, k, l + 3) & - - 3d0*q_prim_vf(xiend)%sf(j, k, l + 4)) & - /(12d0*(z_cb(l + 1) - z_cb(l))) - else if (l == zb + 1) then - !print *, ' grid check zb1 :: ',q_prim_vf(xibeg)%sf(j, k, l) - - ! dxix / dz - tensora(7) = (-3d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xibeg)%sf(j, k, l + 2) & - + q_prim_vf(xibeg)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(8) = (-3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - + 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 2) & - + q_prim_vf(xibeg + 1)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (-3d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - - 10d0*q_prim_vf(xiend)%sf(j, k, l) & - + 18d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - 6d0*q_prim_vf(xiend)%sf(j, k, l + 2) & - + q_prim_vf(xiend)%sf(j, k, l + 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze - 1) then - !print *, ' grid check ze1 :: ',q_prim_vf(xiend)%sf(j, k, l) - - ! dxix / dz - tensora(7) = (3d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & - - q_prim_vf(xibeg)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(8) = (3d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - q_prim_vf(xibeg + 1)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (3d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - + 10d0*q_prim_vf(xiend)%sf(j, k, l) & - - 18d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 6d0*q_prim_vf(xiend)%sf(j, k, l - 2) & - - q_prim_vf(xiend)%sf(j, k, l - 3)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else if (l == ze) then - !print *, ' grid check ze :: ',q_prim_vf(xiend)%sf(j, k, l) - - ! dxix / dz - tensora(7) = (25d0*q_prim_vf(xibeg)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xibeg)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xibeg)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(8) = (25d0*q_prim_vf(xibeg + 1)%sf(j, k, l) & - - 48d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (25d0*q_prim_vf(xiend)%sf(j, k, l) & - - 48d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 36d0*q_prim_vf(xiend)%sf(j, k, l - 2) & - - 16d0*q_prim_vf(xiend)%sf(j, k, l - 3) & - + 3d0*q_prim_vf(xiend)%sf(j, k, l - 4)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - else - ! dxix / dz - tensora(7) = (q_prim_vf(xibeg)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg)%sf(j, k, l + 1) & - - q_prim_vf(xibeg)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiy / dz - tensora(8) = (q_prim_vf(xibeg + 1)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xibeg + 1)%sf(j, k, l + 1) & - - q_prim_vf(xibeg + 1)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - ! dxiz / dz - tensora(9) = (q_prim_vf(xiend)%sf(j, k, l - 2) & - - 8d0*q_prim_vf(xiend)%sf(j, k, l - 1) & - + 8d0*q_prim_vf(xiend)%sf(j, k, l + 1) & - - q_prim_vf(xiend)%sf(j, k, l + 2)) & - /(12d0*(z_cb(l) - z_cb(l - 1))) - end if - - !print *, 'I got here AAAAA' - - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) - tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) - tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) - tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) - tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) - tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) - tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) - tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) - tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) - - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & - + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - - !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 3d0 ) then - ! print *, 'j, k, l :: ', j, k, l - ! do i = 1, 9 - ! print *,'i :: ',i,', ten :: ',tensorb(i) - ! end do - ! print *, 'det : ',tensorb(tensor_size) - ! tensorb(tensor_size) = 1d0 - !end if - - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse - ! STEP 4: store the determinant of F in the last entry of the tensor - - !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 2d0 ) then - tensorb(tensor_size) = 1d0 - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = 0d0 - end do - tensorb(1) = 1d0 - tensorb(5) = 1d0 - tensorb(9) = 1d0 - !end if + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,tensora,tensorb,elastic_ene) + do l = 0, p + do k = 0, n + do j = 0, m + !$acc loop seq + do i = 1, tensor_size + tensora(i) = 0d0 + end do + !$acc loop seq + do r = -fd_number, fd_number + tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) + tensora(2) = tensora(2) + q_prim_vf(xibeg+1)%sf(j + r, k, l)*fd_coeff_x(r, j) + tensora(3) = tensora(3) + q_prim_vf(xiend)%sf(j + r, k, l)*fd_coeff_x(r, j) + tensora(4) = tensora(4) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_x(r, k) + tensora(5) = tensora(5) + q_prim_vf(xibeg+1)%sf(j, k + r, l)*fd_coeff_x(r, k) + tensora(6) = tensora(6) + q_prim_vf(xiend)%sf(j, k + r, l)*fd_coeff_x(r, k) + tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_x(r, l) + tensora(8) = tensora(8) + q_prim_vf(xibeg+1)%sf(j, k, l + r)*fd_coeff_x(r, l) + tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_x(r, l) + end do + + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) + tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) + tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) + tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) + tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) + tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) + tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) + tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) + tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) + + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + + !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 2d0 ) then + !tensorb(tensor_size) = 1d0 + !!!$acc loop seq + !do i = 1, tensor_size - 1 + ! tensora(i) = 0d0 + !end do + !tensorb(1) = 1d0 + !tensorb(5) = 1d0 + !tensorb(9) = 1d0 + !end if + + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - !print *, 'I got here A6' - ! STEP 3: computing F tranpose F - !tensorb(1) = tensora(1)**2 - tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 - tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 - tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) - tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) - tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) - tensorb(4) = tensorb(2) - tensorb(7) = tensorb(3) - tensorb(8) = tensorb(6) - !print *, 'I got here A7' - !call s_compute_gradient_xi3d_acc(q_prim_vf, ixb, ixe, iyb, & - !iye, izb, ize, j, k, l, tensora, tensorb) - !! 1: 1D, 3: 2D, 6: 3D - btensor(1)%sf(j, k, l) = tensorb(1) - btensor(2)%sf(j, k, l) = tensorb(2) - btensor(3)%sf(j, k, l) = tensorb(3) - btensor(4)%sf(j, k, l) = tensorb(5) - btensor(5)%sf(j, k, l) = tensorb(6) - btensor(6)%sf(j, k, l) = tensorb(9) - !print *, 'I got here A8' - !! store the determinant at the last entry of the btensor sf - btensor(b_size)%sf(j, k, l) = tensorb(tensor_size) + ! STEP 3: computing F tranpose F + tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 + tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 + tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) + tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) + tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) + + ! STEP 4: update the btensor + btensor%vf(1)%sf(j, k, l) = tensorb(1) + btensor%vf(2)%sf(j, k, l) = tensorb(2) + btensor%vf(3)%sf(j, k, l) = tensorb(3) + btensor%vf(4)%sf(j, k, l) = tensorb(5) + btensor%vf(5)%sf(j, k, l) = tensorb(6) + btensor%vf(6)%sf(j, k, l) = tensorb(9) + !!! store the determinant at the last entry of the btensor sf + btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) + + !$acc loop seq + do i = 1, num_fluids + alpha_rho_K(i) = q_cons_vf(i)%sf(j, k, l) + alpha_K(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) end do + ! If in simulation, use acc mixture subroutines + call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & + alpha_rho_K, Re_K, j, k, l, G_K, Gs) + rho_K = max(rho_K, sgm_eps) + if (G_K .lt. verysmall) G_K = 0d0 + + call s_compute_cauchy_solver(btensor%vf, q_prim_vf, elastic_ene, G_K, j, k, l) + q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) !- & + !G_K*elastic_ene/gamma_K + !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) end do + end do end do !$acc end parallel loop - !print *, 'I got here A9' -! end if - end subroutine s_calculate_btensor_acc + end subroutine s_hyperelastic_rmt_stress_update - !> The following subroutine handles the calculation of the btensor. + !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. !! @param q_prim_vf Primitive variables !! @param btensor is the output @@ -1974,16 +254,17 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_calculate_cauchy_from_btensor(btensor, q_prim_vf, j, k, l) -#ifdef MFC_SIMULATION + subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, elastic_ene, G, j, k, l) !$acc routine seq -#endif - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(IN) :: btensor - integer, intent(IN) :: j, k, l + type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(inout) :: btensor + real(kind(0d0)), intent(out) :: elastic_ene + real(kind(0d0)), intent(in) :: G + integer, intent(in) :: j, k, l real(kind(0d0)), dimension(b_size - 1) :: tensor - real(kind(0d0)) :: trace + real(kind(0d0)) :: trace, invariant1 + real(kind(0d0)) :: f13 = 1d0/3d0 integer :: i !< Generic loop iterators ! tensor is the symmetric tensor & calculate the trace of the tensor @@ -2003,28 +284,55 @@ contains !end if ! calculate the deviatoric of the tensor - btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - (1d0/3d0)*trace + btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace !if (num_dims == 2) then ! btensor(3)%sf(j,k,l) = btensor(3)%sf(j,k,l) - (1d0/3d0)*trace !else - btensor(4)%sf(j, k, l) = btensor(4)%sf(j, k, l) - (1d0/3d0)*trace - btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - (1d0/3d0)*trace + btensor(4)%sf(j, k, l) = btensor(4)%sf(j, k, l) - f13*trace + btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace !end if ! dividing by the jacobian for neo-Hookean model ! setting the tensor to the stresses for riemann solver !$acc loop seq do i = 1, b_size - 1 - q_prim_vf(strxb + i)%sf(j, k, l) = btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + q_prim_vf(strxb + i - 1)%sf(j, k, l) = & + G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) end do ! compute the invariant without the elastic modulus - ! if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then - q_prim_vf(xiend + 1)%sf(j, k, l) = 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) - ! else + if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then + q_prim_vf(xiend + 1)%sf(j, k, l) = & + 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) + else ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 - ! end if + end if - end subroutine s_calculate_cauchy_from_btensor + ! compute the elastic energy without the elastic modulus + elastic_ene = 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) -end module m_xi_tensor + end subroutine s_neoHookean_cauchy_solver + + subroutine s_finalize_hyperelastic_module() + + integer :: i !< iterator + + ! Disassociating procedural pointer to the subroutine which was + ! utilized to calculate the solution of a given Riemann problem + s_compute_cauchy_solver => null() + + ! Deallocating memory + do i = 1, b_size + @:DEALLOCATE_GLOBAL(btensor%vf(i)%sf) + end do + @:DEALLOCATE_GLOBAL(fd_coeff_x) + if (n > 0) then + @:DEALLOCATE_GLOBAL(fd_coeff_y) + if (p > 0) then + @:DEALLOCATE_GLOBAL(fd_coeff_z) + end if + end if + + end subroutine s_finalize_hyperelastic_module + +end module m_hyperelastic diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index e4342e508c..0c5e9a3b49 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -13,7 +13,7 @@ module m_hypoelastic use m_global_parameters !< Definitions of the global parameters - use m_mpi_proxy !< Message passing interface (MPI) module proxy +! use m_mpi_proxy !< Message passing interface (MPI) module proxy use m_helper @@ -36,6 +36,10 @@ module m_hypoelastic @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), rho_K_field, G_K_field) !$acc declare link(rho_K_field, G_K_field) + + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), allocatable, dimension(:, :), fd_coeff_x, fd_coeff_y, fd_coeff_z) + !$acc declare link(fd_coeff_x,fd_coeff_y,fd_coeff_z) + #else real(kind(0d0)), allocatable, dimension(:) :: Gs !$acc declare create(Gs) @@ -354,10 +358,13 @@ contains @:DEALLOCATE_GLOBAL(Gs) @:DEALLOCATE_GLOBAL(rho_K_field, G_K_field) @:DEALLOCATE_GLOBAL(du_dx) + @:DEALLOCATE_GLOBAL(fd_coeff_x) if (n > 0) then @:DEALLOCATE_GLOBAL(du_dy,dv_dx,dv_dy) + @:DEALLOCATE_GLOBAL(fd_coeff_y) if (p > 0) then @:DEALLOCATE_GLOBAL(du_dz, dv_dz, dw_dx, dw_dy, dw_dz) + @:DEALLOCATE_GLOBAL(fd_coeff_z) end if end if diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index f17e59f640..ce1e4ee613 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -48,6 +48,8 @@ module m_start_up !! from the conservative and primitive variables use m_hypoelastic + use m_hyperelastic + use m_phase_change !< Phase-change module use m_viscous @@ -1316,6 +1318,7 @@ contains call s_initialize_derived_variables() if (hypoelasticity) call s_initialize_hypoelastic_module() + if (hyperelasticity) call s_initialize_hyperelastic_module() end subroutine s_initialize_modules From c921cdd66147cc6cc89d84e66a545ba79f7555f0 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 15 Jul 2024 15:53:49 -0500 Subject: [PATCH 249/380] debugged hyper for grid stretching, improved ACC looping for hypo --- src/simulation/m_hyperelastic.fpp | 18 ++++++++----- src/simulation/m_hypoelastic.fpp | 44 +++++++++++++++++-------------- 2 files changed, 35 insertions(+), 27 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 210107b553..88febd1ceb 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -136,6 +136,7 @@ contains !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space subroutine s_hyperelastic_rmt_stress_update(q_prim_vf,q_cons_vf) + type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb @@ -162,15 +163,18 @@ contains end do !$acc loop seq do r = -fd_number, fd_number + ! derivatives in the x-direction tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) tensora(2) = tensora(2) + q_prim_vf(xibeg+1)%sf(j + r, k, l)*fd_coeff_x(r, j) tensora(3) = tensora(3) + q_prim_vf(xiend)%sf(j + r, k, l)*fd_coeff_x(r, j) - tensora(4) = tensora(4) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_x(r, k) - tensora(5) = tensora(5) + q_prim_vf(xibeg+1)%sf(j, k + r, l)*fd_coeff_x(r, k) - tensora(6) = tensora(6) + q_prim_vf(xiend)%sf(j, k + r, l)*fd_coeff_x(r, k) - tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_x(r, l) - tensora(8) = tensora(8) + q_prim_vf(xibeg+1)%sf(j, k, l + r)*fd_coeff_x(r, l) - tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_x(r, l) + ! derivatives in the y-direction + tensora(4) = tensora(4) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) + tensora(5) = tensora(5) + q_prim_vf(xibeg+1)%sf(j, k + r, l)*fd_coeff_y(r, k) + tensora(6) = tensora(6) + q_prim_vf(xiend)%sf(j, k + r, l)*fd_coeff_y(r, k) + ! derivatives in the z-direction + tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_z(r, l) + tensora(8) = tensora(8) + q_prim_vf(xibeg+1)%sf(j, k, l + r)*fd_coeff_z(r, l) + tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_z(r, l) end do ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse @@ -234,7 +238,7 @@ contains call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & alpha_rho_K, Re_K, j, k, l, G_K, Gs) rho_K = max(rho_K, sgm_eps) - if (G_K .lt. verysmall) G_K = 0d0 + if (G_K .le. verysmall) G_K = 0d0 call s_compute_cauchy_solver(btensor%vf, q_prim_vf, elastic_ene, G_K, j, k, l) q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) !- & diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index 0c5e9a3b49..7f3d54c381 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -137,18 +137,20 @@ contains end do !$acc end parallel loop - do r = -fd_number, fd_number !$acc parallel loop collapse(3) gang vector default(present) do q = 0, p do l = 0, n do k = 0, m + !$acc loop seq + do r = -fd_number, fd_number du_dx(k, l, q) = du_dx(k, l, q) & + q_prim_vf(momxb)%sf(k + r, l, q)*fd_coeff_x(r, k) + end do + end do end do end do !$acc end parallel loop - end do if (ndirs > 1) then !$acc parallel loop collapse(3) gang vector default(present) @@ -161,22 +163,23 @@ contains end do !$acc end parallel loop - do r = -fd_number, fd_number - !$acc parallel loop collapse(3) gang vector default(present) - do q = 0, p - do l = 0, n - do k = 0, m + !$acc parallel loop collapse(3) gang vector default(present) + do q = 0, p + do l = 0, n + do k = 0, m + !$acc loop seq + do r = -fd_number, fd_number du_dy(k, l, q) = du_dy(k, l, q) & + q_prim_vf(momxb)%sf(k, l + r, q)*fd_coeff_y(r, l) dv_dx(k, l, q) = dv_dx(k, l, q) & + q_prim_vf(momxb + 1)%sf(k + r, l, q)*fd_coeff_x(r, k) dv_dy(k, l, q) = dv_dy(k, l, q) & + q_prim_vf(momxb + 1)%sf(k, l + r, q)*fd_coeff_y(r, l) - end do - end do - end do - !$acc end parallel loop + end do + end do + end do end do + !$acc end parallel loop ! 3D if (ndirs == 3) then @@ -192,11 +195,12 @@ contains end do !$acc end parallel loop - do r = -fd_number, fd_number - !$acc parallel loop collapse(3) gang vector default(present) - do q = 0, p - do l = 0, n - do k = 0, m + !$acc parallel loop collapse(3) gang vector default(present) + do q = 0, p + do l = 0, n + do k = 0, m + !$acc loop seq + do r = -fd_number, fd_number du_dz(k, l, q) = du_dz(k, l, q) & + q_prim_vf(momxb)%sf(k, l, q + r)*fd_coeff_z(r, q) dv_dz(k, l, q) = dv_dz(k, l, q) & @@ -207,11 +211,11 @@ contains + q_prim_vf(momxe)%sf(k, l + r, q)*fd_coeff_y(r, l) dw_dz(k, l, q) = dw_dz(k, l, q) & + q_prim_vf(momxe)%sf(k, l, q + r)*fd_coeff_z(r, q) - end do - end do - end do - !$acc end parallel loop + end do + end do + end do end do + !$acc end parallel loop end if end if From 481702e25a4a4c5a551019b0558c43fb136ba259 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 15 Jul 2024 16:54:34 -0500 Subject: [PATCH 250/380] hypo passes test suite on Delta GPU, phase change tolerance could be reduced for speed --- src/simulation/m_hyperelastic.fpp | 4 ++-- src/simulation/m_rhs.fpp | 4 ++++ 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 88febd1ceb..7db25c891a 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -135,7 +135,7 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_hyperelastic_rmt_stress_update(q_prim_vf,q_cons_vf) + subroutine s_hyperelastic_rmt_stress_update(q_cons_vf,q_prim_vf) type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf @@ -226,7 +226,7 @@ contains btensor%vf(4)%sf(j, k, l) = tensorb(5) btensor%vf(5)%sf(j, k, l) = tensorb(6) btensor%vf(6)%sf(j, k, l) = tensorb(9) - !!! store the determinant at the last entry of the btensor sf + ! store the determinant at the last entry of the btensor sf btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) !$acc loop seq diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 65c9510ee3..86bb1985a2 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -791,6 +791,10 @@ contains call nvtxEndRange !print *, "I got here c" + call nvtxStartRange("RHS-ELASTIC") + call s_hyperelastic_rmt_stress_update(q_cons_qp%vf,q_prim_qp%vf) + call nvtxEndRange + if (t_step == t_step_stop) return ! ================================================================== From 9933f80ea6a9352539a214642056ef5e3d773ee8 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 15 Jul 2024 17:17:36 -0500 Subject: [PATCH 251/380] fixed hyperelastic stress update call, one more hyper bug remains --- src/simulation/m_rhs.fpp | 2 +- src/simulation/m_riemann_solvers.fpp | 1 + src/simulation/m_time_steppers.fpp | 6 ++++++ 3 files changed, 8 insertions(+), 1 deletion(-) diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 86bb1985a2..36bb4d83a7 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -792,7 +792,7 @@ contains !print *, "I got here c" call nvtxStartRange("RHS-ELASTIC") - call s_hyperelastic_rmt_stress_update(q_cons_qp%vf,q_prim_qp%vf) + if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_qp%vf,q_prim_qp%vf) call nvtxEndRange if (t_step == t_step_stop) return diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index d277cc6e1f..c6156b7df0 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -1104,6 +1104,7 @@ contains E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) !$acc loop seq do i = 1, b_size - 1 + !TODO MAURO tau_e_L(i) = 0d0; tau_e_R(i) = 0d0; !tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) !tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 920fb6acd7..33a171f218 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -25,6 +25,8 @@ module m_time_steppers use m_ibm + use m_hyperelastic + use m_mpi_proxy !< Message passing interface (MPI) module proxy use m_boundary_conditions @@ -845,6 +847,10 @@ contains call s_pressure_relaxation_procedure(q_cons_ts(1)%vf) end if + call nvtxStartRange("RHS-ELASTIC") + if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_ts(1)%vf,q_prim_vf) + call nvtxEndRange + if (adv_n) call s_comp_alpha_from_n(q_cons_ts(1)%vf) if (ib) then From 8476ff5c1682583851a10e8e32592ef42e88a156 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 15 Jul 2024 19:57:25 -0500 Subject: [PATCH 252/380] additional modifications for RMT --- src/simulation/m_hyperelastic.fpp | 137 +++++++++++++-------------- src/simulation/m_riemann_solvers.fpp | 32 ++++--- submit_test.sh | 5 +- 3 files changed, 84 insertions(+), 90 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 7db25c891a..51a4c98884 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -153,71 +153,77 @@ contains ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,tensora,tensorb,elastic_ene) + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,Re_K,tensora,tensorb,elastic_ene) do l = 0, p do k = 0, n do j = 0, m - !$acc loop seq - do i = 1, tensor_size - tensora(i) = 0d0 + + !$acc loop seq + do i = 1, num_fluids + alpha_rho_K(i) = q_cons_vf(i)%sf(j, k, l) + alpha_K(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) end do - !$acc loop seq - do r = -fd_number, fd_number - ! derivatives in the x-direction - tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) - tensora(2) = tensora(2) + q_prim_vf(xibeg+1)%sf(j + r, k, l)*fd_coeff_x(r, j) - tensora(3) = tensora(3) + q_prim_vf(xiend)%sf(j + r, k, l)*fd_coeff_x(r, j) - ! derivatives in the y-direction - tensora(4) = tensora(4) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) - tensora(5) = tensora(5) + q_prim_vf(xibeg+1)%sf(j, k + r, l)*fd_coeff_y(r, k) - tensora(6) = tensora(6) + q_prim_vf(xiend)%sf(j, k + r, l)*fd_coeff_y(r, k) - ! derivatives in the z-direction - tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_z(r, l) - tensora(8) = tensora(8) + q_prim_vf(xibeg+1)%sf(j, k, l + r)*fd_coeff_z(r, l) - tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_z(r, l) - end do - - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) - tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) - tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) - tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) - tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) - tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) - tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) - tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) - tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) - - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + ! If in simulation, use acc mixture subroutines + call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & + alpha_rho_K, Re_K, j, k, l, G_K, Gs) + rho_K = max(rho_K, sgm_eps) + if (G_K .le. verysmall) G_K = 0d0 + + if (G_K .gt. 1d0) then + !$acc loop seq + do i = 1, tensor_size + tensora(i) = 0d0 + end do + !$acc loop seq + do r = -fd_number, fd_number + ! derivatives in the x-direction + tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) + tensora(2) = tensora(2) + q_prim_vf(xibeg+1)%sf(j + r, k, l)*fd_coeff_x(r, j) + tensora(3) = tensora(3) + q_prim_vf(xiend)%sf(j + r, k, l)*fd_coeff_x(r, j) + ! derivatives in the y-direction + tensora(4) = tensora(4) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) + tensora(5) = tensora(5) + q_prim_vf(xibeg+1)%sf(j, k + r, l)*fd_coeff_y(r, k) + tensora(6) = tensora(6) + q_prim_vf(xiend)%sf(j, k + r, l)*fd_coeff_y(r, k) + ! derivatives in the z-direction + tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_z(r, l) + tensora(8) = tensora(8) + q_prim_vf(xibeg+1)%sf(j, k, l + r)*fd_coeff_z(r, l) + tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_z(r, l) + end do + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) + tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) + tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) + tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) + tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) + tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) + tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) + tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) + tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) + + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - !if (tensorb(tensor_size) < 0d0 .or. tensorb(tensor_size) > 2d0 ) then - !tensorb(tensor_size) = 1d0 - !!!$acc loop seq - !do i = 1, tensor_size - 1 - ! tensora(i) = 0d0 - !end do - !tensorb(1) = 1d0 - !tensorb(5) = 1d0 - !tensorb(9) = 1d0 - !end if - - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse - !$acc loop seq - do i = 1, tensor_size - 1 + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes the inverse + !$acc loop seq + do i = 1, tensor_size - 1 tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - - ! STEP 3: computing F tranpose F - tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 - tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 - tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) - tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) - tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) + end do + + ! STEP 3: computing F tranpose F + tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 + tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 + tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) + tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) + tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) + else + tensorb(1) = 1d0; tensorb(5) = 1d0; tensorb(9) = 1d0; + tensorb(2) = 0d0; tensorb(3) = 0d0; tensorb(6) = 0d0; + tensorb(tensor_size) = 1d0; + end if ! STEP 4: update the btensor btensor%vf(1)%sf(j, k, l) = tensorb(1) @@ -228,21 +234,10 @@ contains btensor%vf(6)%sf(j, k, l) = tensorb(9) ! store the determinant at the last entry of the btensor sf btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) - - !$acc loop seq - do i = 1, num_fluids - alpha_rho_K(i) = q_cons_vf(i)%sf(j, k, l) - alpha_K(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) - end do - ! If in simulation, use acc mixture subroutines - call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & - alpha_rho_K, Re_K, j, k, l, G_K, Gs) - rho_K = max(rho_K, sgm_eps) - if (G_K .le. verysmall) G_K = 0d0 - + call s_compute_cauchy_solver(btensor%vf, q_prim_vf, elastic_ene, G_K, j, k, l) - q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) !- & - !G_K*elastic_ene/gamma_K + !q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & + ! G_K*elastic_ene/gamma_K !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) end do end do diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index c6156b7df0..ff3688de00 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -1060,7 +1060,7 @@ contains E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R - ! ADJUSTMENTS FOR HYPOELASTIC ENERGY + ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY if (hypoelasticity) then !$acc loop seq do i = 1, strxe - strxb + 1 @@ -1088,7 +1088,7 @@ contains end do end if - ! ADJUSTMENTS FOR HYPERELASTIC ENERGY + ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY if (hyperelasticity) then G_L = 0d0; G_R = 0d0; !$acc loop seq @@ -1104,10 +1104,9 @@ contains E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) !$acc loop seq do i = 1, b_size - 1 - !TODO MAURO - tau_e_L(i) = 0d0; tau_e_R(i) = 0d0; - !tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - !tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + !tau_e_L(i) = 0d0; tau_e_R(i) = 0d0; + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do end if @@ -1219,8 +1218,8 @@ contains + xi_P*(vel_R(idx1)*(E_R + pres_R) + & s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) - ! ELASTICITY. Elastic shear stress terms for the momentum and energy flux - if (hypoelasticity) then + ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux + if (elasticity) then flux_ene_e = 0d0; !$acc loop seq do i = 1, num_dims @@ -1236,13 +1235,6 @@ contains s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) end do flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e - ! HYPOELASTIC STRESS EVOLUTION FLUX. - !$acc loop seq - do i = 1, strxe - strxb + 1 - flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & - xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & - xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) - end do end if ! VOLUME FRACTION FLUX. @@ -1282,6 +1274,16 @@ contains flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) + ! HYPOELASTIC STRESS EVOLUTION FLUX. + if (hypoelasticity) then + !$acc loop seq + do i = 1, strxe - strxb + 1 + flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & + xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & + xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) + end do + end if + ! REFERENCE MAP FLUX. if (hyperelasticity) then !$acc loop seq diff --git a/submit_test.sh b/submit_test.sh index c544960d23..49c55718b2 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -21,15 +21,12 @@ #./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar #./mfc.sh run /users/mrodrig97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar -./mfc.sh run /u/rodrigu1/hMFC/tests/9EB947DB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run /u/rodrigu1/hMFC/tests/9EB947DB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta - From a2fd00f666889191ff5578eaf349a585d81ed7a5 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 15 Jul 2024 20:52:39 -0500 Subject: [PATCH 253/380] code compiles, passes test suite, hyperelastic RMT runs --- src/simulation/m_hyperelastic.fpp | 24 +++++++++--------------- submit_test.sh | 6 +++++- 2 files changed, 14 insertions(+), 16 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 51a4c98884..54f3d808e8 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -33,12 +33,11 @@ module m_hyperelastic !> @name Abstract subroutine for the infinite relaxation solver !> @{ - subroutine s_abstract_hyperelastic_solver(btensor, q_prim_vf, elastic_ene, G, j, k, l) + subroutine s_abstract_hyperelastic_solver(btensor, q_prim_vf, G, j, k, l) import :: scalar_field, sys_size, b_size type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor - real(kind(0d0)), intent(out) :: elastic_ene real(kind(0d0)), intent(in) :: G integer, intent(in) :: j, k, l @@ -144,7 +143,7 @@ contains real(kind(0d0)), dimension(num_fluids) :: alpha_K, alpha_rho_K real(kind(0d0)), dimension(2) :: Re_K real(kind(0d0)) :: rho_K, gamma_K, pi_inf_K, qv_K - real(kind(0d0)) :: G_K, elastic_ene + real(kind(0d0)) :: G_K integer :: j, k, l, i, r ! STEP 1: computing the grad_xi tensor @@ -153,7 +152,7 @@ contains ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,Re_K,tensora,tensorb,elastic_ene) + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,Re_K,tensora,tensorb) do l = 0, p do k = 0, n do j = 0, m @@ -167,9 +166,9 @@ contains call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & alpha_rho_K, Re_K, j, k, l, G_K, Gs) rho_K = max(rho_K, sgm_eps) - if (G_K .le. verysmall) G_K = 0d0 + if ( G_K .le. verysmall ) G_K = 0d0 - if (G_K .gt. 1d0) then + if ( G_K .gt. verysmall ) then !$acc loop seq do i = 1, tensor_size tensora(i) = 0d0 @@ -235,10 +234,9 @@ contains ! store the determinant at the last entry of the btensor sf btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) - call s_compute_cauchy_solver(btensor%vf, q_prim_vf, elastic_ene, G_K, j, k, l) - !q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & - ! G_K*elastic_ene/gamma_K - !print *, 'elastic energy :: ',G_K*f_elastic_energy(qK_btensor_vf, j, k, l) + call s_compute_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) + q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & + G_K*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma_K end do end do end do @@ -253,11 +251,10 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, elastic_ene, G, j, k, l) + subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) !$acc routine seq type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor - real(kind(0d0)), intent(out) :: elastic_ene real(kind(0d0)), intent(in) :: G integer, intent(in) :: j, k, l @@ -303,12 +300,9 @@ contains if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then q_prim_vf(xiend + 1)%sf(j, k, l) = & 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) - else - ! q_prim_vf(xiend+1)%sf(j,k,l) = 1d-12 end if ! compute the elastic energy without the elastic modulus - elastic_ene = 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) end subroutine s_neoHookean_cauchy_solver diff --git a/submit_test.sh b/submit_test.sh index 49c55718b2..c71bbed26c 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -21,9 +21,13 @@ #./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta +./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta + #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar #./mfc.sh run /users/mrodrig97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar From 124bd7339861d70b710c15696bf7e05447f2199d Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 16 Jul 2024 02:24:33 -0400 Subject: [PATCH 254/380] oscar commit --- submit_test.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/submit_test.sh b/submit_test.sh index c544960d23..ad94805dbc 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -28,8 +28,8 @@ #./mfc.sh run /users/mrodrig97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar -./mfc.sh run /u/rodrigu1/hMFC/tests/9EB947DB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run /u/rodrigu1/hMFC/tests/9EB947DB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +./mfc.sh run /users/mrodri97/hMFC/tests/9EB947DB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +./mfc.sh run /users/mrodri97/hMFC/tests/9EB947DB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar From e53b72893aaad7f5ee6d1af715ae362fcf1d185f Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 16 Jul 2024 17:16:42 -0400 Subject: [PATCH 255/380] fixed incorrect flux calculation of the xi_field in the Riemann solver for RMT, had to be conservative. Checking if jacobian flag is necessary now --- src/simulation/m_hyperelastic.fpp | 99 +++++++++++++--------------- src/simulation/m_rhs.fpp | 2 +- src/simulation/m_riemann_solvers.fpp | 26 ++++++-- src/simulation/m_time_steppers.fpp | 2 +- submit_test.sh | 14 ++-- 5 files changed, 73 insertions(+), 70 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 54f3d808e8..c4833b7185 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -136,7 +136,7 @@ contains !! btensor is symmetric, save the data space subroutine s_hyperelastic_rmt_stress_update(q_cons_vf,q_prim_vf) - type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf + type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb @@ -144,7 +144,7 @@ contains real(kind(0d0)), dimension(2) :: Re_K real(kind(0d0)) :: rho_K, gamma_K, pi_inf_K, qv_K real(kind(0d0)) :: G_K - + logical :: flag integer :: j, k, l, i, r ! STEP 1: computing the grad_xi tensor ! grad_xi definition / organization @@ -152,11 +152,11 @@ contains ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,Re_K,tensora,tensorb) + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,Re_K, tensora, tensorb, flag) do l = 0, p do k = 0, n do j = 0, m - + flag = .true. !$acc loop seq do i = 1, num_fluids alpha_rho_K(i) = q_cons_vf(i)%sf(j, k, l) @@ -168,7 +168,7 @@ contains rho_K = max(rho_K, sgm_eps) if ( G_K .le. verysmall ) G_K = 0d0 - if ( G_K .gt. verysmall ) then + if ( G_K .gt. 1d0 ) then !$acc loop seq do i = 1, tensor_size tensora(i) = 0d0 @@ -205,12 +205,15 @@ contains + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes the inverse + ! tensorb is the adjoint, tensora becomes F !$acc loop seq do i = 1, tensor_size - 1 tensora(i) = tensorb(i)/tensorb(tensor_size) end do - + + ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) + tensorb(tensor_size) = 1d0/tensorb(tensor_size) + ! STEP 3: computing F tranpose F tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 @@ -218,25 +221,39 @@ contains tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) + + !if (tensorb(tensor_size) < 0d0) then + ! print *, 'idx :: ',j,' ',k,' ',l,' J :: ',tensorb(tensor_size),' ',G_K + !end if else - tensorb(1) = 1d0; tensorb(5) = 1d0; tensorb(9) = 1d0; - tensorb(2) = 0d0; tensorb(3) = 0d0; tensorb(6) = 0d0; - tensorb(tensor_size) = 1d0; + flag = .false. end if - ! STEP 4: update the btensor - btensor%vf(1)%sf(j, k, l) = tensorb(1) - btensor%vf(2)%sf(j, k, l) = tensorb(2) - btensor%vf(3)%sf(j, k, l) = tensorb(3) - btensor%vf(4)%sf(j, k, l) = tensorb(5) - btensor%vf(5)%sf(j, k, l) = tensorb(6) - btensor%vf(6)%sf(j, k, l) = tensorb(9) - ! store the determinant at the last entry of the btensor sf - btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) + !if (tensorb(tensor_size) < 0.3) flag = .false. + + if (flag) then + ! STEP 4: update the btensor + btensor%vf(1)%sf(j, k, l) = tensorb(1) + btensor%vf(2)%sf(j, k, l) = tensorb(2) + btensor%vf(3)%sf(j, k, l) = tensorb(3) + btensor%vf(4)%sf(j, k, l) = tensorb(5) + btensor%vf(5)%sf(j, k, l) = tensorb(6) + btensor%vf(6)%sf(j, k, l) = tensorb(9) + ! store the determinant at the last entry of the btensor + btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) - call s_compute_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) - q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & - G_K*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma_K + ! STEP 5a: updating the Cauchy stress primitive scalar field + call s_compute_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) + ! STEP 5b: updating the pressure field + q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & + G_K*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma_K + ! STEP 5c: updating the Cauchy stress conservative scalar field + !$acc loop seq + do i = 1, b_size - 1 + q_cons_vf(strxb + i - 1)%sf(j, k, l) = & + rho_K*q_prim_vf(strxb + i - 1)%sf(j, k, l) + end do + end if end do end do end do @@ -258,51 +275,29 @@ contains real(kind(0d0)), intent(in) :: G integer, intent(in) :: j, k, l - real(kind(0d0)), dimension(b_size - 1) :: tensor - real(kind(0d0)) :: trace, invariant1 + real(kind(0d0)) :: trace real(kind(0d0)) :: f13 = 1d0/3d0 integer :: i !< Generic loop iterators + !TODO Make this 1D and 2D capable ! tensor is the symmetric tensor & calculate the trace of the tensor - !trace = btensor(1)%sf(j,k,l) - !if (num_dims == 2) then - ! trace = trace + btensor(3)%sf(j,k,l) - !else - trace = btensor(1)%sf(j, k, l) + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) - !end if - - ! invariant calculation, saving it in the q_prim_vf field - !invariant1 = btensor(1)%sf(j, k, l) - !if (num_dims == 2) then - ! invariant1 = invariant1 + btensor(3)%sf(j, k, l) - !elseif (num_dims == 3) then - ! invariant1 = invariant1 + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) - !end if + trace = btensor(1)%sf(j, k, l) + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) ! calculate the deviatoric of the tensor btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace - !if (num_dims == 2) then - ! btensor(3)%sf(j,k,l) = btensor(3)%sf(j,k,l) - (1d0/3d0)*trace - !else - btensor(4)%sf(j, k, l) = btensor(4)%sf(j, k, l) - f13*trace - btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace - !end if + btensor(4)%sf(j, k, l) = btensor(4)%sf(j, k, l) - f13*trace + btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace + ! dividing by the jacobian for neo-Hookean model ! setting the tensor to the stresses for riemann solver - !$acc loop seq do i = 1, b_size - 1 q_prim_vf(strxb + i - 1)%sf(j, k, l) = & G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) end do - ! compute the invariant without the elastic modulus - if (btensor(b_size)%sf(j,k,l) .gt. 0d0) then - q_prim_vf(xiend + 1)%sf(j, k, l) = & - 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) - end if - - ! compute the elastic energy without the elastic modulus + q_prim_vf(xiend + 1)%sf(j, k, l) = & + 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) end subroutine s_neoHookean_cauchy_solver diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 36bb4d83a7..518cabcaa6 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -792,7 +792,7 @@ contains !print *, "I got here c" call nvtxStartRange("RHS-ELASTIC") - if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_qp%vf,q_prim_qp%vf) + if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_qp%vf,q_prim_qp%vf) call nvtxEndRange if (t_step == t_step_stop) return diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index ff3688de00..9b2f3b0fcd 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -901,6 +901,7 @@ contains real(kind(0d0)) :: xi_MP, xi_PP real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R + real(kind(0d0)), dimension(num_dims) :: xi_field_L, xi_field_R real(kind(0d0)) :: G_L, G_R real(kind(0d0)) :: nbub_L, nbub_R @@ -1090,6 +1091,11 @@ contains ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY if (hyperelasticity) then + !$acc loop seq + do i = 1, num_dims + xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) + xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) + end do G_L = 0d0; G_R = 0d0; !$acc loop seq do i = 1, num_fluids @@ -1104,9 +1110,9 @@ contains E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) !$acc loop seq do i = 1, b_size - 1 - !tau_e_L(i) = 0d0; tau_e_R(i) = 0d0; - tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + !tau_e_L(i) = 0d0; tau_e_R(i) = 0d0; + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do end if @@ -1287,11 +1293,17 @@ contains ! REFERENCE MAP FLUX. if (hyperelasticity) then !$acc loop seq - do i = xibeg, xiend - flux_rs${XYZ}$_vf(j, k, l, i) = & - xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & - xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) + do i = 1, num_dims + flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & + xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*xi_field_L(i) - rho_L*vel_L(idx1)*xi_field_L(i)) + & + xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*xi_field_R(i) - rho_R*vel_R(idx1)*xi_field_R(i)) end do + !!$acc loop seq + !do i = xibeg, xiend + ! flux_rs${XYZ}$_vf(j, k, l, i) = & + ! xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & + ! xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) + !end do end if ! SURFACE TENSION FLUX. need to check diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 33a171f218..f7e8b853f5 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -848,7 +848,7 @@ contains end if call nvtxStartRange("RHS-ELASTIC") - if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_ts(1)%vf,q_prim_vf) + if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_ts(1)%vf, q_prim_vf) call nvtxEndRange if (adv_n) call s_comp_alpha_from_n(q_cons_ts(1)%vf) diff --git a/submit_test.sh b/submit_test.sh index 7d26596e17..8fe108b055 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -24,15 +24,11 @@ #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -#./mfc.sh run /users/mrodrig97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar +#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 02:00:00 -# test1 -t simulation -c oscar #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar -./mfc.sh run /users/mrodri97/hMFC/tests/9EB947DB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -./mfc.sh run /users/mrodri97/hMFC/tests/9EB947DB/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar - - From 8382a704f56091040733699ccedd83897e70d288 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 16 Jul 2024 17:24:12 -0400 Subject: [PATCH 256/380] additional clean up for the RMT code --- src/simulation/m_hyperelastic.fpp | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index c4833b7185..19fe4dac50 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -146,11 +146,6 @@ contains real(kind(0d0)) :: G_K logical :: flag integer :: j, k, l, i, r - ! STEP 1: computing the grad_xi tensor - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,Re_K, tensora, tensorb, flag) do l = 0, p @@ -168,11 +163,16 @@ contains rho_K = max(rho_K, sgm_eps) if ( G_K .le. verysmall ) G_K = 0d0 - if ( G_K .gt. 1d0 ) then + if ( G_K .gt. verysmall ) then !$acc loop seq do i = 1, tensor_size tensora(i) = 0d0 end do + ! STEP 1: computing the grad_xi tensor using finite differences + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz !$acc loop seq do r = -fd_number, fd_number ! derivatives in the x-direction @@ -221,16 +221,10 @@ contains tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) - - !if (tensorb(tensor_size) < 0d0) then - ! print *, 'idx :: ',j,' ',k,' ',l,' J :: ',tensorb(tensor_size),' ',G_K - !end if else flag = .false. end if - !if (tensorb(tensor_size) < 0.3) flag = .false. - if (flag) then ! STEP 4: update the btensor btensor%vf(1)%sf(j, k, l) = tensorb(1) From 91b6a664d989337e31ad989b1cfe0cd08a953a52 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 16 Jul 2024 18:01:46 -0400 Subject: [PATCH 257/380] added symmetry boundary conditions for the \xi field, other boundary conditions might need to be added as well --- src/simulation/m_boundary_conditions.fpp | 31 ++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/src/simulation/m_boundary_conditions.fpp b/src/simulation/m_boundary_conditions.fpp index ca77632dc1..2b9eee16e8 100644 --- a/src/simulation/m_boundary_conditions.fpp +++ b/src/simulation/m_boundary_conditions.fpp @@ -357,6 +357,12 @@ contains q_prim_vf(i)%sf(-j, k, l) = & q_prim_vf(i)%sf(j - 1, k, l) end do + + if(hyperelasticity) then + q_prim_vf(xibeg)%sf(-j, k, l) = & + -q_prim_vf(xibeg)%sf(j - 1, k, l) + end if + end do end do end do @@ -401,6 +407,11 @@ contains q_prim_vf(i)%sf(m - (j - 1), k, l) end do + if(hyperelasticity) then + q_prim_vf(xibeg)%sf(m + j, k, l) = & + -q_prim_vf(xibeg)%sf(m - (j - 1), k, l) + end if + end do end do end do @@ -448,6 +459,11 @@ contains q_prim_vf(i)%sf(l, -j, k) = & q_prim_vf(i)%sf(l, j - 1, k) end do + + if(hyperelasticity) then + q_prim_vf(xibeg + 1)%sf(l, -j, k) = & + -q_prim_vf(xibeg + 1)%sf(l, j - 1, k) + end if end do end do end do @@ -490,6 +506,11 @@ contains q_prim_vf(i)%sf(l, n + j, k) = & q_prim_vf(i)%sf(l, n - (j - 1), k) end do + + if(hyperelasticity) then + q_prim_vf(xibeg + 1)%sf(l, n + j, k) = & + -q_prim_vf(xibeg + 1)%sf(l, n - (j - 1), k) + end if end do end do end do @@ -537,6 +558,11 @@ contains q_prim_vf(i)%sf(k, l, -j) = & q_prim_vf(i)%sf(k, l, j - 1) end do + + if(hyperelasticity) then + q_prim_vf(xiend)%sf(k, l, -j) = & + -q_prim_vf(xiend)%sf(k, l, j - 1) + end if end do end do end do @@ -579,6 +605,11 @@ contains q_prim_vf(i)%sf(k, l, p + j) = & q_prim_vf(i)%sf(k, l, p - (j - 1)) end do + + if(hyperelasticity) then + q_prim_vf(xiend)%sf(k, l, p + j) = & + -q_prim_vf(xiend)%sf(k, l, p - (j - 1)) + end if end do end do end do From e6e2c6a4810f97fb0350cea2b8ba8ffe5ecae773 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 16 Jul 2024 19:43:54 -0400 Subject: [PATCH 258/380] corrected stress values --- src/simulation/m_hyperelastic.fpp | 6 +++--- submit_test.sh | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 19fe4dac50..cff32e89a4 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -226,11 +226,11 @@ contains end if if (flag) then - ! STEP 4: update the btensor + ! STEP 4: update the btensor, this is consistent with Riemann solvers btensor%vf(1)%sf(j, k, l) = tensorb(1) btensor%vf(2)%sf(j, k, l) = tensorb(2) - btensor%vf(3)%sf(j, k, l) = tensorb(3) - btensor%vf(4)%sf(j, k, l) = tensorb(5) + btensor%vf(3)%sf(j, k, l) = tensorb(5) + btensor%vf(4)%sf(j, k, l) = tensorb(3) btensor%vf(5)%sf(j, k, l) = tensorb(6) btensor%vf(6)%sf(j, k, l) = tensorb(9) ! store the determinant at the last entry of the btensor diff --git a/submit_test.sh b/submit_test.sh index 8fe108b055..8f8430e5ab 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -28,7 +28,7 @@ #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar ./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 02:00:00 -# test1 -t simulation -c oscar #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar From 9aa316ed8f05e9196980ef7be1614bb230226ebf Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 16 Jul 2024 20:34:07 -0400 Subject: [PATCH 259/380] hard coded the boundaries for RMT, need to fix with for cbc in RMT --- src/simulation/m_hyperelastic.fpp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index cff32e89a4..59bcc60ea3 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -148,9 +148,9 @@ contains integer :: j, k, l, i, r !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,Re_K, tensora, tensorb, flag) - do l = 0, p - do k = 0, n - do j = 0, m + do l = 0, p-2 + do k = 0, n-2 + do j = 2, m-2 flag = .true. !$acc loop seq do i = 1, num_fluids From 9cb3a52b79618a62f45ef36411b99532afc81714 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 16 Jul 2024 21:02:06 -0400 Subject: [PATCH 260/380] improved the abstract interface for hyperelastict --- src/simulation/m_hyperelastic.fpp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 59bcc60ea3..ede27d6230 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -41,7 +41,7 @@ module m_hyperelastic real(kind(0d0)), intent(in) :: G integer, intent(in) :: j, k, l - end subroutine + end subroutine s_abstract_hyperelastic_solver !> @} end interface @@ -163,7 +163,7 @@ contains rho_K = max(rho_K, sgm_eps) if ( G_K .le. verysmall ) G_K = 0d0 - if ( G_K .gt. verysmall ) then + if ( G_K .gt. 1d0 ) then !$acc loop seq do i = 1, tensor_size tensora(i) = 0d0 @@ -237,7 +237,7 @@ contains btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) ! STEP 5a: updating the Cauchy stress primitive scalar field - call s_compute_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) + call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) ! STEP 5b: updating the pressure field q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & G_K*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma_K From cdf9923ec00a1f688efd4cbfba6f612261b09e70 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 16 Jul 2024 22:05:30 -0500 Subject: [PATCH 261/380] fixed private variables in HLLC Riemann solver for xi_field_L/R --- src/simulation/m_hyperelastic.fpp | 2 +- src/simulation/m_riemann_solvers.fpp | 2 +- submit_gpu.sh | 8 ++++++-- submit_test.sh | 8 ++++---- 4 files changed, 12 insertions(+), 8 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index ede27d6230..eef766178c 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -237,7 +237,7 @@ contains btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) ! STEP 5a: updating the Cauchy stress primitive scalar field - call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) + call s_compute_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) ! STEP 5b: updating the pressure field q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & G_K*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma_K diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 9b2f3b0fcd..ddb8a4b3ba 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -959,7 +959,7 @@ contains ! 6-EQUATION MODEL WITH HLLC if (model_eqns == 3) then !ME3 - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R, flux_ene_e) + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R, flux_ene_e, xi_field_L, xi_field_R) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end diff --git a/submit_gpu.sh b/submit_gpu.sh index 6909cf3938..c61e198972 100755 --- a/submit_gpu.sh +++ b/submit_gpu.sh @@ -32,11 +32,15 @@ #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 02:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta + diff --git a/submit_test.sh b/submit_test.sh index 8f8430e5ab..6ea710c75d 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -20,15 +20,15 @@ #./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 04:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 02:00:00 -# test1 -t simulation -c oscar +#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 02:00:00 -# test1 -t simulation -c oscar #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar From 6eca956c8640dae1984077474de6a1c8b4725703 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 17 Jul 2024 16:51:16 -0500 Subject: [PATCH 262/380] additional fixes to hyperelastic, compiles, passes test suites, testing on Delta --- src/simulation/m_hyperelastic.fpp | 102 ++++++++++++++------------- src/simulation/m_riemann_solvers.fpp | 21 +++--- submit_test.sh | 4 +- 3 files changed, 62 insertions(+), 65 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index eef766178c..e94bc2048e 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -34,7 +34,7 @@ module m_hyperelastic !> @name Abstract subroutine for the infinite relaxation solver !> @{ subroutine s_abstract_hyperelastic_solver(btensor, q_prim_vf, G, j, k, l) - + !$acc routine seq import :: scalar_field, sys_size, b_size type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor @@ -47,7 +47,8 @@ module m_hyperelastic end interface !> @} - procedure(s_abstract_hyperelastic_solver), pointer :: s_compute_cauchy_solver => null() + procedure(s_abstract_hyperelastic_solver), & + pointer :: s_compute_cauchy_solver => null() !! The btensor at the cell-interior Gaussian quadrature points. !! These tensor is needed to be calculated once and make the code DRY. @@ -88,6 +89,7 @@ contains @:ACC_SETUP_VFs(btensor) @:ALLOCATE(Gs(1:num_fluids)) + !$acc loop seq do i = 1, num_fluids Gs(i) = fluid_pp(i)%G end do @@ -138,20 +140,18 @@ contains type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf - real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb + real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb real(kind(0d0)), dimension(num_fluids) :: alpha_K, alpha_rho_K real(kind(0d0)), dimension(2) :: Re_K real(kind(0d0)) :: rho_K, gamma_K, pi_inf_K, qv_K real(kind(0d0)) :: G_K - logical :: flag integer :: j, k, l, i, r - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,Re_K, tensora, tensorb, flag) + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,Re_K, tensora, tensorb) do l = 0, p-2 do k = 0, n-2 do j = 2, m-2 - flag = .true. !$acc loop seq do i = 1, num_fluids alpha_rho_K(i) = q_cons_vf(i)%sf(j, k, l) @@ -163,7 +163,7 @@ contains rho_K = max(rho_K, sgm_eps) if ( G_K .le. verysmall ) G_K = 0d0 - if ( G_K .gt. 1d0 ) then + if ( G_K .gt. verysmall ) then !$acc loop seq do i = 1, tensor_size tensora(i) = 0d0 @@ -204,50 +204,52 @@ contains - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes F - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do + if (tensorb(tensor_size) > 0d0) then + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes F + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do - ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) - tensorb(tensor_size) = 1d0/tensorb(tensor_size) - - ! STEP 3: computing F tranpose F - tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 - tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 - tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) - tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) - tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) - else - flag = .false. - end if - - if (flag) then - ! STEP 4: update the btensor, this is consistent with Riemann solvers - btensor%vf(1)%sf(j, k, l) = tensorb(1) - btensor%vf(2)%sf(j, k, l) = tensorb(2) - btensor%vf(3)%sf(j, k, l) = tensorb(5) - btensor%vf(4)%sf(j, k, l) = tensorb(3) - btensor%vf(5)%sf(j, k, l) = tensorb(6) - btensor%vf(6)%sf(j, k, l) = tensorb(9) - ! store the determinant at the last entry of the btensor - btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) - - ! STEP 5a: updating the Cauchy stress primitive scalar field - call s_compute_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) - ! STEP 5b: updating the pressure field - q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & + ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) + tensorb(tensor_size) = 1d0/tensorb(tensor_size) + + ! STEP 3: computing F tranpose F + tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 + tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 + tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) + tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) + tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) + ! STEP 4: update the btensor, this is consistent with Riemann solvers + ! \tau_xx + btensor%vf(1)%sf(j, k, l) = tensorb(1) + ! \tau_xy + btensor%vf(2)%sf(j, k, l) = tensorb(2) + ! \tau_yy + btensor%vf(3)%sf(j, k, l) = tensorb(5) + ! \tau_xz + btensor%vf(4)%sf(j, k, l) = tensorb(3) + ! \tau_yz + btensor%vf(5)%sf(j, k, l) = tensorb(6) + ! \tau_zz + btensor%vf(6)%sf(j, k, l) = tensorb(9) + ! store the determinant at the last entry of the btensor + btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) + ! STEP 5a: updating the Cauchy stress primitive scalar field + call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) + ! STEP 5b: updating the pressure field + q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & G_K*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma_K - ! STEP 5c: updating the Cauchy stress conservative scalar field - !$acc loop seq - do i = 1, b_size - 1 - q_cons_vf(strxb + i - 1)%sf(j, k, l) = & - rho_K*q_prim_vf(strxb + i - 1)%sf(j, k, l) - end do + ! STEP 5c: updating the Cauchy stress conservative scalar field + !$acc loop seq + do i = 1, b_size - 1 + q_cons_vf(strxb + i - 1)%sf(j, k, l) = & + rho_K*q_prim_vf(strxb + i - 1)%sf(j, k, l) + end do end if + end if end do end do end do @@ -275,11 +277,11 @@ contains !TODO Make this 1D and 2D capable ! tensor is the symmetric tensor & calculate the trace of the tensor - trace = btensor(1)%sf(j, k, l) + btensor(4)%sf(j, k, l) + btensor(6)%sf(j, k, l) + trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) ! calculate the deviatoric of the tensor btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace - btensor(4)%sf(j, k, l) = btensor(4)%sf(j, k, l) - f13*trace + btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace ! dividing by the jacobian for neo-Hookean model diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index ddb8a4b3ba..ff9bd5511c 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -1104,13 +1104,12 @@ contains G_R = G_R + alpha_R(i)*Gs(i) end do ! Elastic contribution to energy if G large enough - if (G_L < verysmall) G_L = 0d0; - if (G_R < verysmall) G_R = 0d0; - E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) - E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) + if ( G_L > verysmall .and. G_R > verysmall ) then + E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) + E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) + end if !$acc loop seq do i = 1, b_size - 1 - !tau_e_L(i) = 0d0; tau_e_R(i) = 0d0; tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do @@ -1295,15 +1294,11 @@ contains !$acc loop seq do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & - xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*xi_field_L(i) - rho_L*vel_L(idx1)*xi_field_L(i)) + & - xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*xi_field_R(i) - rho_R*vel_R(idx1)*xi_field_R(i)) + xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*xi_field_L(i) & + - rho_L*vel_L(idx1)*xi_field_L(i)) + & + xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*xi_field_R(i) & + - rho_R*vel_R(idx1)*xi_field_R(i)) end do - !!$acc loop seq - !do i = xibeg, xiend - ! flux_rs${XYZ}$_vf(j, k, l, i) = & - ! xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & - ! xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) - !end do end if ! SURFACE TENSION FLUX. need to check diff --git a/submit_test.sh b/submit_test.sh index 6ea710c75d..b202451b23 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -20,8 +20,8 @@ #./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 04:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6fix/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6fix/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta From f607c5f0f55339d52448de0dc54ef27c7abb36c5 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 17 Jul 2024 23:41:06 -0500 Subject: [PATCH 263/380] night before rehearsal at CTR, code testing --- src/simulation/m_hyperelastic.fpp | 2 +- submit_test.sh | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index e94bc2048e..0dc0c83f2f 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -163,7 +163,7 @@ contains rho_K = max(rho_K, sgm_eps) if ( G_K .le. verysmall ) G_K = 0d0 - if ( G_K .gt. verysmall ) then + if ( G_K .gt. 10d0 ) then !$acc loop seq do i = 1, tensor_size tensora(i) = 0d0 diff --git a/submit_test.sh b/submit_test.sh index b202451b23..992a0c7491 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -20,9 +20,9 @@ #./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 04:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6fix/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6fix/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6fix/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6fix/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6fix/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta From 8c9e058d4c9c14ece63affacf6e98dd7e182829b Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 27 Jul 2024 19:41:25 -0500 Subject: [PATCH 264/380] last submit used at CTR summer program --- src/common/m_phase_change.fpp | 4 ++-- src/simulation/m_hyperelastic.fpp | 2 +- submit_test.sh | 34 +++++++++++++++++++++++-------- 3 files changed, 29 insertions(+), 11 deletions(-) diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index c13fa233c6..3bbbee7e24 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -350,7 +350,7 @@ contains ns = 0 ! change this relative error metric. 1E4 is arbitrary do while ((DABS(pS - pO) > palpha_eps) .and. & - (DABS((pS - pO)/pO) > palpha_eps/1d4) .or. (ns == 0)) + (DABS((pS - pO)/pO) > palpha_eps/1d1) .or. (ns == 0)) ! increasing counter ns = ns + 1 @@ -440,7 +440,7 @@ contains R2D(1) = 0.0d0; R2D(2) = 0.0d0 DeltamP(1) = 0.0d0; DeltamP(2) = 0.0d0 do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & - .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) & + .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d1))) & .or. (ns == 0)) ! Updating counter for the iterative procedure diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 0dc0c83f2f..9ae057946e 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -163,7 +163,7 @@ contains rho_K = max(rho_K, sgm_eps) if ( G_K .le. verysmall ) G_K = 0d0 - if ( G_K .gt. 10d0 ) then + if ( G_K .gt. 20d0 ) then !$acc loop seq do i = 1, tensor_size tensora(i) = 0d0 diff --git a/submit_test.sh b/submit_test.sh index 992a0c7491..69b80bbe7b 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -8,8 +8,8 @@ #./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta #./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta @@ -20,15 +20,33 @@ #./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 04:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6fix/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6fix/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6fix/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.3/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 01:00:00 -# pre_bubingel -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# sim_bubingel -t simulation -a bciv-delta-gpu -c delta + +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta + +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# pre_bubinwater -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# sim_bubinwater -t simulation -a bciv-delta-gpu -c delta + +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 02:00:00 -# test1 -t simulation -c oscar #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar + +#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/finalruns/elcom/bubliq/25wv/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta +#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/finalruns/elcom/bubliq/75wv/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta + From 24c25662b433caf4e8fcebb08fd56a5c85730293 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 27 Jul 2024 21:23:32 -0500 Subject: [PATCH 265/380] reverted phase change tolerances --- src/common/m_phase_change.fpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 3bbbee7e24..c13fa233c6 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -350,7 +350,7 @@ contains ns = 0 ! change this relative error metric. 1E4 is arbitrary do while ((DABS(pS - pO) > palpha_eps) .and. & - (DABS((pS - pO)/pO) > palpha_eps/1d1) .or. (ns == 0)) + (DABS((pS - pO)/pO) > palpha_eps/1d4) .or. (ns == 0)) ! increasing counter ns = ns + 1 @@ -440,7 +440,7 @@ contains R2D(1) = 0.0d0; R2D(2) = 0.0d0 DeltamP(1) = 0.0d0; DeltamP(2) = 0.0d0 do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & - .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d1))) & + .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) & .or. (ns == 0)) ! Updating counter for the iterative procedure From 33d820dbccf0190e37fca235c17ee1c3a4f46444 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 27 Jul 2024 22:09:40 -0500 Subject: [PATCH 266/380] added hyper_model capability --- src/simulation/m_global_parameters.fpp | 3 ++ src/simulation/m_hyperelastic.fpp | 52 +++++++++++++++++++++++--- src/simulation/m_start_up.fpp | 1 + 3 files changed, 51 insertions(+), 5 deletions(-) diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index d4c877f221..574c288c89 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -148,6 +148,7 @@ module m_global_parameters logical :: mixture_err !< Mixture properties correction logical :: hypoelasticity !< hypoelasticity modeling logical :: hyperelasticity !< hyperelasticity modeling + integer :: hyper_model !< hyperelasticity solver algorithm logical :: elasticity !< elasticity modeling, true for hyper or hypo logical :: cu_tensor @@ -527,6 +528,7 @@ contains hypoelasticity = .false. hyperelasticity = .false. elasticity = .false. + hyper_model = dflt_int weno_flat = .true. riemann_flat = .true. rdma_mpi = .false. @@ -857,6 +859,7 @@ contains xi_idx%end = sys_size + num_dims ! adding three more equations for the \xi field and the elastic energy sys_size = xi_idx%end + 1 + hyper_model = 1 end if if (.not. f_is_default(sigma)) then diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 9ae057946e..9d8b6a4f49 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -97,11 +97,11 @@ contains ! Associating procedural pointer to the subroutine that will be ! utilized to calculate the solution of a given Riemann problem - !if (hyper_model == 1) then + if (hyper_model == 1) then s_compute_cauchy_solver => s_neoHookean_cauchy_solver - !elseif (riemann_solver == 2) then - ! s_compute_cauchy_solver => s_Mooney_Rivlin_cauchy_solver - !end if + elseif (riemann_solver == 2) then + s_compute_cauchy_solver => s_Mooney_Rivlin_cauchy_solver + end if @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) if (n > 0) then @@ -238,7 +238,7 @@ contains ! store the determinant at the last entry of the btensor btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) ! STEP 5a: updating the Cauchy stress primitive scalar field - call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) + call s_compute_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) ! STEP 5b: updating the pressure field q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & G_K*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma_K @@ -297,6 +297,48 @@ contains end subroutine s_neoHookean_cauchy_solver + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_Mooney_Rivlin_cauchy_solver(btensor, q_prim_vf, G, j, k, l) + !$acc routine seq + type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(inout) :: btensor + real(kind(0d0)), intent(in) :: G + integer, intent(in) :: j, k, l + + real(kind(0d0)) :: trace + real(kind(0d0)) :: f13 = 1d0/3d0 + integer :: i !< Generic loop iterators + + !TODO Make this 1D and 2D capable + ! tensor is the symmetric tensor & calculate the trace of the tensor + trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) + + ! calculate the deviatoric of the tensor + btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace + btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace + btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace + + ! dividing by the jacobian for neo-Hookean model + ! setting the tensor to the stresses for riemann solver + !$acc loop seq + do i = 1, b_size - 1 + q_prim_vf(strxb + i - 1)%sf(j, k, l) = & + G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + end do + ! compute the invariant without the elastic modulus + q_prim_vf(xiend + 1)%sf(j, k, l) = & + 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) + + end subroutine s_Mooney_Rivlin_cauchy_solver + + subroutine s_finalize_hyperelastic_module() integer :: i !< iterator diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 422485e66f..9aee5a052d 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -1434,6 +1434,7 @@ contains call s_finalize_time_steppers_module() if (hypoelasticity) call s_finalize_hypoelastic_module() + if (hyperelasticity) call s_finalize_hyperelastic_module() call s_finalize_derived_variables_module() call s_finalize_data_output_module() call s_finalize_rhs_module() From 2246408b38b8ec57d9093cb44dac218e9e23a415 Mon Sep 17 00:00:00 2001 From: Nazarii Koval Date: Tue, 30 Jul 2024 10:08:54 -0500 Subject: [PATCH 267/380] commiting changes in 2d hardcoded ic --- src/pre_process/include/2dHardcodedIC.fpp | 7 +++++++ submit_gpu_lung.sh | 6 ------ 2 files changed, 7 insertions(+), 6 deletions(-) delete mode 100755 submit_gpu_lung.sh diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp index e07821f225..a9956ffbb8 100644 --- a/src/pre_process/include/2dHardcodedIC.fpp +++ b/src/pre_process/include/2dHardcodedIC.fpp @@ -129,6 +129,13 @@ q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) end if + + case (207) ! Bumps for the patch geometry of the lung + h = 0.0 + lam = 1.0 + amp = patch_icpp(patch_id)%a2 + + case default if (proc_rank == 0) then diff --git a/submit_gpu_lung.sh b/submit_gpu_lung.sh deleted file mode 100755 index b7902da8db..0000000000 --- a/submit_gpu_lung.sh +++ /dev/null @@ -1,6 +0,0 @@ -#!/bin/bash - -./mfc.sh run ./examples/2D_lungwave_horizontal/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -./mfc.sh run ./examples/2D_lungwave_horizontal/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - From 7445aabeb6c3205e06782d217c415463f9a55452 Mon Sep 17 00:00:00 2001 From: Sawyer Remillard Date: Wed, 31 Jul 2024 10:15:31 -0500 Subject: [PATCH 268/380] 2D capability for interface outputting --- src/post_process/m_data_output.fpp | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index e70a14178e..e68c021bdd 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -1005,11 +1005,16 @@ contains end do call s_mpi_allreduce_max(maxalph_loc, maxalph_glb) - do l = 0, p - if (z_cc(l) < dz(l) .and. z_cc(l) > 0) then - cent = l - end if - end do + if (p > 0) then + do l = 0, p + if (z_cc(l) < dz(l) .and. z_cc(l) > 0) then + cent = l + end if + end do + else + cent = 0 + end if + thres = 0.9d0*maxalph_glb do k = 0, n OLoop: do j = 0, m @@ -1031,9 +1036,7 @@ contains do i = 1, counter if (euc_d < tgp) then cycle OLoop - elseif (euc_d > tgp .and. i == counter .and. x_cc(j) < 1.5 .and. y_cc(k) < 1.5) then - !artificial bounding on the interface for bubble at a centroid. - !need to remove eventually. + elseif (euc_d > tgp .and. i == counter) then counter = counter + 1 x_d1(counter) = x_cc(j) y_d1(counter) = y_cc(k) From 0186c5fb998f308f73499e3147de3a570bb172ff Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Wed, 31 Jul 2024 16:42:29 -0500 Subject: [PATCH 269/380] added checkers for current elasticity capabilities, have not addressed prestress --- src/common/m_checker_common.fpp | 14 ++++++++++++++ src/simulation/m_checker.fpp | 17 +++++++++++++---- 2 files changed, 27 insertions(+), 4 deletions(-) diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index ab5df7862f..36aba5015f 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -38,6 +38,7 @@ contains call s_check_inputs_qbmm_and_polydisperse if (adv_n) call s_check_inputs_adv_n if (hypoelasticity) call s_check_inputs_hypoelasticity + if (hyperelasticity) call s_check_inputs_hyperelasticity call s_check_inputs_phase_change call s_check_inputs_ibm #endif @@ -179,8 +180,21 @@ contains '5-equation (model_eqns = 2) or '// & '6-equation model (model_eqns = 3). Exiting ...') end if + if (hyperelasticity) then + call s_mpi_abort('hyperelasticity cannot be true with hypoelasticity. '// & + 'Exiting ...') + end if end subroutine s_check_inputs_hypoelasticity + !> Checks constraints on the hyperelasticity parameters. + !! Called by s_check_inputs_common for pre-processing and simulation + subroutine s_check_inputs_hyperelasticity + if (model_eqns /= 3) then + call s_mpi_abort('hyperelasticity requires '// & + '6-equation model (model_eqns = 3). Exiting ...') + end if + end subroutine s_check_inputs_hyperelasticity + !> Checks constraints on the phase change parameters. !! Called by s_check_inputs_common for pre-processing and simulation subroutine s_check_inputs_phase_change diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index 923682437c..c3523ec9a1 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -31,6 +31,7 @@ contains call s_check_inputs_model_eqns if (acoustic_source) call s_check_inputs_acoustic_src if (hypoelasticity) call s_check_inputs_hypoelasticity + if (hyperelasticity) call s_check_inputs_hyperelasticity if (bubbles) call s_check_inputs_bubbles if (adap_dt) call s_check_inputs_adapt_dt if (alt_soundspeed) call s_check_inputs_alt_soundspeed @@ -368,13 +369,21 @@ contains !> Checks constraints on hypoelasticity parameters subroutine s_check_inputs_hypoelasticity - if (riemann_solver == 3) then + if (riemann_solver /= 1) then call s_mpi_abort('hypoelasticity requires HLL '// & - '(riemann_solver = 1) or HLLC '// & - '(riemann_solver = 2) Riemann solver. '// & + '(riemann_solver = 1) Riemann solver. '// & 'Exiting ...') end if - end subroutine + end subroutine s_check_inputs_hypoelasticity + + !> Checks constraints on hyperelasticity parameters + subroutine s_check_inputs_hyperelasticity + if (riemann_solver /= 2) then + call s_mpi_abort('hyperelasticity requires HLLC '// & + '(riemann_solver = 2) Riemann solver. '// & + 'Exiting ...') + end if + end subroutine s_check_inputs_hyperelasticity !> Checks constraints on bubble parameters subroutine s_check_inputs_bubbles From bc999b5d95236fd69c9949464113065fec9f0fcf Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 1 Aug 2024 08:05:13 -0500 Subject: [PATCH 270/380] updating 5-eq hllc riemann, not yet done --- src/simulation/m_riemann_solvers.fpp | 137 ++++++++++++++------------- 1 file changed, 70 insertions(+), 67 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 9546f6b383..d932016776 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -2066,7 +2066,7 @@ contains end do !$acc end parallel loop else - ! TODO 5-EQUATION MODEL WITH HLLC, INTERFACE CAPTURING ONLY + ! 5-EQUATION MODEL WITH HLLC, INTERFACE CAPTURING ONLY !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp) copyin(is1,is2,is3) do l = is3%beg, is3%end @@ -2173,6 +2173,7 @@ contains E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R + ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY if (hypoelasticity) then !$acc loop seq do i = 1, strxe - strxb + 1 @@ -2185,7 +2186,7 @@ contains G_L = G_L + alpha_L(i)*Gs(i) G_R = G_R + alpha_R(i)*Gs(i) end do - + !$acc loop seq do i = 1, strxe - strxb + 1 ! Elastic contribution to energy if G large enough if ((G_L > verysmall) .and. (G_R > verysmall)) then @@ -2200,6 +2201,32 @@ contains end do end if + ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY + if (hyperelasticity) then + !$acc loop seq + do i = 1, num_dims + xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) + xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) + end do + G_L = 0d0; G_R = 0d0; + !$acc loop seq + do i = 1, num_fluids + ! Mixture left and right shear modulus + G_L = G_L + alpha_L(i)*Gs(i) + G_R = G_R + alpha_R(i)*Gs(i) + end do + ! Elastic contribution to energy if G large enough + if ( G_L > verysmall .and. G_R > verysmall ) then + E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) + E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) + end if + !$acc loop seq + do i = 1, b_size - 1 + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + end do + end if + H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -2230,36 +2257,25 @@ contains end if if (wave_speeds == 1) then - if (hypoelasticity) then - s_L = min(vel_L(dir_idx(1)) - & - sqrt(c_L*c_L + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), & - vel_R(dir_idx(1)) - & - sqrt(c_R*c_R + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) - s_R = max(vel_R(dir_idx(1)) + & - sqrt(c_R*c_R + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), & - vel_L(dir_idx(1)) + & - sqrt(c_L*c_L + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) - + if (elasticity) then + s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) + s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & - tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)* & - (s_L - vel_L(idx1)) - & - rho_R*vel_R(idx1)* & - (s_R - vel_R(idx1))) & - /(rho_L*(s_L - vel_L(idx1)) - & - rho_R*(s_R - vel_R(idx1))) - + tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & + rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & + rho_R*(s_R - vel_R(idx1))) else - s_L = min(vel_L(idx1) - c_L, vel_R(idx1) - c_R) - s_R = max(vel_R(idx1) + c_R, vel_L(idx1) + c_L) - - s_S = (pres_R - pres_L + rho_L*vel_L(idx1)* & - (s_L - vel_L(idx1)) - & - rho_R*vel_R(idx1)* & - (s_R - vel_R(idx1))) & - /(rho_L*(s_L - vel_L(idx1)) - & - rho_R*(s_R - vel_R(idx1))) - end if + s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) + s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) + s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & + (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & + /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) + end if elseif (wave_speeds == 2) then pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(idx1) - & @@ -2313,54 +2329,41 @@ contains ! MOMENTUM FLUX. ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) - !$acc loop seq + !$acc loop seq do i = 1, num_dims - idxi = dir_idx(i) - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & - xi_M*(rho_L*(vel_L(idx1)* & - vel_L(idxi) + & - s_M*(xi_L*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))* & - vel_L(idxi)) - vel_L(idxi))) + & - dir_flg(idxi)*(pres_L)) & - + xi_P*(rho_R*(vel_R(idx1)* & - vel_R(idxi) + & - s_P*(xi_R*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))* & - vel_R(idxi)) - vel_R(idxi))) + & - dir_flg(idxi)*(pres_R)) & - + (s_M/s_L)*(s_P/s_R)*dir_flg(idxi)*pcorr + !idxi = dir_idx(i) + flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & + xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & + (1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & + xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & + (1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) end do ! ENERGY FLUX. ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) flux_rs${XYZ}$_vf(j, k, l, E_idx) = & xi_M*(vel_L(idx1)*(E_L + pres_L) + & - s_M*(xi_L*(E_L + (s_S - vel_L(idx1))* & - (rho_L*s_S + pres_L/ & - (s_L - vel_L(idx1)))) - E_L)) & + s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & + xi_P*(vel_R(idx1)*(E_R + pres_R) + & - s_P*(xi_R*(E_R + (s_S - vel_R(idx1))* & - (rho_R*s_S + pres_R/ & - (s_R - vel_R(idx1)))) - E_R)) & - + (s_M/s_L)*(s_P/s_R)*pcorr*s_S + s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) - ! Additional elastic shear stress terms for the energy flux. + ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux if (elasticity) then - !$acc loop seq - do i = 1, num_dims - idxi = dir_idx(i) - ! MOMENTUM ELASTIC FLUX. - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & - - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) - ! ENERGY ELASTIC FLUX. - flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) - & - xi_M*(vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & - s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & - xi_P*(vel_R(idxi)*tau_e_R(dir_idx_tau(i)) + & - s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) - end do + flux_ene_e = 0d0; + !$acc loop seq + do i = 1, num_dims + ! MOMENTUM ELASTIC FLUX. + flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & + flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) & + - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) + ! ENERGY ELASTIC FLUX. + flux_ene_e = flux_ene_e - & + xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & + s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & + xi_P*(vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & + s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) + end do + flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e end if ! HYPOELASTIC STRESS EVOLUTION FLUX. From efe8914117689b20ea88d87eb3d0ff1e64ce0d98 Mon Sep 17 00:00:00 2001 From: Nazarii Koval Date: Thu, 1 Aug 2024 15:40:24 -0500 Subject: [PATCH 271/380] updated 3Dhardcodedic to include the lung problem geometry --- src/pre_process/include/3dHardcodedIC.fpp | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp index 3d9a4e2f1d..4088fcc29f 100644 --- a/src/pre_process/include/3dHardcodedIC.fpp +++ b/src/pre_process/include/3dHardcodedIC.fpp @@ -42,7 +42,20 @@ pInt = pref + rhoH*9.81*(1.2 - intH) q_prim_vf(E_idx)%sf(i, j, k) = pInt + rhoL*9.81*(intH - y_cc(j)) end if - + + case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|) + h = 0.0 + lam = 1.0 + amp = patch_icpp(patch_id)%a2 + intH = amp*ABS((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h) + if (x_cc(i) > intH) then + q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1) + q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2) + q_prim_vf(E_idx)%sf(i, j, k) = patch_icpp(1)%pres + q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1) + q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2) + end if + ! Put your variable assignments here case default call s_int_to_str(patch_id, iStr) From 570639a0e8f25e4700a4a89e6cffea4ea7a7fc2f Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 4 Aug 2024 21:52:41 -0500 Subject: [PATCH 272/380] 1D and 2D passes suite, 3D fails --- diff.txt | 8069 ++++++++++++++++++++++++++ src/simulation/m_data_output.fpp | 12 +- src/simulation/m_riemann_solvers.fpp | 84 +- submit_gpu.sh | 4 +- 4 files changed, 8135 insertions(+), 34 deletions(-) create mode 100644 diff.txt diff --git a/diff.txt b/diff.txt new file mode 100644 index 0000000000..be07509475 --- /dev/null +++ b/diff.txt @@ -0,0 +1,8069 @@ +diff --git a/batch_mfc.sh b/batch_mfc.sh +new file mode 100755 +index 00000000..41df3c34 +--- /dev/null ++++ b/batch_mfc.sh +@@ -0,0 +1,14 @@ ++#!/bin/bash ++ ++./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar ++ ++./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar ++ ++./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar ++ +diff --git a/examples/2D_lungwave/case.py b/examples/2D_lungwave/case.py +new file mode 100644 +index 00000000..e5888cbe +--- /dev/null ++++ b/examples/2D_lungwave/case.py +@@ -0,0 +1,193 @@ ++#!/usr/bin/env python3 ++ ++import math ++import json ++ ++pi = 3.141592653589 ++# material parameters ++ ++#material1 :: gas ++#patterson 2018 ++ ++gammag = 1.4 #unitless ++Bg =0 #pascals ++rhog = 1.18 #kg/m^3 ++c_g = 347.2 #m/s ++G_g = 0 #pa ++ ++ #material2 :: lung ++ ++gammal = 5.5 ++Bl = 492.E+06 ++rhol = 996.0 ++c_l = 1648.7 ++G_l = 1E3 ++ ++#primitive vartiables ++patmos = 101325. #pa ++ ++#problem specific variable ++lambda_wave = 1E-3 ++ ++#define pulse ++P_amp = 10.E+6 ++P_len = 45 #length of the impulse ++theta = -math.pi/2 #direction of propagation ++ ++#non-dim ++ ++#define characteristic density, length, time, stress material ++rho_char = rhog ++length_char = lambda_wave ++c_char = c_g ++time_char = length_char/c_char ++stress_char = rho_char*c_char*c_char/gammag ++ ++#non-dim the properties ++rhog_n = rhog/rho_char ++c_g_n = c_g/c_char ++rhol_n = rhol/rho_char ++c_l_n = c_l/c_char ++Bg_n = Bg/stress_char ++Bl_n = Bl/stress_char ++G_g_n = G_g/stress_char ++G_l_n = G_l/stress_char ++patmos_n = patmos/stress_char ++P_amp_n = P_amp/stress_char ++ ++#geometry ++dlengx = 1. ++dlengy = 20. ++Nx = 200 ++Ny = dlengy*Nx ++dx = dlengx/Nx ++dy = dlengy/Ny ++alphal_back = 1.0 ++alphag_back = 0.0 ++alphal_lung = 0.0 ++alphag_lung = 1.0 ++ ++interface_amp = 0.5 ++ ++# time stepping requirements ++time_end = 2.5 ++cfl = 0.5 ++ ++dt = cfl * dx/c_l ++Nt = int(time_end/dt) ++Nframes = 50000 ++tstart = 0 ++tstop = Nt ++tsave = int(Nt/Nframes) ++ ++#interface profile ++interface_amp = 0.5 ++ ++# Configuring case dictionary ++print(json.dumps({ ++ # Logistics ================================================================ ++ 'run_time_info' : 'T', ++ # ========================================================================== ++ ++ # Computational Domain Parameters ========================================== ++ 'x_domain%beg' : 0., ++ 'x_domain%end' : dlengx, ++ 'y_domain%beg' : -dlengy/2., ++ 'y_domain%end' : dlengy/2., ++ 'm' : int(Nx), ++ 'n' : int(Ny), ++ 'p' : 0, ++ 'dt' : dt, ++ 't_step_start' : tstart, ++ 't_step_stop' : tstop, ++ 't_step_save' : tsave, ++ # ========================================================================== ++ ++ # Simulation Algorithm Parameters ========================================== ++ 'num_patches' : 2, ++ 'model_eqns' : 2, ++ 'alt_soundspeed' : 'F', ++ 'num_fluids' : 2, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'T', ++ 'mixture_err' : 'T', ++ 'time_stepper' : 3, ++ 'weno_order' : 5, ++ 'weno_eps' : 1.E-16, ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'T', ++ 'riemann_solver' : 2, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -1, ++ 'bc_x%end' : -1, ++ 'bc_y%beg' : -6, ++ 'bc_y%end' : -6, ++ # ========================================================================== ++ ++ # Formatted Database Files Structure Parameters ============================ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt' :'T', ++ 'parallel_io' :'T', ++ # ========================================================================== ++ ++ # Monopole setting ========================================================= ++ 'Monopole' : 'T', # creating an acoustic wave ++ 'num_mono' : 1, # place in the middle and expand ++ 'Mono(1)%pulse' : 3, # sine wave ++ 'Mono(1)%npulse' : 1, # 1 pulse ++ 'Mono(1)%mag' : 10.0*patmos_n, # magnitude ++ 'Mono(1)%length' : 1*dlengx, # impulse length ++ 'Mono(1)%loc(1)' : dlengx/2, # x_center of the domain ++ 'Mono(1)%loc(2)' : 5.0*dlengx, # upper boundary of the domain ++ 'Mono(1)%dir' : -math.pi/2, # direction: -pi/2 ++ #============================================================================== ++ ++ # Patch 1: Background ====================================================== ++ 'patch_icpp(1)%geometry' : 3, ++ 'patch_icpp(1)%x_centroid' : dlengx/2, ++ 'patch_icpp(1)%y_centroid' : 0., ++ 'patch_icpp(1)%length_x' : dlengx, ++ 'patch_icpp(1)%length_y' : dlengy, ++ 'patch_icpp(1)%vel(1)' : 0., ++ 'patch_icpp(1)%vel(2)' : 0.E+00, ++ 'patch_icpp(1)%pres' : patmos_n, ++ 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, ++ 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, ++ 'patch_icpp(1)%alpha(1)' : alphal_back, ++ 'patch_icpp(1)%alpha(2)' : alphag_back, ++ # ========================================================================== ++ ++ ++ # Patch 2: Lung ============================================================ ++ 'patch_icpp(2)%geometry' : 7, ++ 'patch_icpp(2)%hcid' : 205, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ 'patch_icpp(2)%x_centroid' : dlengx/2., ++ 'patch_icpp(2)%y_centroid' : -dlengy/4., ++ 'patch_icpp(2)%length_x' : dlengx, ++ 'patch_icpp(2)%length_y' : dlengy/2.+2, ++ 'patch_icpp(2)%a2' : interface_amp, ++ 'patch_icpp(2)%vel(1)' : 0.E+00, ++ 'patch_icpp(2)%vel(2)' : 0.0, ++ 'patch_icpp(2)%pres' : patmos_n, ++ 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, ++ 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, ++ 'patch_icpp(2)%alpha(1)' : alphal_lung, ++ 'patch_icpp(2)%alpha(2)' : alphag_lung, ++ # ========================================================================== ++ ++ # Fluids Physical Parameters =============================================== ++ 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), ++ 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), ++ 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), ++ 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), ++ # ========================================================================== ++ ++})) ++ ++# ============================================================================== +diff --git a/examples/2D_lungwave_horizontal/case.py b/examples/2D_lungwave_horizontal/case.py +new file mode 100644 +index 00000000..d11aeac2 +--- /dev/null ++++ b/examples/2D_lungwave_horizontal/case.py +@@ -0,0 +1,189 @@ ++#!/usr/bin/env python3 ++ ++import math ++import json ++ ++pi = 3.141592653589 ++# material parameters ++ ++#material1 :: gas ++#patterson 2018 ++ ++gammag = 1.4 #unitless ++Bg =0 #pascals ++rhog = 1.18 #kg/m^3 ++c_g = 347.2 #m/s ++G_g = 0 #pa ++ ++#material2 :: water ++gammal = 5.5 ++Bl = 492.E+06 ++rhol = 996.0 ++c_l = 1648.7 ++G_l = 1E3 ++ ++#primitive vartiables ++patmos = 101325. #pa ++ ++#problem specific variable ++lambda_wave = 1E-3 ++ ++#define pulse ++P_amp = 10.E+6 ++P_len = 45 #length of the impulse ++theta = -math.pi/2 #direction of propagation ++ ++#non-dim ++ ++#define characteristic density, length, time, stress material ++rho_char = rhog ++length_char = lambda_wave ++c_char = c_g ++time_char = length_char/c_char ++stress_char = rho_char*c_char*c_char/gammag ++ ++#non-dim the properties ++rhog_n = rhog/rho_char ++c_g_n = c_g/c_char ++rhol_n = rhol/rho_char ++c_l_n = c_l/c_char ++Bg_n = Bg/stress_char ++Bl_n = Bl/stress_char ++G_g_n = G_g/stress_char ++G_l_n = G_l/stress_char ++patmos_n = patmos/stress_char ++P_amp_n = P_amp/stress_char ++ ++#geometry ++dlengx = 10. ++dlengy = 2. ++Ny = 500 ++Nx = dlengx*Ny ++dx = dlengx/Nx ++dy = dlengy/Ny ++alphal_back = 1.0 ++alphag_back = 0.0 ++alphal_lung = 0.0 ++alphag_lung = 1.0 ++ ++interface_amp = 0.5 ++ ++# time stepping requirements ++time_end = 5 ++cfl = 8.0 ++ ++dt = cfl * dx/c_l ++Nt = int(time_end/dt) ++Nframes = 500 ++tstart = 0 ++tstop = Nt ++tsave = int(Nt/Nframes) ++ ++# Configuring case dictionary ++print(json.dumps({ ++ # Logistics ================================================================ ++ 'run_time_info' : 'T', ++ # ========================================================================== ++ ++ # Computational Domain Parameters ========================================== ++ 'x_domain%beg' : -dlengx/2., ++ 'x_domain%end' : dlengx/2., ++ 'y_domain%beg' : 0., ++ 'y_domain%end' : dlengy, ++ 'm' : int(Nx), ++ 'n' : int(Ny), ++ 'p' : 0, ++ 'dt' : dt, ++ 't_step_start' : tstart, ++ 't_step_stop' : tstop, ++ 't_step_save' : tsave, ++ # ========================================================================== ++ ++ # Simulation Algorithm Parameters ========================================== ++ 'num_patches' : 2, ++ 'model_eqns' : 2, ++ 'alt_soundspeed' : 'F', ++ 'num_fluids' : 2, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'T', ++ 'mixture_err' : 'T', ++ 'time_stepper' : 3, ++ 'weno_order' : 5, ++ 'weno_eps' : 1.E-16, ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'T', ++ 'riemann_solver' : 2, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -6, ++ 'bc_x%end' : -6, ++ 'bc_y%beg' : -1, ++ 'bc_y%end' : -1, ++ # ========================================================================== ++ ++ # Formatted Database Files Structure Parameters ============================ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt' :'T', ++ 'parallel_io' :'T', ++ # ========================================================================== ++ ++ # Monopole setting ========================================================= ++ 'Monopole' : 'T', # creating an acoustic wave ++ 'num_mono' : 1, # place in the middle and expand ++ 'Mono(1)%pulse' : 3, # square wave ++ 'Mono(1)%npulse' : 1, # 1 pulse ++ 'Mono(1)%mag' : 100.0*patmos_n,# magnitude ++ 'Mono(1)%length' : 45.0*dlengy, # pulse length ++ 'Mono(1)%support' : 2, # 2D semi infinite plane (x: -inf,inf; y:-len/2, len/2) ++ 'Mono(1)%support_width' : 30, ++ 'Mono(1)%loc(1)' : 0.7*dlengy, # x_center of the domain ++ 'Mono(1)%loc(2)' : dlengy/2, # upper boundary of the domain ++ 'Mono(1)%dir' : -math.pi, # direction: -pi/2 ++ ++ # Patch 1: Background ====================================================== ++ 'patch_icpp(1)%geometry' : 3, ++ 'patch_icpp(1)%x_centroid' : 0., ++ 'patch_icpp(1)%y_centroid' : dlengy/2., ++ 'patch_icpp(1)%length_x' : dlengx, ++ 'patch_icpp(1)%length_y' : dlengy, ++ 'patch_icpp(1)%vel(1)' : 0., ++ 'patch_icpp(1)%vel(2)' : 0.E+00, ++ 'patch_icpp(1)%pres' : patmos_n, ++ 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, ++ 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, ++ 'patch_icpp(1)%alpha(1)' : alphal_back, ++ 'patch_icpp(1)%alpha(2)' : alphag_back, ++ # ========================================================================== ++ ++ # Patch 2: Lung ============================================================ ++ 'patch_icpp(2)%geometry' : 7, ++ 'patch_icpp(2)%hcid' : 206, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ 'patch_icpp(2)%x_centroid' : -dlengx/4., ++ 'patch_icpp(2)%y_centroid' : dlengy/2., ++ 'patch_icpp(2)%length_x' : dlengx/2.+2, ++ 'patch_icpp(2)%length_y' : dlengy, ++ 'patch_icpp(2)%a2' : interface_amp, ++ 'patch_icpp(2)%vel(1)' : 0.E+00, ++ 'patch_icpp(2)%vel(2)' : 0.0, ++ 'patch_icpp(2)%pres' : patmos_n, ++ 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, ++ 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, ++ 'patch_icpp(2)%alpha(1)' : alphal_lung, ++ 'patch_icpp(2)%alpha(2)' : alphag_lung, ++ # ========================================================================== ++ ++ # Fluids Physical Parameters =============================================== ++ 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), ++ 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), ++ 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), ++ 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), ++ ++ #============================================================================== ++})) ++ ++# ============================================================================== +diff --git a/examples/2D_phasechange_bubble/case.py b/examples/2D_phasechange_bubble/case.py +new file mode 100644 +index 00000000..5fbe5f83 +--- /dev/null ++++ b/examples/2D_phasechange_bubble/case.py +@@ -0,0 +1,286 @@ ++#!/usr/bin/env python3 ++import math, json ++ ++## 1 FOR BACKGROUND, 2 FOR BUBBLE ++# Pressure [Pa] ++p01 = 5E6 ++p02 = 3550 ++ ++# Temperature [K] ++T01 = 298.15 ++T02 = 298.15 ++#T02 = 7.914 ++ ++#### FLUID PROPERTIES #### ++ ++### liquid water ### ++# pi infty ++piwl = 1.0E+09 ++# qv ++qvwl = -1167000 ++# qv' ++qvpwl = 0.0E0 ++# cv ++cvwl = 1816 ++# cp ++cpwl = 4267 ++# gamma ++gamwl = cpwl / cvwl ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) ++rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) ++ ++# speed of sound FOR ++c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) ++c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) ++ ++# part for Gases - relations from IMR ++Ru = 8.3144598 # Universal gas constant (J/mol-K) ++ ++### Vapor water ### ++Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) ++# gamma ++gamwv = 1.4 ++# cp ++cpwv = Rv * gamwv/(gamwv-1) ++# cv ++cvwv = cpwv/gamwv ++# pi infinity ++piwv = 0.0E0 ++# qv ++qvwv = 2030000 ++# qv' ++qvpwv = -23400 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) ++rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) ++ ++# speed of sound ++c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) ++c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) ++ ++### Air ### ++ ++Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) ++# gamma ++gama = 1.4 ++# cp ++cpa = Ra * gama/(gama-1) ++# cv ++cva = cpa/gama ++# pi infinity ++pia = 0.0E0 ++# qv ++qva = 0.0E0 ++# qv' ++qvpa = 0.0E0 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0a1 = (p01 + pia)/((gama-1)*cva*T01) ++rho0a2 = (p02 + pia)/((gama-1)*cva*T02) ++ ++# Speed of sound ++c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) ++c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) ++ ++## SHOCK RELATIONS ++p02Op01 = p02 / p01 ++ ++# Mach number of the shocked region - this should agree with Min, if everything is correct ++Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) ++ ++# shock speed ++ss = Ms * c_a1 ++ ++### volume fractions for each of the patches ### ++C0 = 0.25 # vapor concentration for IMR ++ ++# water liquid ++awl1 = 1.00E00-2.00E-12 ++awl2 = 1.00E-12 ++# water vapor ++awv1 = 1.00E-12 ++awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) ++# air ++aa1 = 1.0 - awl1 - awv1 ++aa2 = 1.0 - awl2 - awv2 ++ ++## SIMULATION PARAMETERS ++ ++# CFL ++cfl = 0.50 ++ ++# Bubble Initial Radius ++R0 = 30E-06 ++ ++# number of elements ++Nx0 = 400 ++Nx = 1600 ++Ny = 1600 ++Nz = 1600 ++ ++# domain boundaries ++xb = 0.00 ++xe = 120E-6 ++ ++yb = 0.00 ++ye = 120E-6 ++ ++zb = 0.00 ++ze = 120E-6 ++ ++# typical cell size ++dx = ( xe - xb ) / Nx ++dy = ( ye - yb ) / Ny ++dz = ( ze - zb ) / Nz ++ ++# time step ++ ++# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) ++SF = 200 ++ ++# Critical time-step ++tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) ++ ++# making Nt divisible by SF ++# tendA = 1.5 * tc ++tend = 1.2 * tc ++ ++# 1 - ensure NtA is sufficient to go a little beyond tendA ++# NtA = int( tendA // dt + 1 ) ++ ++# Array of saves. it is the same as Nt/Sf = t_step_save ++# AS = int( NtA // SF + 1 ) ++ ++# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) ++# Nt = AS * SF ++Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) ++ ++dt = tend / Nt ++ ++AS = int( Nt//SF ) ++ ++# Total physical time ++# tend = Nt * dt ++ ++# Configuring case dictionary ================================================== ++print(json.dumps({ ++ # Logistics ================================================ ++ 'run_time_info': 'T', ++ # ========================================================== ++ # Computational Domain Parameters ========================== ++ 'x_domain%beg' : xb, ++ 'x_domain%end' : xe, ++ 'y_domain%beg' : yb, ++ 'y_domain%end' : ye, ++ 'stretch_x' : 'T', ++ 'loops_x' : 3, ++ 'a_x' : 4.0E0, ++ 'x_a' : -2.0*R0, ++ 'x_b' : 2.0*R0, ++ 'stretch_y' : 'T', ++ 'loops_y' : 3, ++ 'a_y' : 4.0E0, ++ 'y_a' : -2.0*R0, ++ 'y_b' : 2.0*R0, ++ 'cyl_coord' : 'T', ++ 'm' : Nx, ++ 'n' : Ny, ++ 'p' : 0, ++ 'dt' : dt, ++ 't_step_start' : 0, ++ 't_step_stop' : Nt, ++ 't_step_save' : AS, ++ # ========================================================== ++ # Simulation Algorithm Parameters ========================== ++ 'num_patches' : 2, ++ 'model_eqns' : 3, ++ 'num_fluids' : 3, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'T', ++ 'mixture_err' : 'T', ++ 'relax' : 'T', ++ 'relax_model' : 6, ++ 'palpha_eps' : 1.0E-8, ++ 'ptgalpha_eps' : 1.0E-2, ++ 'time_stepper' : 3, ++ 'weno_order' : 3, ++ 'weno_eps' : 1.0E-16, ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'F', ++ 'riemann_solver' : 2, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -2, ++ 'bc_x%end' : -6, ++ 'bc_y%beg' : -2, ++ 'bc_y%end' : -6, ++ # ========================================================== ++ # Formatted Database Files Structure Parameters ============ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt':'T', ++ 'parallel_io' :'T', ++ # ========================================================== ++ # Patch 1: High pressured water ============================ ++ # Specify the cubic water background grid geometry ++ 'patch_icpp(1)%geometry' : 3, ++ 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, ++ 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, ++ 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, ++ 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, ++ 'patch_icpp(1)%vel(1)' : 0.0E+00, ++ 'patch_icpp(1)%vel(2)' : 0.0E+00, ++ 'patch_icpp(1)%pres' : p01, ++ 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, ++ 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, ++ 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, ++ 'patch_icpp(1)%alpha(1)' : awl1, ++ 'patch_icpp(1)%alpha(2)' : awv1, ++ 'patch_icpp(1)%alpha(3)' : aa1, ++ # ========================================================== ++ # Patch 2: (Vapor) Bubble ================================== ++ 'patch_icpp(2)%geometry' : 2, ++ 'patch_icpp(2)%x_centroid' : xb, ++ 'patch_icpp(2)%y_centroid' : yb, ++ 'patch_icpp(2)%radius' : R0, ++ 'patch_icpp(2)%vel(1)' : 0.0E+00, ++ 'patch_icpp(2)%vel(2)' : 0.0E+00, ++ 'patch_icpp(2)%pres' : p02, ++ 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, ++ 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, ++ 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, ++ 'patch_icpp(2)%alpha(1)' : awl2, ++ 'patch_icpp(2)%alpha(2)' : awv2, ++ 'patch_icpp(2)%alpha(3)' : aa2, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ # ========================================================== ++ # Fluids Physical Parameters =============================== ++ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), ++ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), ++ 'fluid_pp(1)%cv' : cvwl, ++ 'fluid_pp(1)%qv' : qvwl, ++ 'fluid_pp(1)%qvp' : qvpwl, ++ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), ++ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), ++ 'fluid_pp(2)%cv' : cvwv, ++ 'fluid_pp(2)%qv' : qvwv, ++ 'fluid_pp(2)%qvp' : qvpwv, ++ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), ++ 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), ++ 'fluid_pp(3)%cv' : cva, ++ 'fluid_pp(3)%qv' : qva, ++ 'fluid_pp(3)%qvp' : qvpa, ++ # ========================================================== ++})) +diff --git a/examples/2D_phasechange_bubble/casefile.py b/examples/2D_phasechange_bubble/casefile.py +new file mode 100644 +index 00000000..722d0049 +--- /dev/null ++++ b/examples/2D_phasechange_bubble/casefile.py +@@ -0,0 +1,300 @@ ++#!/usr/bin/env python3 ++import math, json ++ ++## 1 FOR BACKGROUND, 2 FOR BUBBLE ++# Pressure [Pa] ++p01 = 5E6 ++p02 = 3550 ++ ++# Temperature [K] ++T01 = 298.15 ++T02 = 298.15 ++#T02 = 7.914 ++ ++#### FLUID PROPERTIES #### ++ ++### liquid water ### ++# pi infty ++piwl = 1.0E+09 ++# qv ++qvwl = -1167000 ++# qv' ++qvpwl = 0.0E0 ++# cv ++cvwl = 1816 ++# cp ++cpwl = 4267 ++# gamma ++gamwl = cpwl / cvwl ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) ++rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) ++ ++# speed of sound FOR ++c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) ++c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) ++ ++# part for Gases - relations from IMR ++Ru = 8.3144598 # Universal gas constant (J/mol-K) ++ ++### Vapor water ### ++Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) ++# gamma ++gamwv = 1.4 ++# cp ++cpwv = Rv * gamwv/(gamwv-1) ++# cv ++cvwv = cpwv/gamwv ++# pi infinity ++piwv = 0.0E0 ++# qv ++qvwv = 2030000 ++# qv' ++qvpwv = -23400 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) ++rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) ++ ++# speed of sound ++c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) ++c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) ++ ++### Air ### ++ ++Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) ++# gamma ++gama = 1.4 ++# cp ++cpa = Ra * gama/(gama-1) ++# cv ++cva = cpa/gama ++# pi infinity ++pia = 0.0E0 ++# qv ++qva = 0.0E0 ++# qv' ++qvpa = 0.0E0 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0a1 = (p01 + pia)/((gama-1)*cva*T01) ++rho0a2 = (p02 + pia)/((gama-1)*cva*T02) ++ ++# Speed of sound ++c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) ++c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) ++ ++## SHOCK RELATIONS ++p02Op01 = p02 / p01 ++ ++# Mach number of the shocked region - this should agree with Min, if everything is correct ++Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) ++ ++# shock speed ++ss = Ms * c_a1 ++ ++### volume fractions for each of the patches ### ++C0 = 0.25 # vapor concentration for IMR ++ ++# water liquid ++awl1 = 1.00E00-2.00E-12 ++awl2 = 1.00E-12 ++# water vapor ++awv1 = 1.00E-12 ++awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) ++# air ++aa1 = 1.0 - awl1 - awv1 ++aa2 = 1.0 - awl2 - awv2 ++ ++## SIMULATION PARAMETERS ++ ++# CFL ++cfl = 0.50 ++ ++# Bubble Initial Radius ++R0 = 30E-06 ++ ++# number of elements ++Nx0 = 400 ++Nx = 100 ++Ny = 100 ++Nz = 100 ++ ++# domain boundaries ++xb = 0.00 ++xe = 120E-6 ++ ++yb = 0.00 ++ye = 120E-6 ++ ++zb = 0.00 ++ze = 120E-6 ++ ++# typical cell size ++dx = ( xe - xb ) / Nx ++dy = ( ye - yb ) / Ny ++dz = ( ze - zb ) / Nz ++ ++# time step ++ ++# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) ++SF = 200 ++ ++# Critical time-step ++tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) ++ ++# making Nt divisible by SF ++# tendA = 1.5 * tc ++tend = 1.2 * tc ++ ++# 1 - ensure NtA is sufficient to go a little beyond tendA ++# NtA = int( tendA // dt + 1 ) ++ ++# Array of saves. it is the same as Nt/Sf = t_step_save ++# AS = int( NtA // SF + 1 ) ++ ++# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) ++# Nt = AS * SF ++Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) ++ ++dt = tend / Nt ++ ++AS = int( Nt//SF ) ++ ++# Total physical time ++# tend = Nt * dt ++ ++# Configuring case dictionary ================================================== ++print(json.dumps({ ++ # Logistics ================================================ ++ 'run_time_info': 'T', ++ # ========================================================== ++ # Computational Domain Parameters ========================== ++ 'x_domain%beg' : xb, ++ 'x_domain%end' : xe, ++ 'y_domain%beg' : yb, ++ 'y_domain%end' : ye, ++ 'z_domain%beg' : zb, ++ 'z_domain%end' : ze, ++ 'stretch_x' : 'T', ++ 'loops_x' : 3, ++ 'a_x' : 4.0E0, ++ 'x_a' : -2.0*R0, ++ 'x_b' : 2.0*R0, ++ 'stretch_y' : 'T', ++ 'loops_y' : 3, ++ 'a_y' : 4.0E0, ++ 'y_a' : -2.0*R0, ++ 'y_b' : 2.0*R0, ++ 'stretch_z' : 'T', ++ 'loops_z' : 3, ++ 'a_z' : 4.0E0, ++ 'z_a' : -2.0*R0, ++ 'z_b' : 2.0*R0, ++ 'cyl_coord' : 'F', ++ 'm' : Nx, ++ 'n' : Ny, ++ 'p' : Nz, ++ 'dt' : dt, ++ 't_step_start' : 0, ++ 't_step_stop' : Nt, ++ 't_step_save' : AS, ++ # ========================================================== ++ # Simulation Algorithm Parameters ========================== ++ 'num_patches' : 2, ++ 'model_eqns' : 3, ++ 'num_fluids' : 3, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'T', ++ 'mixture_err' : 'T', ++ 'relax' : 'T', ++ 'relax_model' : 6, ++ 'palpha_eps' : 1.0E-6, ++ 'ptgalpha_eps' : 1.0E-2, ++ 'time_stepper' : 3, ++ 'weno_order' : 3, ++ 'weno_eps' : 1.0E-32, ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'F', ++ 'riemann_solver' : 2, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -2, ++ 'bc_x%end' : -6, ++ 'bc_y%beg' : -2, ++ 'bc_y%end' : -6, ++ 'bc_z%beg' : -2, ++ 'bc_z%end' : -6, ++ # ========================================================== ++ # Formatted Database Files Structure Parameters ============ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt':'T', ++ 'parallel_io' :'T', ++ # ========================================================== ++ # Patch 1: High pressured water ============================ ++ # Specify the cubic water background grid geometry ++ 'patch_icpp(1)%geometry' : 9, ++ 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, ++ 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, ++ 'patch_icpp(1)%z_centroid' : ( ze + zb ) * 500000 / 100, ++ 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, ++ 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, ++ 'patch_icpp(1)%length_z' : ( ze - zb ) * 1000000 / 100, ++ 'patch_icpp(1)%vel(1)' : 0.0E+00, ++ 'patch_icpp(1)%vel(2)' : 0.0E+00, ++ 'patch_icpp(1)%vel(3)' : 0.0E+00, ++ 'patch_icpp(1)%pres' : p01, ++ 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, ++ 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, ++ 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, ++ 'patch_icpp(1)%alpha(1)' : awl1, ++ 'patch_icpp(1)%alpha(2)' : awv1, ++ 'patch_icpp(1)%alpha(3)' : aa1, ++ # ========================================================== ++ # Patch 2: (Vapor) Bubble ================================== ++ 'patch_icpp(2)%geometry' : 8, ++ 'patch_icpp(2)%x_centroid' : xb, ++ 'patch_icpp(2)%y_centroid' : yb, ++ 'patch_icpp(2)%z_centroid' : zb, ++ 'patch_icpp(2)%radius' : R0, ++ 'patch_icpp(2)%vel(1)' : 0.0E+00, ++ 'patch_icpp(2)%vel(2)' : 0.0E+00, ++ 'patch_icpp(2)%vel(3)' : 0.0E+00, ++ 'patch_icpp(2)%pres' : p02, ++ 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, ++ 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, ++ 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, ++ 'patch_icpp(2)%alpha(1)' : awl2, ++ 'patch_icpp(2)%alpha(2)' : awv2, ++ 'patch_icpp(2)%alpha(3)' : aa2, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ # ========================================================== ++ # Fluids Physical Parameters =============================== ++ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), ++ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), ++ 'fluid_pp(1)%cv' : cvwl, ++ 'fluid_pp(1)%qv' : qvwl, ++ 'fluid_pp(1)%qvp' : qvpwl, ++ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), ++ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), ++ 'fluid_pp(2)%cv' : cvwv, ++ 'fluid_pp(2)%qv' : qvwv, ++ 'fluid_pp(2)%qvp' : qvpwv, ++ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), ++ 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), ++ 'fluid_pp(3)%cv' : cva, ++ 'fluid_pp(3)%qv' : qva, ++ 'fluid_pp(3)%qvp' : qvpa, ++ # ========================================================== ++})) +diff --git a/examples/3D_CAV/3D_CAV_sph_col.py b/examples/3D_CAV/3D_CAV_sph_col.py +new file mode 100644 +index 00000000..a54df0a5 +--- /dev/null ++++ b/examples/3D_CAV/3D_CAV_sph_col.py +@@ -0,0 +1,205 @@ ++import math ++import json ++ ++ ++## Deine characteristic values for the sim ++Ri = 50E-6 ++T = 407.9 ++rhog = 0.027 ++Pb = 3550 ++Pl = 101325 ++#mulc = 9E-04 ++#mubc = 1.0E-05 ++domain_length = 3*Ri ++ ++ ++## fluid properties ++Pi_inf_l = 1.0E+09 ++Pi_inf_b = 0.0E+00 ++nl = 2.35 ++nb = 1.47 ++alpha1 = 1.0E+00 ++Cv_l = 1816 ++rhol = (Pl+Pi_inf_l)/((nl-1)*Cv_l*T) ++alpha2 = alpha1 ++cl = (nl*(Pl+Pi_inf_l)/rhol)**(0.5) ++ ++## Defining Characteristic Values ++Rc = Ri ++rhoc = rhol ++uc = (Pl/rhol)**(0.5E+00) ++tc = Ri/uc ++Pc = rhoc*uc**(2.0E+00) ++ ++## Non-Dimensionalizing values using characteristic values ++Rin = Ri/Rc ++rholn = rhol/rhoc ++rhogn = rhog/rhoc ++Pln = Pl/Pc ++Pbn = Pb/Pc ++tcn = tc/tc ++Pi_inf_ln = Pi_inf_l/Pc ++leng = domain_length/Rc ++clc = cl/uc ++ ++ ++## Non-Dimensional Numbers ++#Rel = rhol*uc*2*Rin/mulc ++#Reb = rhog*uc*2*Rin/mubc ++Ma = uc/cl ++ ++## Grid Specifications ++CFL = 0.1 ++PpBr = 192 ++Nx = PpBr*leng ++Ny = Nx ++Nz = Nx ++x_beg = 0.0E+00 ++x_end = leng ++y_beg = 0.0E+00 ++y_end = leng ++z_beg = 0.0E+00 ++z_end = leng ++delta_x = leng/Nx ++delta_t = CFL*delta_x/clc ++Nt = int(1.1*tcn/delta_t) ++x_centroidl = (x_end+x_beg)/(2.0E+00) ++y_centroidl = (y_end+y_beg)/(2.0E+00) ++z_centroidl = (z_end+z_beg)/(2.0E+00) ++x_centroidb = 0.0E+00 ++y_centroidb = 0.0E+00 ++z_centroidb = 0.0E+00 ++ ++ ++# Configuring case dictionary ++print(json.dumps({ ++ # Logistics ================================================ ++ 'run_time_info' : 'T', ++ 'sim_data' : 'T', ++ # ========================================================== ++ ++ # Computational Domain Parameters ========================== ++ 'x_domain%beg' : x_beg, ++ 'x_domain%end' : x_end, ++ 'y_domain%beg' : y_beg, ++ 'y_domain%end' : y_end, ++ 'z_domain%beg' : z_beg, ++ 'z_domain%end' : z_end, ++ 'm' : int(Nx), ++ 'n' : int(Ny), ++ 'p' : int(Nz), ++ 'cyl_coord' : 'F', ++ 'dt' : delta_t, ++ 't_step_start' : 0, ++ 't_step_stop' : Nt, ++ 't_step_save' : int(Nt/360), ++# ========================================================== ++ ++ # Simulation Algorithm Parameters ========================== ++ 'num_patches' : 2, ++ 'model_eqns' : 2, ++ 'alt_soundspeed' : 'F', ++ 'num_fluids' : 2, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'T', ++ 'mixture_err' : 'T', ++ 'time_stepper' : 3, ++ 'weno_order' : 5, ++ 'weno_eps' : 1.E-100, ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'F', ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'riemann_solver' : 2, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -2, ++ 'bc_x%end' : -6, ++ 'bc_y%beg' : -2, ++ 'bc_y%end' : -6, ++ 'bc_z%beg' : -2, ++ 'bc_z%end' : -6, ++ 'stretch_x' : 'T', ++ 'stretch_y' : 'T', ++ 'stretch_z' : 'T', ++ 'a_x' : 4.0E+00, ++ 'x_a' : -1.5E+00, ++ 'x_b' : 1.5E+00, ++ 'a_y' : 4.0E+00, ++ 'y_a' : -1.5E+00, ++ 'y_b' : 1.5E+00, ++ 'a_z' : 4.0E+00, ++ 'z_a' : -1.5E+00, ++ 'z_b' : 1.5E+00, ++ # ========================================================== ++ ++ # Formatted Database Files Structure Parameters ============ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt' :'T', ++ 'parallel_io' :'T', ++ 'fd_order' :'1', ++ 'probe_wrt' :'T', ++ 'num_probes' : 1, ++ 'probe(1)%x' : 0., ++ 'probe(1)%y' : 0., ++ 'probe(1)%z' : 0., ++ # ========================================================== ++ ++ # Patch 1: Background ============================ ++ 'patch_icpp(1)%geometry' : 9, ++ 'patch_icpp(1)%x_centroid' : 40*x_centroidl, ++ 'patch_icpp(1)%y_centroid' : 40*y_centroidl, ++ 'patch_icpp(1)%z_centroid' : 40*z_centroidl, ++ 'patch_icpp(1)%length_x' : 40*leng, ++ 'patch_icpp(1)%length_y' : 40*leng, ++ 'patch_icpp(1)%length_z' : 40*leng, ++ 'patch_icpp(1)%vel(1)' : 0.E+00, ++ 'patch_icpp(1)%vel(2)' : 0.E+00, ++ 'patch_icpp(1)%vel(3)' : 0.E+00, ++ 'patch_icpp(1)%pres' : Pln, ++ 'patch_icpp(1)%alpha_rho(1)' : alpha1*rholn, ++ 'patch_icpp(1)%alpha_rho(2)' : 0.0E+00, ++ 'patch_icpp(1)%alpha(1)' : alpha1, ++ 'patch_icpp(1)%alpha(2)' : 0.0E+00, ++ # ========================================================== ++ # Patch 2: Bubble ====================================== ++ 'patch_icpp(2)%geometry' : 14, ++ 'patch_icpp(2)%x_centroid' : x_centroidb, ++ 'patch_icpp(2)%y_centroid' : y_centroidb, ++ 'patch_icpp(2)%z_centroid' : z_centroidb, ++ 'patch_icpp(2)%radius' : Rin, ++ 'patch_icpp(2)%smoothen' : 'T', ++ 'patch_icpp(2)%smooth_patch_id': 1, ++ 'patch_icpp(2)%smooth_coeff' : 1.5E+00, ++ 'patch_icpp(2)%non_axis_sym' : 'F', ++ 'patch_icpp(2)%a2' : 0.0E+00, ++ 'patch_icpp(2)%a3' : 0.0E+00, ++ 'patch_icpp(2)%a4' : 0.0E+00, ++ 'patch_icpp(2)%a5' : 0.0E+00, ++ 'patch_icpp(2)%a6' : 0.0E+00, ++ 'patch_icpp(2)%a7' : 0.0E+00, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ 'patch_icpp(2)%vel(1)' : 0.E+00, ++ 'patch_icpp(2)%vel(2)' : 0.E+00, ++ 'patch_icpp(2)%vel(3)' : 0.E+00, ++ 'patch_icpp(2)%pres' : Pbn, ++ 'patch_icpp(2)%alpha_rho(1)' : 0.0E+00, ++ 'patch_icpp(2)%alpha_rho(2)' : alpha2*rhogn, ++ 'patch_icpp(2)%alpha(1)' : 0.0E+00, ++ 'patch_icpp(2)%alpha(2)' : alpha2, ++ # ========================================================== ++ ++ # Fluids Physical Parameters =============================== ++ 'fluid_pp(1)%gamma' : 1/(nl-1), ++ 'fluid_pp(1)%pi_inf' : nl*Pi_inf_ln/(nl-1), ++ 'fluid_pp(2)%gamma' : 1/(nb-1), ++ 'fluid_pp(2)%pi_inf' : 0.0E+00, ++# 'fluid_pp(1)%Re(1)' : Rel, ++# 'fluid_pp(2)%Re(1)' : Reb, ++ # ========================================================== ++})) ++ ++# ============================================================================== ++ +diff --git a/examples/3D_ctr_test/case.py b/examples/3D_ctr_test/case.py +new file mode 100644 +index 00000000..aac9ec36 +--- /dev/null ++++ b/examples/3D_ctr_test/case.py +@@ -0,0 +1,399 @@ ++#!/usr/bin/env python3 ++import math, json ++ ++## 1 FOR BACKGROUND, 2 FOR BUBBLE, 3 FOR GEL ++# Pressure [Pa] ++p01 = 5E6 ++p02 = 3550 ++p03 = p01 ++ ++# Temperature [K] ++T01 = 298.15 ++T02 = 298.15 ++T03 = T01 ++ ++#### FLUID PROPERTIES #### ++ ++### liquid water ### ++# pi infty ++piwl = 1.0E+09 ++# qv ++qvwl = -1167000 ++# qv' ++qvpwl = 0.0E0 ++# cv ++cvwl = 1816 ++# cp ++cpwl = 4267 ++# gamma ++gamwl = cpwl / cvwl ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) ++rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) ++rho0wl3 = (p03 + piwl)/((gamwl-1)*cvwl*T03) ++ ++# speed of sound FOR ++c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) ++c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) ++c_wl3 = math.sqrt( gamwl * ( p03 + piwl ) / rho0wl3 ) ++ ++# part for Gases - relations from IMR ++Ru = 8.3144598 # Universal gas constant (J/mol-K) ++ ++### Vapor water ### ++Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) ++# gamma ++gamwv = 1.4 ++# cp ++cpwv = Rv * gamwv/(gamwv-1) ++# cv ++cvwv = cpwv/gamwv ++# pi infinity ++piwv = 0.0E0 ++# qv ++qvwv = 2030000 ++# qv' ++qvpwv = -23400 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) ++rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) ++rho0wv3 = (p03 + piwv)/((gamwv-1)*cvwv*T03) ++ ++# speed of sound ++c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) ++c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) ++c_wv3 = math.sqrt( gamwv * ( p03 + piwv ) / rho0wv3 ) ++ ++### Air ### ++ ++Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) ++gamwa = 1.4 ++# cp ++cpa = Ra * gamwa/(gamwa-1) ++# cv ++cva = cpa/gamwa ++# pi infinity ++pia = 0.0E0 ++# qv ++qvwa = 0.0E0 ++# qv' ++qvpwa = 0.0E0 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wa1 = (p01 + pia)/((gamwa-1)*cva*T01) ++rho0wa2 = (p02 + pia)/((gamwa-1)*cva*T02) ++ ++# Speed of sound ++c_a1 = math.sqrt( gamwa * ( p01 + pia ) / rho0wa1 ) ++c_a2 = math.sqrt( gamwa * ( p02 + pia ) / rho0wa2 ) ++ ++### 3% polyacrylamide gel ### ++# gamma ++gamwg = 2.35 ++# pi infty ++pig = 1.0E+09 ++# qv ++qvwg = -1167000 ++# qv' ++qvpwg = 0.0E0 ++# cv ++cvg = 1816 ++# cp ++cpg = gamwg*cvg ++ ++## FOR PATCHES 1 & 2 & 3 ## ++ ++# density ++rho0wg1 = (p01 + pig)/((gamwg-1)*cvg*T01) ++rho0wg2 = (p02 + pig)/((gamwg-1)*cvg*T02) ++rho0wg3 = (p03 + pig)/((gamwg-1)*cvg*T03) ++ ++# Speed of sound ++c_g1 = math.sqrt( gamwg * ( p01 + pig ) / rho0wg1 ) ++c_g2 = math.sqrt( gamwg * ( p02 + pig ) / rho0wg2 ) ++c_g3 = math.sqrt( gamwg * ( p03 + pig ) / rho0wg3 ) ++ ++## SHOCK RELATIONS ++p02Op01 = p02 / p01 ++ ++# Mach number of the shocked region - this should agree with Min, if everything is correct ++Ms = math.sqrt( ( gamwa + 1. ) / ( 2. * gamwa ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) ++ ++# shock speed ++ss = Ms * c_a1 ++ ++### volume fractions for each of the patches ### ++C0 = 0.5 # vapor concentration for IMR ++ ++# patch 1: liquid water ++liq_wv = 1.00E-15 ++liq_wg = 0. ++liq_wa = 1.00E-15 ++liq_wl = 1.00E00 - liq_wv - liq_wa - liq_wg ++# water vapor ++vap_wl = 1.00E-15 ++vap_wv = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0wa2 + 1 ) ++vap_wg = 0. ++vap_wa = 1.00E-15 ++vap_tot = vap_wl + vap_wv + vap_wa + vap_wg ++# bub ++bub_wl = 1.00E-15 ++bub_wv = vap_tot ++bub_wg = 0. ++bub_wa = 1.00E00 - bub_wl - bub_wv - bub_wg ++# gel ++gel_wv = 0. ++gel_wl = 0. ++gel_wa = 0. ++gel_wg = 1.00E00 - gel_wl - gel_wv - gel_wa ++ ++## SIMULATION PARAMETERS ++ ++# CFL ++cfl = 0.50 ++ ++# Bubble Initial Radius ++R0 = 230.4E-06 ++ ++# number of elements ++Nx0 = 400 ++Nx = 399 ++Ny = 199 ++Nz = 199 ++ ++lref = 921.6E-6 ++# domain boundaries ++xb = -lref ++xe = lref ++ ++yb = 0.00 ++ye = lref ++ ++zb = 0.00 ++ze = lref ++ ++lenx = ( xe - xb ) ++leny = ( ye - yb ) ++lenz = ( ze - zb ) ++ ++xcenl = (xb + xe)/2.0 ++ycenl = (yb + ye)/2.0 ++zcenl = (zb + ze)/2.0 ++ ++#xdist = 6.51E-10 #2.17E-5 ++#sod = xdist/R0 ++sod = -2.17 ++xcenb = sod*R0 ++ycenb = 0.00 ++zcenb = 0.00 ++ ++xbg = 0 ++xeg = xe ++ ++lenxg = (xeg - xbg) ++lenyg = leny ++lenzg = lenz ++xceng = (xbg + xeg)/2.0 ++yceng = ycenl ++zceng = zcenl ++ ++# typical cell size ++dx = ( xe - xb ) / Nx ++dy = ( ye - yb ) / Ny ++dz = ( ze - zb ) / Nz ++#print(dx) ++# time step ++ ++# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) ++SF = 60 ++ ++# Critical time-step ++tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) ++ ++# making Nt divisible by SF ++# tendA = 1.5 * tc ++tend = 1.2 * tc ++ ++# 1 - ensure NtA is sufficient to go a little beyond tendA ++# NtA = int( tendA // dt + 1 ) ++ ++# Array of saves. it is the same as Nt/Sf = t_step_save ++# AS = int( NtA // SF + 1 ) ++ ++# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) ++# Nt = AS * SF ++Nt = int(10E3 * tend // tc * Nx / Nx0 + 1) ++#print(Nt) ++dt = tend / Nt ++ ++AS = int( Nt//SF ) ++ ++# Total physical time ++# tend = Nt * dt ++ ++# Configuring case dictionary ================================================== ++print(json.dumps({ ++ # Logistics ================================================ ++ 'run_time_info': 'T', ++ # ========================================================== ++ # Computational Domain Parameters ========================== ++ 'x_domain%beg' : xb, ++ 'x_domain%end' : xe, ++ 'y_domain%beg' : yb, ++ 'y_domain%end' : ye, ++ 'z_domain%beg' : zb, ++ 'z_domain%end' : ze, ++ 'stretch_x' : 'F', ++ 'loops_x' : 1, ++ 'a_x' : 4.0E0, ++ 'x_a' : -2.0*R0, ++ 'x_b' : 2.0*R0, ++ 'stretch_y' : 'F', ++ 'loops_y' : 1, ++ 'a_y' : 4.0E0, ++ 'y_a' : -2.0*R0, ++ 'y_b' : 2.0*R0, ++ 'stretch_z' : 'F', ++ 'loops_z' : 1, ++ 'a_z' : 4.0E0, ++ 'z_a' : -2.0*R0, ++ 'z_b' : 2.0*R0, ++ 'cyl_coord' : 'F', ++ 'm' : Nx, ++ 'n' : Ny, ++ 'p' : Nz, ++ 'dt' : dt, ++ 't_step_start' : 0, ++ 't_step_stop' : Nt, ++ 't_step_save' : AS, ++ # ========================================================== ++ # Simulation Algorithm Parameters ========================== ++ 'num_patches' : 3, ++ 'model_eqns' : 3, ++ 'num_fluids' : 4, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'T', ++ 'mixture_err' : 'T', ++ 'relax' : 'T', ++ 'relax_model' : 6, ++ 'palpha_eps' : 1.0E-6, ++ 'ptgalpha_eps' : 1.0E-2, ++ 'time_stepper' : 3, ++ 'weno_order' : 3, ++ 'weno_eps' : 1.0E-16, ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'F', ++ 'riemann_solver' : 2, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -6, #-2, ++ 'bc_x%end' : -6, ++ 'bc_y%beg' : -2, ++ 'bc_y%end' : -6, ++ 'bc_z%beg' : -2, ++ 'bc_z%end' : -6, ++ # ========================================================== ++ # Formatted Database Files Structure Parameters ============ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt':'T', ++ 'parallel_io' :'T', ++ # ========================================================== ++ # Patch 1: High pressured water ============================ ++ # Specify the cubic water background grid geometry ++ 'patch_icpp(1)%geometry' : 9, ++ 'patch_icpp(1)%x_centroid' : xcenl, ++ 'patch_icpp(1)%y_centroid' : ycenl, ++ 'patch_icpp(1)%z_centroid' : zcenl, ++ 'patch_icpp(1)%length_x' : lenx, ++ 'patch_icpp(1)%length_y' : leny, ++ 'patch_icpp(1)%length_z' : lenz, ++ 'patch_icpp(1)%vel(1)' : 0.0E+00, ++ 'patch_icpp(1)%vel(2)' : 0.0E+00, ++ 'patch_icpp(1)%vel(3)' : 0.0E+00, ++ 'patch_icpp(1)%pres' : p01, ++ 'patch_icpp(1)%alpha_rho(1)' : liq_wl * rho0wl1, ++ 'patch_icpp(1)%alpha_rho(2)' : liq_wv * rho0wv1, ++ 'patch_icpp(1)%alpha_rho(3)' : liq_wa * rho0wa1, ++ 'patch_icpp(1)%alpha_rho(4)' : liq_wg * rho0wg1, ++ 'patch_icpp(1)%alpha(1)' : liq_wl, ++ 'patch_icpp(1)%alpha(2)' : liq_wv, ++ 'patch_icpp(1)%alpha(3)' : liq_wa, ++ 'patch_icpp(1)%alpha(4)' : liq_wg, ++ # ========================================================== ++ # Patch 2: (Vapor) Bubble ================================== ++ 'patch_icpp(2)%geometry' : 8, ++ 'patch_icpp(2)%x_centroid' : xcenb, ++ 'patch_icpp(2)%y_centroid' : ycenb, ++ 'patch_icpp(2)%z_centroid' : zcenb, ++ 'patch_icpp(2)%radius' : R0, ++ 'patch_icpp(2)%vel(1)' : 0.0E+00, ++ 'patch_icpp(2)%vel(2)' : 0.0E+00, ++ 'patch_icpp(2)%vel(3)' : 0.0E+00, ++ 'patch_icpp(2)%pres' : p02, ++ 'patch_icpp(2)%alpha_rho(1)' : bub_wl * rho0wl2, ++ 'patch_icpp(2)%alpha_rho(2)' : bub_wv * rho0wv2, ++ 'patch_icpp(2)%alpha_rho(3)' : bub_wa * rho0wa2, ++ 'patch_icpp(2)%alpha_rho(4)' : bub_wg * rho0wg2, ++ 'patch_icpp(2)%alpha(1)' : bub_wl, ++ 'patch_icpp(2)%alpha(2)' : bub_wv, ++ 'patch_icpp(2)%alpha(3)' : bub_wa, ++ 'patch_icpp(2)%alpha(4)' : bub_wg, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ # ========================================================== ++ # Patch 3: Gel Object ====================================== ++ 'patch_icpp(3)%geometry' : 9, ++ 'patch_icpp(3)%x_centroid' : xceng, ++ 'patch_icpp(3)%y_centroid' : yceng, ++ 'patch_icpp(3)%z_centroid' : zceng, ++ 'patch_icpp(3)%length_x' : lenxg, ++ 'patch_icpp(3)%length_y' : lenyg, ++ 'patch_icpp(3)%length_z' : lenzg, ++ 'patch_icpp(3)%vel(1)' : 0.0E+00, ++ 'patch_icpp(3)%vel(2)' : 0.0E+00, ++ 'patch_icpp(3)%vel(3)' : 0.0E+00, ++ 'patch_icpp(3)%pres' : p03, ++ 'patch_icpp(3)%alpha_rho(1)' : gel_wl * rho0wl2, ++ 'patch_icpp(3)%alpha_rho(2)' : gel_wv * rho0wv2, ++ 'patch_icpp(3)%alpha_rho(3)' : gel_wa * rho0wa2, ++ 'patch_icpp(3)%alpha_rho(4)' : gel_wg * rho0wg2, ++ 'patch_icpp(3)%alpha(1)' : gel_wl, ++ 'patch_icpp(3)%alpha(2)' : gel_wv, ++ 'patch_icpp(3)%alpha(3)' : gel_wa, ++ 'patch_icpp(3)%alpha(4)' : gel_wg, ++ 'patch_icpp(3)%alter_patch(1)' : 'T', ++ # ========================================================== ++ # Fluids Physical Parameters =============================== ++ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), ++ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), ++ 'fluid_pp(1)%cv' : cvwl, ++ 'fluid_pp(1)%qv' : qvwl, ++ 'fluid_pp(1)%qvp' : qvpwl, ++ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), ++ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), ++ 'fluid_pp(2)%cv' : cvwv, ++ 'fluid_pp(2)%qv' : qvwv, ++ 'fluid_pp(2)%qvp' : qvpwv, ++ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gamwa - 1 ), ++ 'fluid_pp(3)%pi_inf' : gamwa * pia / ( gamwa - 1 ), ++ 'fluid_pp(3)%cv' : cva, ++ 'fluid_pp(3)%qv' : qvwa, ++ 'fluid_pp(3)%qvp' : qvpwa, ++ 'fluid_pp(4)%gamma' : 1.0E+00 / ( gamwg - 1), ++ 'fluid_pp(4)%pi_inf' : gamwg * pig / ( gamwg - 1), ++ 'fluid_pp(4)%cv' : cvg, ++ 'fluid_pp(4)%qv' : qvwg, ++ 'fluid_pp(4)%qvp' : qvpwg, ++ # ========================================================== ++})) +diff --git a/examples/3D_ctr_test/old_case.py b/examples/3D_ctr_test/old_case.py +new file mode 100644 +index 00000000..092c0213 +--- /dev/null ++++ b/examples/3D_ctr_test/old_case.py +@@ -0,0 +1,399 @@ ++#!/usr/bin/env python3 ++import math, json ++ ++## 1 FOR BACKGROUND, 2 FOR BUBBLE, 3 FOR GEL ++# Pressure [Pa] ++p01 = 5E6 ++p02 = 3550 ++p03 = p01 ++ ++# Temperature [K] ++T01 = 298.15 ++T02 = 298.15 ++T03 = T01 ++ ++#### FLUID PROPERTIES #### ++ ++### liquid water ### ++# pi infty ++piwl = 1.0E+09 ++# qv ++qvwl = -1167000 ++# qv' ++qvpwl = 0.0E0 ++# cv ++cvwl = 1816 ++# cp ++cpwl = 4267 ++# gamma ++gamwl = cpwl / cvwl ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) ++rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) ++rho0wl3 = (p03 + piwl)/((gamwl-1)*cvwl*T03) ++ ++# speed of sound FOR ++c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) ++c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) ++c_wl3 = math.sqrt( gamwl * ( p03 + piwl ) / rho0wl3 ) ++ ++# part for Gases - relations from IMR ++Ru = 8.3144598 # Universal gas constant (J/mol-K) ++ ++### Vapor water ### ++Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) ++# gamma ++gamwv = 1.4 ++# cp ++cpwv = Rv * gamwv/(gamwv-1) ++# cv ++cvwv = cpwv/gamwv ++# pi infinity ++piwv = 0.0E0 ++# qv ++qvwv = 2030000 ++# qv' ++qvpwv = -23400 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) ++rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) ++rho0wv3 = (p03 + piwv)/((gamwv-1)*cvwv*T03) ++ ++# speed of sound ++c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) ++c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) ++c_wv3 = math.sqrt( gamwv * ( p03 + piwv ) / rho0wv3 ) ++ ++### Air ### ++ ++Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) ++gamwa = 1.4 ++# cp ++cpa = Ra * gamwa/(gamwa-1) ++# cv ++cva = cpa/gamwa ++# pi infinity ++pia = 0.0E0 ++# qv ++qvwa = 0.0E0 ++# qv' ++qvpwa = 0.0E0 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wa1 = (p01 + pia)/((gamwa-1)*cva*T01) ++rho0wa2 = (p02 + pia)/((gamwa-1)*cva*T02) ++ ++# Speed of sound ++c_a1 = math.sqrt( gamwa * ( p01 + pia ) / rho0wa1 ) ++c_a2 = math.sqrt( gamwa * ( p02 + pia ) / rho0wa2 ) ++ ++### 3% polyacrylamide gel ### ++# gamma ++gamwg = 2.35 ++# pi infty ++pig = 1.0E+09 ++# qv ++qvwg = -1167000 ++# qv' ++qvpwg = 0.0E0 ++# cv ++cvg = 1816 ++# cp ++cpg = gamwg*cvg ++ ++## FOR PATCHES 1 & 2 & 3 ## ++ ++# density ++rho0wg1 = (p01 + pig)/((gamwg-1)*cvg*T01) ++rho0wg2 = (p02 + pig)/((gamwg-1)*cvg*T02) ++rho0wg3 = (p03 + pig)/((gamwg-1)*cvg*T03) ++ ++# Speed of sound ++c_g1 = math.sqrt( gamwg * ( p01 + pig ) / rho0wg1 ) ++c_g2 = math.sqrt( gamwg * ( p02 + pig ) / rho0wg2 ) ++c_g3 = math.sqrt( gamwg * ( p03 + pig ) / rho0wg3 ) ++ ++## SHOCK RELATIONS ++p02Op01 = p02 / p01 ++ ++# Mach number of the shocked region - this should agree with Min, if everything is correct ++Ms = math.sqrt( ( gamwa + 1. ) / ( 2. * gamwa ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) ++ ++# shock speed ++ss = Ms * c_a1 ++ ++### volume fractions for each of the patches ### ++C0 = 0.1 # vapor concentration for IMR ++ ++# patch 1: liquid water ++liq_wv = 1.00E-15 ++liq_wg = 1.00E-15 ++liq_wa = 1.00E-15 ++liq_wl = 1.00E00 - liq_wv - liq_wa - liq_wg ++# water vapor ++vap_wl = 1.00E-15 ++vap_wv = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0wa2 + 1 ) ++vap_wg = 1.00E-15 ++vap_wa = 1.00E-15 ++vap_tot = vap_wl + vap_wv + vap_wa + vap_wg ++# bub ++bub_wl = 1.00E-15 ++bub_wv = vap_tot ++bub_wg = 1.00E-15 ++bub_wa = 1.00E00 - bub_wl - bub_wv - bub_wg ++# gel ++gel_wv = 1.00E-15 ++gel_wl = 1.00E-15 ++gel_wa = 1.00E-15 ++gel_wg = 1.00E00 - gel_wl - gel_wv - gel_wa ++ ++## SIMULATION PARAMETERS ++ ++# CFL ++cfl = 0.50 ++ ++# Bubble Initial Radius ++R0 = 230.4E-06 ++ ++# number of elements ++Nx0 = 400 ++Nx = 199*2 ++Ny = 199 ++Nz = 199 ++ ++lref = 921.6E-6 ++# domain boundaries ++xb = -lref ++xe = lref ++ ++yb = 0.00 ++ye = lref ++ ++zb = 0.00 ++ze = lref ++ ++lenx = ( xe - xb ) ++leny = ( ye - yb ) ++lenz = ( ze - zb ) ++ ++xcenl = (xb + xe)/2.0 ++ycenl = (yb + ye)/2.0 ++zcenl = (zb + ze)/2.0 ++ ++#xdist = 6.51E-10 #2.17E-5 ++#sod = xdist/R0 ++sod = -2.17 ++xcenb = sod*R0 ++ycenb = 0.00 ++zcenb = 0.00 ++ ++xbg = 0 ++xeg = xe ++ ++lenxg = (xeg - xbg) ++lenyg = leny ++lenzg = lenz ++xceng = (xbg + xeg)/2.0 ++yceng = ycenl ++zceng = zcenl ++ ++# typical cell size ++dx = ( xe - xb ) / Nx ++dy = ( ye - yb ) / Ny ++dz = ( ze - zb ) / Nz ++#print(dx) ++# time step ++ ++# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) ++SF = 60 ++ ++# Critical time-step ++tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) ++ ++# making Nt divisible by SF ++# tendA = 1.5 * tc ++tend = 1.2 * tc ++ ++# 1 - ensure NtA is sufficient to go a little beyond tendA ++# NtA = int( tendA // dt + 1 ) ++ ++# Array of saves. it is the same as Nt/Sf = t_step_save ++# AS = int( NtA // SF + 1 ) ++ ++# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) ++# Nt = AS * SF ++Nt = int(10E3 * tend // tc * Nx / Nx0 + 1) ++#print(Nt) ++dt = tend / Nt ++ ++AS = int( Nt//SF ) ++ ++# Total physical time ++# tend = Nt * dt ++ ++# Configuring case dictionary ================================================== ++print(json.dumps({ ++ # Logistics ================================================ ++ 'run_time_info': 'T', ++ # ========================================================== ++ # Computational Domain Parameters ========================== ++ 'x_domain%beg' : xb, ++ 'x_domain%end' : xe, ++ 'y_domain%beg' : yb, ++ 'y_domain%end' : ye, ++ 'z_domain%beg' : zb, ++ 'z_domain%end' : ze, ++ 'stretch_x' : 'F', ++ 'loops_x' : 1, ++ 'a_x' : 4.0E0, ++ 'x_a' : -2.0*R0, ++ 'x_b' : 2.0*R0, ++ 'stretch_y' : 'F', ++ 'loops_y' : 1, ++ 'a_y' : 4.0E0, ++ 'y_a' : -2.0*R0, ++ 'y_b' : 2.0*R0, ++ 'stretch_z' : 'F', ++ 'loops_z' : 1, ++ 'a_z' : 4.0E0, ++ 'z_a' : -2.0*R0, ++ 'z_b' : 2.0*R0, ++ 'cyl_coord' : 'F', ++ 'm' : Nx, ++ 'n' : Ny, ++ 'p' : Nz, ++ 'dt' : dt, ++ 't_step_start' : 0, ++ 't_step_stop' : Nt, ++ 't_step_save' : AS, ++ # ========================================================== ++ # Simulation Algorithm Parameters ========================== ++ 'num_patches' : 3, ++ 'model_eqns' : 3, ++ 'num_fluids' : 4, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'T', ++ 'mixture_err' : 'T', ++ 'relax' : 'T', ++ 'relax_model' : 6, ++ 'palpha_eps' : 1.0E-6, ++ 'ptgalpha_eps' : 1.0E-2, ++ 'time_stepper' : 3, ++ 'weno_order' : 3, ++ 'weno_eps' : 1.0E-16, ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'F', ++ 'riemann_solver' : 2, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -6, #-2, ++ 'bc_x%end' : -6, ++ 'bc_y%beg' : -2, ++ 'bc_y%end' : -6, ++ 'bc_z%beg' : -2, ++ 'bc_z%end' : -6, ++ # ========================================================== ++ # Formatted Database Files Structure Parameters ============ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt':'T', ++ 'parallel_io' :'T', ++ # ========================================================== ++ # Patch 1: High pressured water ============================ ++ # Specify the cubic water background grid geometry ++ 'patch_icpp(1)%geometry' : 9, ++ 'patch_icpp(1)%x_centroid' : xcenl, ++ 'patch_icpp(1)%y_centroid' : ycenl, ++ 'patch_icpp(1)%z_centroid' : zcenl, ++ 'patch_icpp(1)%length_x' : lenx, ++ 'patch_icpp(1)%length_y' : leny, ++ 'patch_icpp(1)%length_z' : lenz, ++ 'patch_icpp(1)%vel(1)' : 0.0E+00, ++ 'patch_icpp(1)%vel(2)' : 0.0E+00, ++ 'patch_icpp(1)%vel(3)' : 0.0E+00, ++ 'patch_icpp(1)%pres' : p01, ++ 'patch_icpp(1)%alpha_rho(1)' : liq_wl * rho0wl1, ++ 'patch_icpp(1)%alpha_rho(2)' : liq_wv * rho0wv1, ++ 'patch_icpp(1)%alpha_rho(3)' : liq_wa * rho0wa1, ++ 'patch_icpp(1)%alpha_rho(4)' : liq_wg * rho0wg1, ++ 'patch_icpp(1)%alpha(1)' : liq_wl, ++ 'patch_icpp(1)%alpha(2)' : liq_wv, ++ 'patch_icpp(1)%alpha(3)' : liq_wa, ++ 'patch_icpp(1)%alpha(4)' : liq_wg, ++ # ========================================================== ++ # Patch 2: (Vapor) Bubble ================================== ++ 'patch_icpp(2)%geometry' : 8, ++ 'patch_icpp(2)%x_centroid' : xcenb, ++ 'patch_icpp(2)%y_centroid' : ycenb, ++ 'patch_icpp(2)%z_centroid' : zcenb, ++ 'patch_icpp(2)%radius' : R0, ++ 'patch_icpp(2)%vel(1)' : 0.0E+00, ++ 'patch_icpp(2)%vel(2)' : 0.0E+00, ++ 'patch_icpp(2)%vel(3)' : 0.0E+00, ++ 'patch_icpp(2)%pres' : p02, ++ 'patch_icpp(2)%alpha_rho(1)' : bub_wl * rho0wl2, ++ 'patch_icpp(2)%alpha_rho(2)' : bub_wv * rho0wv2, ++ 'patch_icpp(2)%alpha_rho(3)' : bub_wa * rho0wa2, ++ 'patch_icpp(2)%alpha_rho(4)' : bub_wg * rho0wg2, ++ 'patch_icpp(2)%alpha(1)' : bub_wl, ++ 'patch_icpp(2)%alpha(2)' : bub_wv, ++ 'patch_icpp(2)%alpha(3)' : bub_wa, ++ 'patch_icpp(2)%alpha(4)' : bub_wg, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ # ========================================================== ++ # Patch 3: Gel Object ====================================== ++ 'patch_icpp(3)%geometry' : 9, ++ 'patch_icpp(3)%x_centroid' : xceng, ++ 'patch_icpp(3)%y_centroid' : yceng, ++ 'patch_icpp(3)%z_centroid' : zceng, ++ 'patch_icpp(3)%length_x' : lenxg, ++ 'patch_icpp(3)%length_y' : lenyg, ++ 'patch_icpp(3)%length_z' : lenzg, ++ 'patch_icpp(3)%vel(1)' : 0.0E+00, ++ 'patch_icpp(3)%vel(2)' : 0.0E+00, ++ 'patch_icpp(3)%vel(3)' : 0.0E+00, ++ 'patch_icpp(3)%pres' : p03, ++ 'patch_icpp(3)%alpha_rho(1)' : gel_wl * rho0wl2, ++ 'patch_icpp(3)%alpha_rho(2)' : gel_wv * rho0wv2, ++ 'patch_icpp(3)%alpha_rho(3)' : gel_wa * rho0wa2, ++ 'patch_icpp(3)%alpha_rho(4)' : gel_wg * rho0wg2, ++ 'patch_icpp(3)%alpha(1)' : gel_wl, ++ 'patch_icpp(3)%alpha(2)' : gel_wv, ++ 'patch_icpp(3)%alpha(3)' : gel_wa, ++ 'patch_icpp(3)%alpha(4)' : gel_wg, ++ 'patch_icpp(3)%alter_patch(1)' : 'T', ++ # ========================================================== ++ # Fluids Physical Parameters =============================== ++ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), ++ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), ++ 'fluid_pp(1)%cv' : cvwl, ++ 'fluid_pp(1)%qv' : qvwl, ++ 'fluid_pp(1)%qvp' : qvpwl, ++ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), ++ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), ++ 'fluid_pp(2)%cv' : cvwv, ++ 'fluid_pp(2)%qv' : qvwv, ++ 'fluid_pp(2)%qvp' : qvpwv, ++ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gamwa - 1 ), ++ 'fluid_pp(3)%pi_inf' : gamwa * pia / ( gamwa - 1 ), ++ 'fluid_pp(3)%cv' : cva, ++ 'fluid_pp(3)%qv' : qvwa, ++ 'fluid_pp(3)%qvp' : qvpwa, ++ 'fluid_pp(4)%gamma' : 1.0E+00 / ( gamwg - 1), ++ 'fluid_pp(4)%pi_inf' : gamwg * pig / ( gamwg - 1), ++ 'fluid_pp(4)%cv' : cvg, ++ 'fluid_pp(4)%qv' : qvwg, ++ 'fluid_pp(4)%qvp' : qvpwg, ++ # ========================================================== ++})) +diff --git a/examples/3D_hyperelasticity/hyper_gel.py b/examples/3D_hyperelasticity/hyper_gel.py +new file mode 100644 +index 00000000..09782de4 +--- /dev/null ++++ b/examples/3D_hyperelasticity/hyper_gel.py +@@ -0,0 +1,312 @@ ++import math ++import json ++#need quadrant and collapse near hypoelastic wall ++ ++## Define characteristic values for the sim ++Ri = 230.4E-6 ++# temperature ++T = (10*101325+1.0E+09)/(1000*(2.35-1)*1816) ++# print("T :: ",T) ++rhog = 1 ++Pb = 3550 #Pb = 101325 ++Pl = 101325 #Pl = 20*101325 ++Po = Pl ++Pi_inf_l = 1.0E+09 ++Pi_inf_b = 0.0E+00 ++Pi_inf_o = 1.1754E+09 ++ ++## fluid properties ++# liquid ++nl = 2.35E+00 ++cv_l = 1816 ++rhol = (Pl+Pi_inf_l)/((nl-1)*cv_l*T) ++# object ++obj_rhol = rhol ++cv_o = cv_l ++rhoo = 1060 ++no = 2.35 ++#no = 1.19E+00 ++muo = 0.060E+00 ++# gas ++ng = 1.47E+00 ++ ++# alpha seeding fractions ++bub_wl = 1.0E-12 ++bub_wo = 1.0E-12 ++bub_wg = 1 - bub_wl - bub_wo ++liq_wo = 1.0E-12 ++liq_wg = 1.0E-12 ++liq_wl = 1 - liq_wo - liq_wg ++obj_wl = 1.0E-12 ++obj_wg = 1.0E-12 ++obj_wo = 1 - obj_wl - obj_wg ++ ++Gl = 0. ++Gg = 0. ++Go = 0.57E+03 #1.0933E+04 ++ ++## mixture values in the liquid ++#rhoml = (alpha1-alph_eps)*rhol+alph_eps*rhog ++#pi_inf_m = (alpha1-alph_eps)*Pi_inf_l ++#nml = (alpha1-alph_eps)*nl+alph_eps*ng ++cl = (nl*(Pl+Pi_inf_l)/rhol)**(0.5) ++rhoml = liq_wl*rhol + liq_wg*rhog + liq_wo*rhoo ++ ++## Defining Characteristic Values ++Rc = Ri ++rhoc = rhol ++uc = (Pl/rhol)**(0.5E+00) ++ucc = (Pl/rhoml)**(0.5E+00) ++# characteristic collapse time, change later to prevent horrific confusion ++tc = Ri/uc ++Pc = rhoc*uc**(2.0E+00) ++ ++## Non-Dimensionalizing values using characteristic values ++Rin = Ri/Rc ++rholn = rhol/rhoc ++rhogn = rhog/rhoc ++rhoon = rhoo/rhoc ++Pln = Pl/Pc ++Pbn = Pb/Pc ++Pon = Po/Pc ++tcn = tc/tc ++Pi_inf_ln = Pi_inf_l/Pc ++clc = cl/uc ++sod_nd = 2.17 ++#clmc = clm/ucc ++Pi_inf_on = Pi_inf_o/Pc ++ ++# Un comment if dimensional ++#Rin = Ri ++#rholn = rhol ++#rhogn = rhog ++#rhoon = rhoo ++#Pln = Pl ++#Pbn = Pb/rhoo ++#Pon = Po ++#tcn = tc ++#Pi_inf_ln = Pi_inf_l ++#leng = domain_length ++#clc = cl ++#sod_nd = sod ++ ++## Non-Dimensional Numbers ++#Rel = rhol*uc*2*Rin/mulc ++#Reb = rhog*uc*2*Rin/mubc ++Rel = 0 ++Reb = 0 ++Reo = rhoo*uc*2/muo ++Ma = uc/cl ++Co = Pl/Go ++iCo = 1/Co ++ ++## GEOMETRY:: Grid Specifications ++lengx = 8.0E+00 ++lengy = 3.0E+00 ++lengz = 3.0E+00 ++CFL = 0.3 ++PPBR = 16 #92 ++x_beg = -5.0E+00 ++x_end = 3.0E+00 ++y_beg = 0.0E+00 ++y_end = lengy ++z_beg = 0.0E+00 ++z_end = lengz ++Nx = PPBR*lengx ++Ny = PPBR*lengy ++Nz = PPBR*lengz ++delta_x = lengx/Nx ++delta_t = CFL*delta_x/clc ++ ++#print("NX :: ",Nx,", NY :: ",Ny,", NZ :: ",Nz) ++ ++#delta_t_c = 0.185*delta_x/clmc ++#print(delta_t_c) ++ ++Nt = int(1.7*tcn/delta_t) ++# liquid centroid, patch 1 ++x_centroidl = x_beg/(2.0E+00) ++y_centroidl = (y_end+y_beg)/(2.0E+00) ++z_centroidl = (z_end+z_beg)/(2.0E+00) ++# bubble centroid, patch 2 ++x_centroidb = -sod_nd ++y_centroidb = 0.0 ++z_centroidb = 0.0 ++# objective centroid, patch 3 ++x_centroido = x_end/2 ++y_centroido = (y_end+y_beg)/(2.0E+00) ++z_centroido = (z_end+z_beg)/(2.0E+00) ++ ++# Configuring case dictionary ++print(json.dumps({ ++ # Logistics ================================================ ++ 'run_time_info' : 'T', ++ 'sim_data' : 'T', ++ # ========================================================== ++ ++ # Computational Domain Parameters ========================== ++ 'x_domain%beg' : x_beg, ++ 'x_domain%end' : x_end, ++ 'y_domain%beg' : y_beg, ++ 'y_domain%end' : y_end, ++ 'z_domain%beg' : z_beg, ++ 'z_domain%end' : z_end, ++ 'm' : int(Nx), ++ 'n' : int(Ny), ++ 'p' : int(Nz), ++ 'cyl_coord' : 'F', ++ 'dt' : delta_t, ++ 't_step_start' : 0, ++ 't_step_stop' : Nt, ++ 't_step_save' : int(5),#int(Nt/150), ++# ========================================================== ++ ++ # Simulation Algorithm Parameters ========================== ++ 'num_patches' : 3, ++ 'model_eqns' : 2, ++ 'hypoelasticity' : 'F', ++ 'hyperelasticity' : 'T', ++ 'pre_stress' : 'F', ++ 'alt_soundspeed' : 'F', ++ 'num_fluids' : 3, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'F', ++ 'mixture_err' : 'T', ++ 'time_stepper' : 3, ++ 'weno_order' : 5, ++ 'weno_eps' : 1.E-16, ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'T', ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'riemann_solver' : 1, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -6, #-16,#-2 ++ 'bc_x%end' : -6, ++ 'bc_y%beg' : -2, ++ 'bc_y%end' : -6, ++ 'bc_z%beg' : -2, ++ 'bc_z%end' : -6, ++ 'stretch_x' : 'F', ++ 'stretch_y' : 'F', ++ 'stretch_z' : 'F', ++ 'a_x' : 4.0E+00, ++ 'x_a' : -1.5E+00-sod_nd, ++ 'x_b' : 2.5E+00, ++ #'loops_x' : 0, ++ 'a_y' : 4.0E+00, ++ 'y_a' : -1.5E+00, ++ 'y_b' : 1.5E+00, ++ #'loops_y' : 0, ++ 'a_z' : 4.0E+00, ++ 'z_a' : -1.5E+00, ++ 'z_b' : 1.5E+00, ++ #'loops_z' : 0, ++ # ========================================================== ++ ++ # Formatted Database Files Structure Parameters ============ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt' :'T', ++ 'parallel_io' :'T', ++ 'probe_wrt' :'T', ++ 'fd_order' : 1, ++ 'num_probes' : 1, ++ 'probe(1)%x' : 0., ++ 'probe(1)%y' : 0., ++ 'probe(1)%z' : 0., ++ # ========================================================== ++ ++ # Patch 1: Background ============================ ++ 'patch_icpp(1)%geometry' : 9,# for 3D ++ 'patch_icpp(1)%x_centroid' : x_centroidl, #100*x_centroidl, ++ 'patch_icpp(1)%y_centroid' : y_centroidl, #100*y_centroidl, ++ 'patch_icpp(1)%z_centroid' : z_centroidl, #100*z_centroidl, ++ 'patch_icpp(1)%length_x' : lengx, #200*lengx, ++ 'patch_icpp(1)%length_y' : lengy, #200*lengy, ++ 'patch_icpp(1)%length_z' : lengz, #200*lengz, ++ 'patch_icpp(1)%vel(1)' : 0.E+00, ++ 'patch_icpp(1)%vel(2)' : 0.E+00, ++ 'patch_icpp(1)%vel(3)' : 0.E+00, ++ 'patch_icpp(1)%pres' : Pln, ++ 'patch_icpp(1)%alpha_rho(1)' : liq_wl*rholn, ++ 'patch_icpp(1)%alpha_rho(2)' : liq_wg*rhogn, ++ 'patch_icpp(1)%alpha_rho(3)' : liq_wo*rhoon, ++ 'patch_icpp(1)%alpha(1)' : liq_wl, ++ 'patch_icpp(1)%alpha(2)' : liq_wg, ++ 'patch_icpp(1)%alpha(3)' : liq_wo, ++ # ========================================================== ++ # Patch 2: Bubble ====================================== ++ # Specify the spherical gas bubble grid geometry ++ 'patch_icpp(2)%geometry' : 8,# for 3D ++ 'patch_icpp(2)%smoothen' : 'T', ++ 'patch_icpp(2)%smooth_patch_id' : 1, ++ 'patch_icpp(2)%smooth_coeff' : 4.0E+00, ++ 'patch_icpp(2)%x_centroid' : x_centroidb, ++ 'patch_icpp(2)%y_centroid' : y_centroidb, ++ 'patch_icpp(2)%z_centroid' : z_centroidb, ++ 'patch_icpp(2)%radius' : Rin, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ # Specify the patch primitive variables ++ 'patch_icpp(2)%vel(1)' : 0.E+00, ++ 'patch_icpp(2)%vel(2)' : 0.E+00, ++ 'patch_icpp(2)%vel(3)' : 0.E+00, ++ 'patch_icpp(2)%pres' : Pbn, ++ 'patch_icpp(2)%alpha_rho(1)' : bub_wl*rholn, ++ 'patch_icpp(2)%alpha_rho(2)' : bub_wg*rhogn, ++ 'patch_icpp(2)%alpha_rho(3)' : bub_wo*rhoon, ++ 'patch_icpp(2)%alpha(1)' : bub_wl, ++ 'patch_icpp(2)%alpha(2)' : bub_wg, ++ 'patch_icpp(2)%alpha(3)' : bub_wo, ++ # ========================================================== ++ # Patch 3: Gel =========================================== ++ # Specify the gel grid geometry ++ 'patch_icpp(3)%geometry' : 9,# for 3D ++ 'patch_icpp(3)%x_centroid' : x_centroido, #100*x_centroido, ++ 'patch_icpp(3)%y_centroid' : y_centroido, #100*y_centroido, ++ 'patch_icpp(3)%z_centroid' : z_centroido, #100*z_centroido, ++ 'patch_icpp(3)%length_x' : 3.0E+00, #100*lengx, ++ 'patch_icpp(3)%length_y' : lengy, #200*lengy, ++ 'patch_icpp(3)%length_z' : lengz, #200*lengz, ++ 'patch_icpp(3)%alter_patch(1)' : 'T', ++ # Specify the patch primitive variables ++ 'patch_icpp(3)%vel(1)' : 0.E+00, ++ 'patch_icpp(3)%vel(2)' : 0.E+00, ++ 'patch_icpp(3)%vel(3)' : 0.E+00, ++ 'patch_icpp(3)%pres' : Pon, ++ 'patch_icpp(3)%alpha_rho(1)' : obj_wl*rholn, ++ 'patch_icpp(3)%alpha_rho(2)' : obj_wg*rhogn, ++ 'patch_icpp(3)%alpha_rho(3)' : obj_wo*rhoon, ++ 'patch_icpp(3)%alpha(1)' : obj_wl, ++ 'patch_icpp(3)%alpha(2)' : obj_wg, ++ 'patch_icpp(3)%alpha(3)' : obj_wo, ++ # ========================================================== ++ ++ ++ # Fluids Physical Parameters =============================== ++ 'fluid_pp(1)%gamma' : 1./(nl-1.), ++ 'fluid_pp(1)%pi_inf' : nl*Pi_inf_ln/(nl-1.), ++ 'fluid_pp(1)%G' : Gl, ++ 'fluid_pp(2)%gamma' : 1./(ng-1.), ++ 'fluid_pp(2)%pi_inf' : 0.0E+00, ++ 'fluid_pp(2)%G' : Gg, ++ 'fluid_pp(3)%gamma' : 1./(no-1.), ++ 'fluid_pp(3)%pi_inf' : no*Pi_inf_on/(no-1.), ++ 'fluid_pp(3)%G' : iCo, ++ 'fluid_pp(1)%qv' : 0.0E+00, ++ 'fluid_pp(1)%qvp' : 0.0E+00, ++ 'fluid_pp(2)%qv' : 0.0E+00, ++ 'fluid_pp(2)%qvp' : 0.0E+00, ++ 'fluid_pp(3)%qv' : 0.0E+00, ++ 'fluid_pp(3)%qvp' : 0.0E+00, ++# 'fluid_pp(1)%Re(1)' : Rel, ++# 'fluid_pp(2)%Re(1)' : Reb, ++# 'fluid_pp(3)%Re(1)' : Reo, ++ # ===========++============================================= ++})) ++ ++# ============================================================================== ++ ++ +diff --git a/examples/3D_phasechange_bubble/case.py b/examples/3D_phasechange_bubble/case.py +new file mode 100644 +index 00000000..047c8655 +--- /dev/null ++++ b/examples/3D_phasechange_bubble/case.py +@@ -0,0 +1,300 @@ ++#!/usr/bin/env python3 ++import math, json ++ ++## 1 FOR BACKGROUND, 2 FOR BUBBLE ++# Pressure [Pa] ++p01 = 5E6 ++p02 = 3550 ++ ++# Temperature [K] ++T01 = 298.15 ++T02 = 298.15 ++#T02 = 7.914 ++ ++#### FLUID PROPERTIES #### ++ ++### liquid water ### ++# pi infty ++piwl = 1.0E+09 ++# qv ++qvwl = -1167000 ++# qv' ++qvpwl = 0.0E0 ++# cv ++cvwl = 1816 ++# cp ++cpwl = 4267 ++# gamma ++gamwl = cpwl / cvwl ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) ++rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) ++ ++# speed of sound FOR ++c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) ++c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) ++ ++# part for Gases - relations from IMR ++Ru = 8.3144598 # Universal gas constant (J/mol-K) ++ ++### Vapor water ### ++Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) ++# gamma ++gamwv = 1.4 ++# cp ++cpwv = Rv * gamwv/(gamwv-1) ++# cv ++cvwv = cpwv/gamwv ++# pi infinity ++piwv = 0.0E0 ++# qv ++qvwv = 2030000 ++# qv' ++qvpwv = -23400 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) ++rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) ++ ++# speed of sound ++c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) ++c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) ++ ++### Air ### ++ ++Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) ++# gamma ++gama = 1.4 ++# cp ++cpa = Ra * gama/(gama-1) ++# cv ++cva = cpa/gama ++# pi infinity ++pia = 0.0E0 ++# qv ++qva = 0.0E0 ++# qv' ++qvpa = 0.0E0 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0a1 = (p01 + pia)/((gama-1)*cva*T01) ++rho0a2 = (p02 + pia)/((gama-1)*cva*T02) ++ ++# Speed of sound ++c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) ++c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) ++ ++## SHOCK RELATIONS ++p02Op01 = p02 / p01 ++ ++# Mach number of the shocked region - this should agree with Min, if everything is correct ++Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) ++ ++# shock speed ++ss = Ms * c_a1 ++ ++### volume fractions for each of the patches ### ++C0 = 0.25 # vapor concentration for IMR ++ ++# water liquid ++awl1 = 1.00E00-2.00E-12 ++awl2 = 1.00E-12 ++# water vapor ++awv1 = 1.00E-12 ++awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) ++# air ++aa1 = 1.0 - awl1 - awv1 ++aa2 = 1.0 - awl2 - awv2 ++ ++## SIMULATION PARAMETERS ++ ++# CFL ++cfl = 0.50 ++ ++# Bubble Initial Radius ++R0 = 30E-06 ++ ++# number of elements ++Nx0 = 400 ++Nx = 199 ++Ny = 199 ++Nz = 199 ++ ++# domain boundaries ++xb = 0.00 ++xe = 120E-6 ++ ++yb = 0.00 ++ye = 120E-6 ++ ++zb = 0.00 ++ze = 120E-6 ++ ++# typical cell size ++dx = ( xe - xb ) / Nx ++dy = ( ye - yb ) / Ny ++dz = ( ze - zb ) / Nz ++ ++# time step ++ ++# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) ++SF = 200 ++ ++# Critical time-step ++tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) ++ ++# making Nt divisible by SF ++# tendA = 1.5 * tc ++tend = 1.2 * tc ++ ++# 1 - ensure NtA is sufficient to go a little beyond tendA ++# NtA = int( tendA // dt + 1 ) ++ ++# Array of saves. it is the same as Nt/Sf = t_step_save ++# AS = int( NtA // SF + 1 ) ++ ++# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) ++# Nt = AS * SF ++Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) ++ ++dt = tend / Nt ++ ++AS = int( Nt//SF ) ++ ++# Total physical time ++# tend = Nt * dt ++ ++# Configuring case dictionary ================================================== ++print(json.dumps({ ++ # Logistics ================================================ ++ 'run_time_info': 'T', ++ # ========================================================== ++ # Computational Domain Parameters ========================== ++ 'x_domain%beg' : xb, ++ 'x_domain%end' : xe, ++ 'y_domain%beg' : yb, ++ 'y_domain%end' : ye, ++ 'z_domain%beg' : zb, ++ 'z_domain%end' : ze, ++ 'stretch_x' : 'T', ++ 'loops_x' : 3, ++ 'a_x' : 4.0E0, ++ 'x_a' : -2.0*R0, ++ 'x_b' : 2.0*R0, ++ 'stretch_y' : 'T', ++ 'loops_y' : 3, ++ 'a_y' : 4.0E0, ++ 'y_a' : -2.0*R0, ++ 'y_b' : 2.0*R0, ++ 'stretch_z' : 'T', ++ 'loops_z' : 3, ++ 'a_z' : 4.0E0, ++ 'z_a' : -2.0*R0, ++ 'z_b' : 2.0*R0, ++ 'cyl_coord' : 'F', ++ 'm' : Nx, ++ 'n' : Ny, ++ 'p' : Nz, ++ 'dt' : dt, ++ 't_step_start' : 0, ++ 't_step_stop' : Nt, ++ 't_step_save' : AS, ++ # ========================================================== ++ # Simulation Algorithm Parameters ========================== ++ 'num_patches' : 2, ++ 'model_eqns' : 3, ++ 'num_fluids' : 3, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'T', ++ 'mixture_err' : 'T', ++ 'relax' : 'T', ++ 'relax_model' : 6, ++ 'palpha_eps' : 1.0E-6, ++ 'ptgalpha_eps' : 1.0E-2, ++ 'time_stepper' : 3, ++ 'weno_order' : 3, ++ 'weno_eps' : 1.0E-32, ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'F', ++ 'riemann_solver' : 2, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -2, ++ 'bc_x%end' : -6, ++ 'bc_y%beg' : -2, ++ 'bc_y%end' : -6, ++ 'bc_z%beg' : -2, ++ 'bc_z%end' : -6, ++ # ========================================================== ++ # Formatted Database Files Structure Parameters ============ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt':'T', ++ 'parallel_io' :'T', ++ # ========================================================== ++ # Patch 1: High pressured water ============================ ++ # Specify the cubic water background grid geometry ++ 'patch_icpp(1)%geometry' : 9, ++ 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, ++ 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, ++ 'patch_icpp(1)%z_centroid' : ( ze + zb ) * 500000 / 100, ++ 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, ++ 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, ++ 'patch_icpp(1)%length_z' : ( ze - zb ) * 1000000 / 100, ++ 'patch_icpp(1)%vel(1)' : 0.0E+00, ++ 'patch_icpp(1)%vel(2)' : 0.0E+00, ++ 'patch_icpp(1)%vel(3)' : 0.0E+00, ++ 'patch_icpp(1)%pres' : p01, ++ 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, ++ 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, ++ 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, ++ 'patch_icpp(1)%alpha(1)' : awl1, ++ 'patch_icpp(1)%alpha(2)' : awv1, ++ 'patch_icpp(1)%alpha(3)' : aa1, ++ # ========================================================== ++ # Patch 2: (Vapor) Bubble ================================== ++ 'patch_icpp(2)%geometry' : 8, ++ 'patch_icpp(2)%x_centroid' : xb, ++ 'patch_icpp(2)%y_centroid' : yb, ++ 'patch_icpp(2)%z_centroid' : zb, ++ 'patch_icpp(2)%radius' : R0, ++ 'patch_icpp(2)%vel(1)' : 0.0E+00, ++ 'patch_icpp(2)%vel(2)' : 0.0E+00, ++ 'patch_icpp(2)%vel(3)' : 0.0E+00, ++ 'patch_icpp(2)%pres' : p02, ++ 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, ++ 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, ++ 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, ++ 'patch_icpp(2)%alpha(1)' : awl2, ++ 'patch_icpp(2)%alpha(2)' : awv2, ++ 'patch_icpp(2)%alpha(3)' : aa2, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ # ========================================================== ++ # Fluids Physical Parameters =============================== ++ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), ++ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), ++ 'fluid_pp(1)%cv' : cvwl, ++ 'fluid_pp(1)%qv' : qvwl, ++ 'fluid_pp(1)%qvp' : qvpwl, ++ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), ++ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), ++ 'fluid_pp(2)%cv' : cvwv, ++ 'fluid_pp(2)%qv' : qvwv, ++ 'fluid_pp(2)%qvp' : qvpwv, ++ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), ++ 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), ++ 'fluid_pp(3)%cv' : cva, ++ 'fluid_pp(3)%qv' : qva, ++ 'fluid_pp(3)%qvp' : qvpa, ++ # ========================================================== ++})) +diff --git a/run_mfc.sh b/run_mfc.sh +new file mode 100755 +index 00000000..fc734bea +--- /dev/null ++++ b/run_mfc.sh +@@ -0,0 +1,14 @@ ++#!/bin/bash ++ ++./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar ++ ++./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar ++ ++./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar ++ +diff --git a/src/common/include/inline_conversions.fpp b/src/common/include/inline_conversions.fpp +index a63af61e..c2f0263e 100644 +--- a/src/common/include/inline_conversions.fpp ++++ b/src/common/include/inline_conversions.fpp +@@ -1,17 +1,17 @@ + #:def s_compute_speed_of_sound() +- subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c) ++ subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c, G) + #ifdef CRAY_ACC_WAR + !DIR$ INLINEALWAYS s_compute_speed_of_sound + #else + !$acc routine seq + #endif +- real(kind(0d0)), intent(in) :: pres +- real(kind(0d0)), intent(in) :: rho, gamma, pi_inf +- real(kind(0d0)), intent(in) :: H +- real(kind(0d0)), dimension(num_fluids), intent(in) :: adv +- real(kind(0d0)), intent(in) :: vel_sum +- real(kind(0d0)), intent(out) :: c +- ++ real(kind(0d0)), intent(IN) :: pres ++ real(kind(0d0)), intent(IN) :: rho, gamma, pi_inf ++ real(kind(0d0)), intent(IN) :: H ++ real(kind(0d0)), dimension(num_fluids), intent(IN) :: adv ++ real(kind(0d0)), intent(IN) :: vel_sum ++ real(kind(0d0)), optional, dimension(num_fluids), intent(IN) :: G ++ real(kind(0d0)), intent(OUT) :: c + real(kind(0d0)) :: blkmod1, blkmod2 + + integer :: q +@@ -22,6 +22,7 @@ + blkmod2 = ((gammas(2) + 1d0)*pres + & + pi_infs(2))/gammas(2) + c = (1d0/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2))) ++ + elseif (model_eqns == 3) then + c = 0d0 + !$acc loop seq +@@ -43,6 +44,7 @@ + (pres + pi_inf/(gamma + 1d0))/ & + (rho*(1d0 - adv(num_fluids))) + end if ++ + else + c = ((H - 5d-1*vel_sum)/gamma) + end if +diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp +index 2a15083c..386a844c 100644 +--- a/src/common/m_checker_common.fpp ++++ b/src/common/m_checker_common.fpp +@@ -38,6 +38,7 @@ contains + call s_check_inputs_qbmm_and_polydisperse + if (adv_n) call s_check_inputs_adv_n + if (hypoelasticity) call s_check_inputs_hypoelasticity ++ if (hyperelasticity) call s_check_inputs_hyperelasticity + call s_check_inputs_phase_change + call s_check_inputs_ibm + #endif +@@ -173,12 +174,27 @@ contains + !> Checks constraints on the hypoelasticity parameters. + !! Called by s_check_inputs_common for pre-processing and simulation + subroutine s_check_inputs_hypoelasticity +- if (model_eqns /= 2) then +- call s_mpi_abort('hypoelasticity requires 5-equation model'// & +- '(model_eqns = 2). Exiting ...') ++ !if ((model_eqns /= 2) .or. (model_eqns /= 3)) then ++ if ((model_eqns == 1) .or. (model_eqns == 4)) then ++ call s_mpi_abort('hypoelasticity requires either '// & ++ '5-equation (model_eqns = 2) or '// & ++ '6-equation model (model_eqns = 3). Exiting ...') ++ end if ++ if (hyperelasticity) then ++ call s_mpi_abort('hyperelasticity cannot be true with hypoelasticity. '// & ++ 'Exiting ...') + end if + end subroutine s_check_inputs_hypoelasticity + ++ !> Checks constraints on the hyperelasticity parameters. ++ !! Called by s_check_inputs_common for pre-processing and simulation ++ subroutine s_check_inputs_hyperelasticity ++ if (model_eqns /= 3) then ++ call s_mpi_abort('hyperelasticity requires '// & ++ '6-equation model (model_eqns = 3). Exiting ...') ++ end if ++ end subroutine s_check_inputs_hyperelasticity ++ + !> Checks constraints on the phase change parameters. + !! Called by s_check_inputs_common for pre-processing and simulation + subroutine s_check_inputs_phase_change +diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp +index a506acb9..6f9ab2ff 100644 +--- a/src/common/m_constants.fpp ++++ b/src/common/m_constants.fpp +@@ -7,18 +7,18 @@ module m_constants + character, parameter :: dflt_char = ' ' !< Default string value + + real(kind(0d0)), parameter :: dflt_real = -1d6 !< Default real value +- real(kind(0d0)), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance +- real(kind(0d0)), parameter :: small_alf = 1d-11 !< Small alf tolerance +- real(kind(0d0)), parameter :: pi = 3.141592653589793d0 !< Pi ++ real(kind(0d0)), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance ++ real(kind(0d0)), parameter :: small_alf = 1d-11 !< Small alf tolerance ++ real(kind(0d0)), parameter :: pi = 3.141592653589793d0 !< Pi + real(kind(0d0)), parameter :: verysmall = 1.d-12 !< Very small number + +- integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils +- integer, parameter :: path_len = 400 !< Maximum path length +- integer, parameter :: name_len = 50 !< Maximum name length +- integer, parameter :: dflt_int = -100 !< Default integer value +- integer, parameter :: fourier_rings = 5 !< Fourier filter ring limit +- integer, parameter :: num_fluids_max = 10 !< Maximum number of fluids in the simulation +- integer, parameter :: num_probes_max = 10 !< Maximum number of flow probes in the simulation ++ integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils ++ integer, parameter :: path_len = 400 !< Maximum path length ++ integer, parameter :: name_len = 50 !< Maximum name length ++ integer, parameter :: dflt_int = -100 !< Default integer value ++ integer, parameter :: fourier_rings = 5 !< Fourier filter ring limit ++ integer, parameter :: num_fluids_max = 10 !< Maximum number of fluids in the simulation ++ integer, parameter :: num_probes_max = 10 !< Maximum number of flow probes in the simulation + integer, parameter :: num_patches_max = 10 + integer, parameter :: pathlen_max = 400 + integer, parameter :: nnode = 4 !< Number of QBMM nodes +diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp +index 9ad172cc..cea5f90d 100644 +--- a/src/common/m_derived_types.fpp ++++ b/src/common/m_derived_types.fpp +@@ -142,7 +142,13 @@ module m_derived_types + type(ic_model_parameters) :: model !< Model parameters + + real(kind(0d0)) :: epsilon, beta !< +- !! The spherical harmonics eccentricity parameters. ++ !! The isentropic vortex parameters administrating, respectively, both ++ !! the amplitude of the disturbance as well as its domain of influence. ++ ++ real(kind(0d0)) :: a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 !< ++ !! The parameters needed for the spherical harmonic patch ++ ++ logical :: non_axis_sym + + real(kind(0d0)), dimension(3) :: normal !< + !! Normal vector indicating the orientation of the patch. It is specified +diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp +index b6d48729..a2b77082 100644 +--- a/src/common/m_helper.fpp ++++ b/src/common/m_helper.fpp +@@ -73,8 +73,8 @@ contains + lE = q + end if + +- if (allocated(fd_coeff_s)) deallocate (fd_coeff_s) +- allocate (fd_coeff_s(-fd_number_in:fd_number_in, lb:lE)) ++ if (allocated(fd_coeff_s)) deallocate(fd_coeff_s) ++ allocate(fd_coeff_s(-fd_number_in:fd_number_in, lb:lE)) + + ! Computing the 1st order finite-difference coefficients + if (fd_order_in == 1) then +@@ -83,7 +83,6 @@ contains + fd_coeff_s(0, i) = -1d0/(s_cc(i + 1) - s_cc(i)) + fd_coeff_s(1, i) = -fd_coeff_s(0, i) + end do +- + ! Computing the 2nd order finite-difference coefficients + elseif (fd_order_in == 2) then + do i = lB, lE +@@ -91,7 +90,6 @@ contains + fd_coeff_s(0, i) = 0d0 + fd_coeff_s(1, i) = -fd_coeff_s(-1, i) + end do +- + ! Computing the 4th order finite-difference coefficients + else + do i = lB, lE +@@ -101,7 +99,6 @@ contains + fd_coeff_s(1, i) = -fd_coeff_s(-1, i) + fd_coeff_s(2, i) = -fd_coeff_s(-2, i) + end do +- + end if + + end subroutine s_compute_finite_difference_coefficients +diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp +index f6372322..c13fa233 100644 +--- a/src/common/m_phase_change.fpp ++++ b/src/common/m_phase_change.fpp +@@ -1,11 +1,3 @@ +-!> +-!! @file m_phase_change.fpp +-!! @brief Contains module m_phasechange +- +-#:include 'macros.fpp' +- +-!> @brief This module is used to relax the model equations (6-eqn model) +-!> towards pressure and temperature (6-eqn to 4-eqn), and (if wanted) Gibbs free + !> energies (6-eqn to 4-eqn) equilibrium through an infinitely fast (algebraic) + !> procedure. + module m_phase_change +@@ -356,8 +348,9 @@ contains + + ! Newton Solver for the pT-equilibrium + ns = 0 +- ! change this relative error metric. 1E4 is just arbitrary +- do while ((DABS(pS - pO) > palpha_eps) .and. (DABS((pS - pO)/pO) > palpha_eps/1e4) .or. (ns == 0)) ++ ! change this relative error metric. 1E4 is arbitrary ++ do while ((DABS(pS - pO) > palpha_eps) .and. & ++ (DABS((pS - pO)/pO) > palpha_eps/1d4) .or. (ns == 0)) + + ! increasing counter + ns = ns + 1 +diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp +index 46436cb8..5652470a 100644 +--- a/src/common/m_variables_conversion.fpp ++++ b/src/common/m_variables_conversion.fpp +@@ -22,6 +22,7 @@ module m_variables_conversion + use m_helper_basic !< Functions to compare floating point numbers + + use m_helper ++ + ! ========================================================================== + + implicit none +@@ -145,8 +146,8 @@ contains + else + pres = (pref + pi_inf)* & + (energy/ & +- (rhoref*(1 - alf)) & +- )**(1/gamma + 1) - pi_inf ++ (rhoref*(1.d0 - alf)) & ++ )**(1.d0/gamma + 1.d0) - pi_inf + end if + + if (hypoelasticity .and. present(G)) then +@@ -164,11 +165,7 @@ contains + end if + end do + +- pres = ( & +- energy - & +- 0.5d0*(mom**2.d0)/rho - & +- pi_inf - qv - E_e & +- )/gamma ++ pres = (energy - 0.5d0*(mom**2.d0)/rho - pi_inf - qv - E_e)/gamma + + end if + +@@ -409,7 +406,6 @@ contains + pi_inf = pi_inf + alpha_K(i)*pi_infs(i) + qv = qv + alpha_rho_K(i)*qvs(i) + end do +- + #ifdef MFC_SIMULATION + ! Computing the shear and bulk Reynolds numbers from species analogs + do i = 1, 2 +@@ -427,6 +423,7 @@ contains + #endif + + if (present(G_K)) then ++ !TODO Check our mixture rule? Replace with Cauchy numbers, make code nondimensional + G_K = 0d0 + do i = 1, num_fluids + G_K = G_K + alpha_K(i)*G(i) +@@ -502,6 +499,7 @@ contains + G_K = 0d0 + do i = 1, num_fluids + !TODO: change to use Gs directly here? ++ !TODO: Make this changes as well for GPUs + G_K = G_K + alpha_K(i)*G(i) + end do + G_K = max(0d0, G_K) +@@ -679,7 +677,6 @@ contains + do i = 1, nb + bubrs(i) = bub_idx%rs(i) + end do +- + !$acc update device(bubrs) + end if + +@@ -862,7 +859,7 @@ contains + + integer :: i, j, k, l, q !< Generic loop iterators + +- real(kind(0.d0)) :: ntmp ++ real(kind(0d0)) :: ntmp + + #:if MFC_CASE_OPTIMIZATION + #ifndef MFC_SIMULATION +@@ -880,7 +877,7 @@ contains + end if + #:endif + +- !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp) ++ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe +@@ -900,7 +897,7 @@ contains + if (model_eqns /= 4) then + #ifdef MFC_SIMULATION + ! If in simulation, use acc mixture subroutines +- if (hypoelasticity) then ++ if (elasticity) then + call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & + alpha_rho_K, Re_K, j, k, l, G_K, Gs) + else if (bubbles) then +@@ -912,7 +909,7 @@ contains + end if + #else + ! If pre-processing, use non acc mixture subroutines +- if (hypoelasticity) then ++ if (elasticity) then + call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & + rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) + else +@@ -988,7 +985,7 @@ contains + qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & + /rho_K + ! subtracting elastic contribution for pressure calculation +- if (G_K > 1000) then !TODO: check if stable for >0 ++ if (G_K .gt. verysmall) then !TODO: check if stable for >0 + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K + ! extra terms in 2 and 3D +@@ -1002,6 +999,17 @@ contains + end do + end if + ++ if (hyperelasticity) then ++ !$acc loop seq ++ do i = strxb, strxe ++ qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K ++ end do ++ !$acc loop seq ++ do i = xibeg, xiend ++ qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K ++ end do ++ end if ++ + !$acc loop seq + do i = advxb, advxe + qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) +@@ -1016,7 +1024,9 @@ contains + end do + !$acc end parallel loop + +- end subroutine s_convert_conservative_to_primitive_variables ++ !print *, 'I got here AA' ++ ++ end subroutine s_convert_conservative_to_primitive_variables ! --------- + + !> The following procedure handles the conversion between + !! the primitive variables and the conservative variables. +@@ -1029,13 +1039,8 @@ contains + subroutine s_convert_primitive_to_conservative_variables(q_prim_vf, & + q_cons_vf) + +- type(scalar_field), & +- dimension(sys_size), & +- intent(in) :: q_prim_vf +- +- type(scalar_field), & +- dimension(sys_size), & +- intent(inout) :: q_cons_vf ++ type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf ++ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + + ! Density, specific heat ratio function, liquid stiffness function + ! and dynamic pressure, as defined in the incompressible flow sense, +@@ -1144,10 +1149,10 @@ contains + end if + + if (hypoelasticity) then +- do i = stress_idx%beg, stress_idx%end ++ do i = strxb, strxe + q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) + ! adding elastic contribution +- if (G > 1000) then ++ if (G .gt. verysmall) then + q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & + (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) + ! extra terms in 2 and 3D +@@ -1161,6 +1166,19 @@ contains + end do + end if + ++ ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 ++ if (hyperelasticity) then ++ ! adding the elastic contribution ++ ! Multiply \tau to \rho \tau ++ do i = strxb, strxe ++ q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) ++ end do ++ ! Multiply \xi to \rho \xi ++ do i = xibeg, xiend ++ q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) ++ end do ++ end if ++ + if (.not. f_is_default(sigma)) then + q_cons_vf(c_idx)%sf(j, k, l) = q_prim_vf(c_idx)%sf(j, k, l) + end if +@@ -1168,7 +1186,6 @@ contains + end do + end do + end do +- + #else + if (proc_rank == 0) then + call s_mpi_abort('Conversion from primitive to '// & +@@ -1176,7 +1193,6 @@ contains + 'implemented. Exiting ...') + end if + #endif +- + end subroutine s_convert_primitive_to_conservative_variables + + !> The following subroutine handles the conversion between +@@ -1252,7 +1268,7 @@ contains + end do + + pres_K = qK_prim_vf(j, k, l, E_idx) +- if (hypoelasticity) then ++ if (elasticity) then + call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, & + alpha_K, alpha_rho_K, Re_K, & + j, k, l, G_K, Gs) +@@ -1310,10 +1326,11 @@ contains + end do + end do + #endif +- + end subroutine s_convert_primitive_to_flux_variables + +- subroutine s_finalize_variables_conversion_module ++ subroutine s_finalize_variables_conversion_module() ! ------------------ ++ ++ integer :: i !< Generic loop iterators + + ! Deallocating the density, the specific heat ratio function and the + ! liquid stiffness function +diff --git a/src/post_process/m_data_input.f90 b/src/post_process/m_data_input.f90 +index 567816f7..bbd063df 100644 +--- a/src/post_process/m_data_input.f90 ++++ b/src/post_process/m_data_input.f90 +@@ -370,7 +370,7 @@ contains + NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) + + ! Read the data for each variable +- if (bubbles .or. hypoelasticity) then ++ if (bubbles .or. elasticity) then + do i = 1, sys_size + var_MOK = int(i, MPI_OFFSET_KIND) + +@@ -444,7 +444,7 @@ contains + NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) + + ! Read the data for each variable +- if (bubbles .or. hypoelasticity) then ++ if (bubbles .or. elasticity) then + do i = 1, sys_size + var_MOK = int(i, MPI_OFFSET_KIND) + +diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp +index 7aa7e873..e68c021b 100644 +--- a/src/post_process/m_data_output.fpp ++++ b/src/post_process/m_data_output.fpp +@@ -16,6 +16,8 @@ module m_data_output + + use m_global_parameters ! Global parameters for the code + ++ use m_derived_variables !< Procedures used to compute quantities derived ++ + use m_mpi_proxy ! Message passing interface (MPI) module proxy + + use m_compile_specific +@@ -27,9 +29,15 @@ module m_data_output + + private; public :: s_initialize_data_output_module, & + s_open_formatted_database_file, & ++ s_open_intf_data_file, & ++ s_open_energy_data_file, & + s_write_grid_to_formatted_database_file, & + s_write_variable_to_formatted_database_file, & ++ s_write_intf_data_file, & ++ s_write_energy_data_file, & + s_close_formatted_database_file, & ++ s_close_intf_data_file, & ++ s_close_energy_data_file, & + s_finalize_data_output_module + + ! Including the Silo Fortran interface library that features the subroutines +@@ -531,7 +539,40 @@ contains + + end subroutine s_open_formatted_database_file + +- subroutine s_write_grid_to_formatted_database_file(t_step) ++ subroutine s_open_intf_data_file() ! ------------------------ ++ ++ character(LEN=path_len + 3*name_len) :: file_path !< ++ !! Relative path to a file in the case directory ++ ++ write (file_path, '(A)') '/intf_data.dat' ++ file_path = trim(case_dir)//trim(file_path) ++ ++ ! Opening the simulation data file ++ open (211, FILE=trim(file_path), & ++ FORM='formatted', & ++ POSITION='append', & ++ STATUS='unknown') ++ ++ end subroutine s_open_intf_data_file ! --------------------------------------- ++ ++ subroutine s_open_energy_data_file() ! ------------------------ ++ ++ character(LEN=path_len + 3*name_len) :: file_path !< ++ !! Relative path to a file in the case directory ++ ++ write (file_path, '(A)') '/eng_data.dat' ++ file_path = trim(case_dir)//trim(file_path) ++ ++ ! Opening the simulation data file ++ open (251, FILE=trim(file_path), & ++ FORM='formatted', & ++ POSITION='append', & ++ STATUS='unknown') ++ ++ end subroutine s_open_energy_data_file ! ---------------------------------------- ++ ++ subroutine s_write_grid_to_formatted_database_file(t_step) ! ----------- ++ + ! Description: The general objective of this subroutine is to write the + ! necessary grid data to the formatted database file, for + ! the current time-step, t_step. The local processor will +@@ -939,7 +980,196 @@ contains + + end subroutine s_write_variable_to_formatted_database_file + +- subroutine s_close_formatted_database_file ++ subroutine s_write_intf_data_file(q_prim_vf) ++ ++ type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf ++ integer :: i, j, k, l, w, cent !< Generic loop iterators ++ integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations ++ real(kind(0d0)), dimension(num_fluids) :: alpha, vol_fluid, xcom, ycom, zcom ++ real(kind=8), parameter :: pi = 4.d0*datan(1.d0) ++ real(kind(0d0)), allocatable :: x_td(:), y_td(:), x_d1(:), y_d1(:), y_d(:), x_d(:) ++ real(kind(0d0)) :: axp, axm, ayp, aym, azm, azp, tgp, euc_d, thres, maxalph_loc, maxalph_glb ++ ++ allocate (x_d1(m*n)) ++ allocate (y_d1(m*n)) ++ counter = 0 ++ maxalph_loc = 0d0 ++ do k = 0, p ++ do j = 0, n ++ do i = 0, m ++ if (q_prim_vf(E_idx + 2)%sf(i, j, k) > maxalph_loc) then ++ maxalph_loc = q_prim_vf(E_idx + 2)%sf(i, j, k) ++ end if ++ end do ++ end do ++ end do ++ ++ call s_mpi_allreduce_max(maxalph_loc, maxalph_glb) ++ if (p > 0) then ++ do l = 0, p ++ if (z_cc(l) < dz(l) .and. z_cc(l) > 0) then ++ cent = l ++ end if ++ end do ++ else ++ cent = 0 ++ end if ++ ++ thres = 0.9d0*maxalph_glb ++ do k = 0, n ++ OLoop: do j = 0, m ++ axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) ++ axm = q_prim_vf(E_idx + 2)%sf(j, k, cent) ++ ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, cent) ++ aym = q_prim_vf(E_idx + 2)%sf(j, k, cent) ++ if ((axp > thres .and. axm < thres) .or. (axp < thres .and. axm > thres) & ++ .or. (ayp > thres .and. aym < thres) .or. (ayp < thres .and. aym > thres)) then ++ if (counter == 0) then ++ counter = counter + 1 ++ x_d1(counter) = x_cc(j) ++ y_d1(counter) = y_cc(k) ++ euc_d = sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2) ++ tgp = sqrt(dx(j)**2 + dy(k)**2) ++ else ++ euc_d = dsqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2) ++ tgp = dsqrt(dx(j)**2 + dy(k)**2) ++ do i = 1, counter ++ if (euc_d < tgp) then ++ cycle OLoop ++ elseif (euc_d > tgp .and. i == counter) then ++ counter = counter + 1 ++ x_d1(counter) = x_cc(j) ++ y_d1(counter) = y_cc(k) ++ ++ end if ++ end do ++ end if ++ end if ++ end do OLoop ++ end do ++ ++ allocate (y_d(counter)) ++ allocate (x_d(counter)) ++ do i = 1, counter ++ y_d(i) = y_d1(i) ++ x_d(i) = x_d1(i) ++ end do ++ root = 0 ++ ++ call s_mpi_gather_data(x_d, counter, x_td, root) ++ call s_mpi_gather_data(y_d, counter, y_td, root) ++ if (proc_rank == 0) then ++ do i = 1, size(x_td) ++ if (i == size(x_td)) then ++ write (211, '(F12.9,1X,F12.9,1X,I4)') & ++ x_td(i), y_td(i), size(x_td) ++ else ++ write (211, '(F12.9,1X,F12.9,1X,F3.1)') & ++ x_td(i), y_td(i), 0d0 ++ end if ++ end do ++ end if ++ ++ end subroutine s_write_intf_data_file ! ----------------------------------- ++ ++ subroutine s_write_energy_data_file(q_prim_vf, q_cons_vf) ++ type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf, q_cons_vf ++ real(kind(0d0)) :: Elk, Egk, Elp, Egint, Vb, Vl, pres_av, Et ++ real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, MaxMa, MaxMa_glb, maxvel, c, Ma, H ++ real(kind(0d0)), dimension(num_dims) :: vel ++ real(kind(0d0)), dimension(num_fluids) :: gammas, pi_infs, adv ++ integer :: i, j, k, l, s !looping indicies ++ integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations ++ ++ Egk = 0d0 ++ Elp = 0d0 ++ Egint = 0d0 ++ Vb = 0d0 ++ maxvel = 0d0 ++ MaxMa = 0d0 ++ Vl = 0d0 ++ Elk = 0d0 ++ Et = 0d0 ++ Vb = 0d0 ++ dV = 0d0 ++ pres_av = 0d0 ++ pres = 0d0 ++ do k = 0, p ++ do j = 0, n ++ do i = 0, m ++ pres = 0d0 ++ dV = dx(i)*dy(j)*dz(k) ++ rho = 0d0 ++ gamma = 0d0 ++ pi_inf = 0d0 ++ pres = q_prim_vf(E_idx)%sf(i, j, k) ++ Egint = Egint + q_prim_vf(E_idx + 2)%sf(i, j, k)*(fluid_pp(2)%gamma*pres)*dV ++ do s = 1, num_dims ++ vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) ++ Egk = Egk + 0.5d0*q_prim_vf(E_idx + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV ++ Elk = Elk + 0.5d0*q_prim_vf(E_idx + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV ++ if (dabs(vel(s)) > maxvel) then ++ maxvel = dabs(vel(s)) ++ end if ++ end do ++ do l = 1, adv_idx%end - E_idx ++ adv(l) = q_prim_vf(E_idx + l)%sf(i, j, k) ++ gamma = gamma + adv(l)*fluid_pp(l)%gamma ++ pi_inf = pi_inf + adv(l)*fluid_pp(l)%pi_inf ++ rho = rho + adv(l)*q_prim_vf(l)%sf(i, j, k) ++ end do ++ ++ H = ((gamma + 1d0)*pres + pi_inf)/rho ++ ++ call s_compute_speed_of_sound(pres, rho, & ++ gamma, pi_inf, & ++ H, adv, 0d0, c) ++ ++ Ma = maxvel/c ++ if (Ma > MaxMa .and. adv(1) > 1.0d0 - 1.0d-10) then ++ MaxMa = Ma ++ end if ++ Vl = Vl + adv(1)*dV ++ Vb = Vb + adv(2)*dV ++ pres_av = pres_av + adv(1)*pres*dV ++ Et = Et + q_cons_vf(E_idx)%sf(i, j, k)*dV ++ end do ++ end do ++ end do ++ ++ tmp = pres_av ++ call s_mpi_allreduce_sum(tmp, pres_av) ++ tmp = Vl ++ call s_mpi_allreduce_sum(tmp, Vl) ++ ++ call s_mpi_allreduce_max(MaxMa, MaxMa_glb) ++ tmp = Elk ++ call s_mpi_allreduce_sum(tmp, Elk) ++ tmp = Egint ++ call s_mpi_allreduce_sum(tmp, Egint) ++ tmp = Egk ++ call s_mpi_allreduce_sum(tmp, Egk) ++ tmp = Vb ++ call s_mpi_allreduce_sum(tmp, Vb) ++ tmp = Et ++ call s_mpi_allreduce_sum(tmp, Et) ++ ++ Elp = pres_av/Vl*Vb ++ if (proc_rank == 0) then ++ write (251, '(10X, 8F24.8)') & ++ Elp, & ++ Egint, & ++ Elk, & ++ Egk, & ++ Et, & ++ Vb, & ++ Vl, & ++ MaxMa_glb ++ end if ++ ++ end subroutine s_write_energy_data_file ++ ++ subroutine s_close_formatted_database_file() ! ------------------------- + ! Description: The purpose of this subroutine is to close any formatted + ! database file(s) that may be opened at the time-step that + ! is currently being post-processed. The root process must +@@ -966,7 +1196,19 @@ contains + + end subroutine s_close_formatted_database_file + +- subroutine s_finalize_data_output_module ++ subroutine s_close_intf_data_file() ! ----------------------- ++ ++ close (211) ++ ++ end subroutine s_close_intf_data_file !--------------------- ++ ++ subroutine s_close_energy_data_file() ! ----------------------- ++ ++ close (251) ++ ++ end subroutine s_close_energy_data_file !--------------------- ++ ++ subroutine s_finalize_data_output_module() ! ------------------------- + ! Description: Deallocation procedures for the module + + ! Deallocating the generic storage employed for the flow variable(s) +diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp +index 0e5401f1..fa6941cb 100644 +--- a/src/post_process/m_global_parameters.fpp ++++ b/src/post_process/m_global_parameters.fpp +@@ -94,6 +94,10 @@ module m_global_parameters + logical :: mixture_err !< Mixture error limiter + logical :: alt_soundspeed !< Alternate sound speed + logical :: hypoelasticity !< Turn hypoelasticity on ++ logical :: hyperelasticity !< Turn hyperelasticity on ++ logical :: elasticity !< elasticity modeling, true for hyper or hypo ++ integer :: b_size !< Number of components in the b tensor ++ integer :: tensor_size !< Number of components in the nonsymmetric tensor + !> @} + + !> @name Annotations of the structure, i.e. the organization, of the state vectors +@@ -109,6 +113,7 @@ module m_global_parameters + integer :: alf_idx !< Index of specific heat ratio func. eqn. + integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. + type(int_bounds_info) :: stress_idx !< Indices of elastic stresses ++ type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. + integer :: c_idx !< Index of color function + !> @} + +@@ -118,6 +123,7 @@ module m_global_parameters + !> @} + + logical :: parallel_io !< Format of the data files ++ logical :: sim_data + logical :: file_per_process !< output format + + integer, allocatable, dimension(:) :: proc_coords !< +@@ -255,6 +261,7 @@ module m_global_parameters + integer :: intxb, intxe + integer :: bubxb, bubxe + integer :: strxb, strxe ++ integer :: xibeg, xiend + !> @} + + contains +@@ -286,7 +293,10 @@ contains + alt_soundspeed = .false. + relax = .false. + relax_model = dflt_int ++ + hypoelasticity = .false. ++ hyperelasticity = .false. ++ elasticity = .false. + + bc_x%beg = dflt_int; bc_x%end = dflt_int + bc_y%beg = dflt_int; bc_y%end = dflt_int +@@ -335,6 +345,7 @@ contains + omega_wrt = .false. + qm_wrt = .false. + schlieren_wrt = .false. ++ sim_data = .false. + cf_wrt = .false. + ib = .false. + +@@ -486,12 +497,24 @@ contains + + end if + +- if (hypoelasticity) then ++ if (hypoelasticity .or. hyperelasticity) then ++ elasticity = .true. + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ++ ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end + end if + ++ if (hyperelasticity) then ++ xi_idx%beg = sys_size + 1 ++ xi_idx%end = sys_size + num_dims ++ ! adding three more equations for the \xi field and the elastic energy ++ sys_size = xi_idx%end + 1 ++ ! number of entries in the symmetric btensor plus the jacobian ++ b_size = (num_dims*(num_dims + 1))/2 + 1 ++ tensor_size = num_dims**2 + 1 ++ end if ++ + if (.not. f_is_default(sigma)) then + c_idx = sys_size + 1 + sys_size = c_idx +@@ -517,6 +540,24 @@ contains + sys_size = internalEnergies_idx%end + alf_idx = 1 ! dummy, cannot actually have a void fraction + ++ if (hypoelasticity .or. hyperelasticity) then ++ elasticity = .true. ++ stress_idx%beg = sys_size + 1 ++ stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ++ ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D ++ sys_size = stress_idx%end ++ end if ++ ++ if (hyperelasticity) then ++ xi_idx%beg = sys_size + 1 ++ xi_idx%end = sys_size + num_dims ++ ! adding three more equations for the \xi field and the elastic energy ++ sys_size = xi_idx%end + 1 ++ ! number of entries in the symmetric btensor plus the jacobian ++ b_size = (num_dims*(num_dims + 1))/2 + 1 ++ tensor_size = num_dims**2 + 1 ++ end if ++ + if (.not. f_is_default(sigma)) then + c_idx = sys_size + 1 + sys_size = c_idx +@@ -590,6 +631,8 @@ contains + strxe = stress_idx%end + intxb = internalEnergies_idx%beg + intxe = internalEnergies_idx%end ++ xibeg = xi_idx%beg ++ xiend = xi_idx%end + ! ================================================================== + + #ifdef MFC_MPI +diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp +index a5dffdb4..5da4c74e 100644 +--- a/src/post_process/m_mpi_proxy.fpp ++++ b/src/post_process/m_mpi_proxy.fpp +@@ -141,6 +141,38 @@ contains + + end subroutine s_initialize_mpi_proxy_module + ++ subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root) ++ ++#ifdef MFC_MPI ++ ++ implicit none ++ integer, intent(in) :: counts ! Array of vector lengths for each process ++ real(kind(0d0)), intent(in), dimension(counts) :: my_vector ! Input vector on each process ++ integer, intent(in) :: root ! Rank of the root process ++ real(kind(0d0)), allocatable, intent(out) :: gathered_vector(:) ! Gathered vector on the root process ++ ++ integer :: i, offset, ierr ++ integer, allocatable :: recounts(:), displs(:) ++ ++ allocate (recounts(num_procs)) ++ ++ call MPI_GATHER(counts, 1, MPI_INTEGER, recounts, 1, MPI_INTEGER, root, & ++ MPI_COMM_WORLD, ierr) ++ ++ allocate (displs(size(recounts))) ++ ++ displs(1) = 0 ++ ++ do i = 2, size(recounts) ++ displs(i) = displs(i - 1) + recounts(i - 1) ++ end do ++ ++ allocate (gathered_vector(sum(recounts))) ++ call MPI_GATHERV(my_vector, counts, MPI_DOUBLE_PRECISION, gathered_vector, recounts, displs, MPI_DOUBLE_PRECISION, & ++ root, MPI_COMM_WORLD, ierr) ++#endif ++ end subroutine s_mpi_gather_data ++ + !> Since only processor with rank 0 is in charge of reading + !! and checking the consistency of the user provided inputs, + !! these are not available to the remaining processors. This +@@ -164,11 +196,11 @@ contains + + #:for VAR in [ 'cyl_coord', 'mpp_lim', 'mixture_err', & + & 'alt_soundspeed', 'hypoelasticity', 'parallel_io', 'rho_wrt', & +- & 'E_wrt', 'pres_wrt', 'gamma_wrt', & ++ & 'E_wrt', 'pres_wrt', 'gamma_wrt', 'sim_data', & + & 'heat_ratio_wrt', 'pi_inf_wrt', 'pres_inf_wrt', 'cons_vars_wrt', & + & 'prim_vars_wrt', 'c_wrt', 'qm_wrt','schlieren_wrt', 'bubbles', 'qbmm', & + & 'polytropic', 'polydisperse', 'file_per_process', 'relax', 'cf_wrt', & +- & 'adv_n', 'ib' ] ++ & 'adv_n', 'ib', 'hyperelasticity' ] + call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) + #:endfor + +diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 +index ed1003ff..60d3d094 100644 +--- a/src/post_process/m_start_up.f90 ++++ b/src/post_process/m_start_up.f90 +@@ -74,7 +74,8 @@ contains + parallel_io, rhoref, pref, bubbles, qbmm, sigR, & + R0ref, nb, polytropic, thermal, Ca, Web, Re_inv, & + polydisperse, poly_sigma, file_per_process, relax, & +- relax_model, cf_wrt, sigma, adv_n, ib ++ relax_model, cf_wrt, sigma, adv_n, ib, sim_data, & ++ hyperelasticity + + ! Inquiring the status of the post_process.inp file + file_loc = 'post_process.inp' +@@ -148,9 +149,9 @@ contains + (t_step_stop - t_step_start)/t_step_save + 1, & + t_step + end if +- + ! Populating the grid and conservative variables + call s_read_data_files(t_step) ++ + ! Populating the buffer regions of the grid variables + if (buff_size > 0) then + call s_populate_grid_variables_buffer_regions() +@@ -163,6 +164,7 @@ contains + + ! Converting the conservative variables to the primitive ones + call s_convert_conservative_to_primitive_variables(q_cons_vf, q_prim_vf) ++ + end subroutine s_perform_time_step + + subroutine s_save_data(t_step, varname, pres, c, H) +@@ -176,6 +178,16 @@ contains + ! Opening a new formatted database file + call s_open_formatted_database_file(t_step) + ++ if (sim_data .and. proc_rank == 0) then ++ call s_open_intf_data_file() ++ call s_open_energy_data_file() ++ end if ++ ++ if (sim_data) then ++ call s_write_intf_data_file(q_prim_vf) ++ call s_write_energy_data_file(q_prim_vf, q_cons_vf) ++ end if ++ + ! Adding the grid to the formatted database file + call s_write_grid_to_formatted_database_file(t_step) + +@@ -304,22 +316,34 @@ contains + + end if + ! ---------------------------------------------------------------------- +- + ! Adding the elastic shear stresses to the formatted database file ----- +- if (hypoelasticity) then ++ if (elasticity) then + do i = 1, stress_idx%end - stress_idx%beg + 1 + if (prim_vars_wrt) then + q_sf = q_prim_vf(i - 1 + stress_idx%beg)%sf( & + -offset_x%beg:m + offset_x%end, & + -offset_y%beg:n + offset_y%end, & + -offset_z%beg:p + offset_z%end) +- + write (varname, '(A,I0)') 'tau', i + call s_write_variable_to_formatted_database_file(varname, t_step) + end if + varname(:) = ' ' + end do + end if ++ if (hyperelasticity) then ++ do i = 1, xiend - xibeg + 1 ++ if (prim_vars_wrt) then ++ q_sf = q_prim_vf(i - 1 + xibeg)%sf( & ++ -offset_x%beg:m + offset_x%end, & ++ -offset_y%beg:n + offset_y%end, & ++ -offset_z%beg:p + offset_z%end) ++ write (varname, '(A,I0)') 'xi', i ++ call s_write_variable_to_formatted_database_file(varname, t_step) ++ end if ++ varname(:) = ' ' ++ end do ++ end if ++ + ! ---------------------------------------------------------------------- + + ! Adding the pressure to the formatted database file ------------------- +@@ -625,8 +649,19 @@ contains + end if + end if + ++! if (proc_rank == 0 .and. sim_data) then ++! close (211) ++! close (251) ++! end if ++ ++ if (sim_data .and. proc_rank == 0) then ++ call s_close_intf_data_file() ++ call s_close_energy_data_file() ++ end if ++ + ! Closing the formatted database file + call s_close_formatted_database_file() ++ + end subroutine s_save_data + + subroutine s_initialize_modules +@@ -682,6 +717,11 @@ contains + ! Disassociate pointers for serial and parallel I/O + s_read_data_files => null() + ++! if (sim_data .and. proc_rank == 0) then ++! call s_close_intf_data_file() ++! call s_close_energy_data_file() ++! end if ++ + ! Deallocation procedures for the modules + call s_finalize_data_output_module() + call s_finalize_derived_variables_module() +diff --git a/src/post_process/p_main.fpp b/src/post_process/p_main.fpp +index c780ce9a..ede32ed7 100644 +--- a/src/post_process/p_main.fpp ++++ b/src/post_process/p_main.fpp +@@ -39,6 +39,7 @@ program p_main + + ! Time-Marching Loop ======================================================= + do ++ + call s_perform_time_step(t_step) + + call s_save_data(t_step, varname, pres, c, H) +diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp +index 7d6ee960..394f560b 100644 +--- a/src/pre_process/include/2dHardcodedIC.fpp ++++ b/src/pre_process/include/2dHardcodedIC.fpp +@@ -2,8 +2,7 @@ + + real(kind(0d0)) :: eps + real(kind(0d0)) :: r, rmax, gam, umax, p0 +- +- real(kind(0d0)) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph ++ real(kind(0d0)) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph + + eps = 1e-9 + +@@ -12,6 +11,7 @@ + #:def Hardcoded2D() + + select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case ++ + case (200) + if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1d0/3d0)) then + ! Volume Fractions +@@ -68,7 +68,7 @@ + + q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(E_idx)%sf(i, j, 0)**(1d0/gam) + +- case (204) ! Rayleigh-Taylor instability ++ case (204) ! Rayleigh-taylor problem + rhoH = 3 + rhoL = 1 + pRef = 1e5 +@@ -100,11 +100,42 @@ + q_prim_vf(E_idx)%sf(i, j, 0) = pInt + rhoL*9.81*(intH - y_cc(j)) + end if + ++ case (205) ! 2D lung wave interaction problem ++ h = 0.0 !non dim origin y ++ lam = 1.0 !non dim lambda ++ amp = patch_icpp(patch_id)%a2 !to be changed later! !non dim amplitude ++ ++ intH = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h ++ ++ if (y_cc(j) > intH) then ++ q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) ++ q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) ++ q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres ++ q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) ++ q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) ++ end if ++ ++ case (206) ! 2D lung wave interaction problem - horizontal domain ++ h = 0.0 !non dim origin y ++ lam = 1.0 !non dim lambda ++ amp = patch_icpp(patch_id)%a2 ++ ++ intL = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h ++ ++ if (x_cc(i) > intL) then !this is the liquid ++ q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) ++ q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) ++ q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres ++ q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) ++ q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) ++ end if ++ + case default + if (proc_rank == 0) then + call s_int_to_str(patch_id, iStr) + call s_mpi_abort("Invalid hcid specified for patch "//trim(iStr)) + end if ++ + end select + + #:enddef +diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp +index 3d9a4e2f..4088fcc2 100644 +--- a/src/pre_process/include/3dHardcodedIC.fpp ++++ b/src/pre_process/include/3dHardcodedIC.fpp +@@ -42,7 +42,20 @@ + pInt = pref + rhoH*9.81*(1.2 - intH) + q_prim_vf(E_idx)%sf(i, j, k) = pInt + rhoL*9.81*(intH - y_cc(j)) + end if +- ++ ++ case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|) ++ h = 0.0 ++ lam = 1.0 ++ amp = patch_icpp(patch_id)%a2 ++ intH = amp*ABS((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h) ++ if (x_cc(i) > intH) then ++ q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1) ++ q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2) ++ q_prim_vf(E_idx)%sf(i, j, k) = patch_icpp(1)%pres ++ q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1) ++ q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2) ++ end if ++ + ! Put your variable assignments here + case default + call s_int_to_str(patch_id, iStr) +diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 +index 9ff468a3..4a49c46a 100644 +--- a/src/pre_process/m_assign_variables.f90 ++++ b/src/pre_process/m_assign_variables.f90 +@@ -276,6 +276,8 @@ contains + real(kind(0d0)) :: orig_qv + real(kind(0d0)) :: muR, muV + real(kind(0d0)) :: R3bar ++ real(kind(0d0)) :: rcoord, theta, phi, xi_sph ++ real(kind(0d0)), dimension(3) :: xi_cart + + real(kind(0d0)), dimension(int(E_idx - mom_idx%beg)) :: vel !< velocity + real(kind(0d0)) :: pres !< pressure +@@ -448,7 +450,7 @@ contains + end do + + ! Elastic Shear Stress +- if (hypoelasticity) then ++ if (elasticity) then + do i = 1, (stress_idx%end - stress_idx%beg) + 1 + q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = & + (eta*patch_icpp(patch_id)%tau_e(i) & +@@ -456,6 +458,32 @@ contains + end do + end if + ++ ! Elastic Shear Stress ++ if (hyperelasticity) then ++ ++ if (pre_stress) then ! pre stressed initial condition in spatial domain ++ rcoord = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2)) ++ theta = atan2(y_cc(k), x_cc(j)) ++ phi = atan2(sqrt(x_cc(j)**2 + y_cc(k)**2), z_cc(l)) ++ !spherical coord, assuming Rmax=1 ++ xi_sph = (rcoord**3 - R0ref**3 + 1d0)**(1d0/3d0) ++ xi_cart(1) = xi_sph*sin(phi)*cos(theta) ++ xi_cart(2) = xi_sph*sin(phi)*sin(theta) ++ xi_cart(3) = xi_sph*cos(phi) ++ else ++ xi_cart(1) = x_cc(j) ++ xi_cart(2) = y_cc(k) ++ xi_cart(3) = z_cc(l) ++ end if ++ ++ ! assigning the reference map to the q_prim vector field ++ do i = 1, num_dims ++ q_prim_vf(i + xibeg - 1)%sf(j, k, l) = eta*xi_cart(i) + & ++ (1d0 - eta)*orig_prim_vf(i + xibeg - 1) ++ end do ++ ++ end if ++ + if (mpp_lim .and. bubbles) then + !adjust volume fractions, according to modeled gas void fraction + alf_sum%sf = 0d0 +diff --git a/src/pre_process/m_check_patches.fpp b/src/pre_process/m_check_patches.fpp +index 4579f5bd..bda4418e 100644 +--- a/src/pre_process/m_check_patches.fpp ++++ b/src/pre_process/m_check_patches.fpp +@@ -119,7 +119,8 @@ contains + patch_icpp(i)%geometry == 9 .or. & + patch_icpp(i)%geometry == 10 .or. & + patch_icpp(i)%geometry == 11 .or. & +- patch_icpp(i)%geometry == 12)) then ++ patch_icpp(i)%geometry == 12 .or. & ++ patch_icpp(i)%geometry == 14)) then + call s_check_supported_patch_smoothing(i) + else + call s_check_unsupported_patch_smoothing(i) +diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp +index 94d5d8fb..c0049095 100644 +--- a/src/pre_process/m_data_output.fpp ++++ b/src/pre_process/m_data_output.fpp +@@ -638,6 +638,7 @@ contains + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & + MPI_DOUBLE_PRECISION, status, ierr) + end do ++ + end if + + call MPI_FILE_CLOSE(ifile, ierr) +diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp +index 57dcda37..78e8c293 100644 +--- a/src/pre_process/m_global_parameters.fpp ++++ b/src/pre_process/m_global_parameters.fpp +@@ -20,11 +20,11 @@ module m_global_parameters + implicit none + + ! Logistics ================================================================ +- integer :: num_procs !< Number of processors +- character(LEN=path_len) :: case_dir !< Case folder location +- logical :: old_grid !< Use existing grid data +- logical :: old_ic !< Use existing IC data +- integer :: t_step_old, t_step_start !< Existing IC/grid folder ++ integer :: num_procs !< Number of processors ++ character(LEN=path_len) :: case_dir !< Case folder location ++ logical :: old_grid !< Use existing grid data ++ logical :: old_ic, non_axis_sym !< Use existing IC data ++ integer :: t_step_old, t_step_start !< Existing IC/grid folder + ! ========================================================================== + + ! Computational Domain Parameters ========================================== +@@ -72,16 +72,21 @@ module m_global_parameters + ! ========================================================================== + + ! Simulation Algorithm Parameters ========================================== +- integer :: model_eqns !< Multicomponent flow model +- logical :: relax !< activate phase change +- integer :: relax_model !< Relax Model +- real(kind(0d0)) :: palpha_eps !< trigger parameter for the p relaxation procedure, phase change model +- real(kind(0d0)) :: ptgalpha_eps !< trigger parameter for the pTg relaxation procedure, phase change model +- integer :: num_fluids !< Number of different fluids present in the flow +- logical :: mpp_lim !< Alpha limiter +- integer :: sys_size !< Number of unknowns in the system of equations +- integer :: weno_order !< Order of accuracy for the WENO reconstruction +- logical :: hypoelasticity !< activate hypoelasticity ++ integer :: model_eqns !< Multicomponent flow model ++ logical :: relax !< activate phase change ++ integer :: relax_model !< Relax Model ++ real(kind(0d0)) :: palpha_eps !< trigger parameter for the p relaxation procedure, phase change model ++ real(kind(0d0)) :: ptgalpha_eps !< trigger parameter for the pTg relaxation procedure, phase change model ++ integer :: num_fluids !< Number of different fluids present in the flow ++ logical :: mpp_lim !< Alpha limiter ++ integer :: sys_size !< Number of unknowns in the system of equations ++ integer :: weno_order !< Order of accuracy for the WENO reconstruction ++ logical :: hypoelasticity !< activate hypoelasticity ++ logical :: hyperelasticity !< activate hyperelasticity ++ logical :: elasticity !< elasticity modeling, true for hyper or hypo ++ integer :: b_size !< Number of components in the b tensor ++ integer :: tensor_size !< Number of components in the nonsymmetric tensor ++ logical :: pre_stress !< activate pre_stressed domain + + ! Annotations of the structure, i.e. the organization, of the state vectors + type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. +@@ -95,6 +100,7 @@ module m_global_parameters + integer :: gamma_idx !< Index of specific heat ratio func. eqn. + integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. + type(int_bounds_info) :: stress_idx !< Indexes of elastic shear stress eqns. ++ type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. + integer :: c_idx !< Index of the color function + + type(int_bounds_info) :: bc_x, bc_y, bc_z !< +@@ -216,6 +222,7 @@ module m_global_parameters + integer :: intxb, intxe + integer :: bubxb, bubxe + integer :: strxb, strxe ++ integer :: xibeg, xiend + !> @} + + integer, allocatable, dimension(:, :, :) :: logic_grid +@@ -278,6 +285,9 @@ contains + weno_order = dflt_int + + hypoelasticity = .false. ++ hyperelasticity = .false. ++ elasticity = .false. ++ pre_stress = .false. + + bc_x%beg = dflt_int; bc_x%end = dflt_int + bc_y%beg = dflt_int; bc_y%end = dflt_int +@@ -339,6 +349,18 @@ contains + patch_icpp(i)%qv = 0d0 + patch_icpp(i)%qvp = 0d0 + patch_icpp(i)%tau_e = 0d0 ++ patch_icpp(i)%a2 = dflt_real ++ patch_icpp(i)%a3 = dflt_real ++ patch_icpp(i)%a4 = dflt_real ++ patch_icpp(i)%a5 = dflt_real ++ patch_icpp(i)%a6 = dflt_real ++ patch_icpp(i)%a8 = dflt_real ++ patch_icpp(i)%a9 = dflt_real ++ patch_icpp(i)%a10 = dflt_real ++ patch_icpp(i)%a11 = dflt_real ++ patch_icpp(i)%a12 = dflt_real ++ patch_icpp(i)%non_axis_sym = .false. ++ + !should get all of r0's and v0's + patch_icpp(i)%r0 = dflt_real + patch_icpp(i)%v0 = dflt_real +@@ -574,13 +596,24 @@ contains + end if + end if + +- if (hypoelasticity) then ++ if (hypoelasticity .or. hyperelasticity) then ++ elasticity = .true. + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end + end if + ++ if (hyperelasticity) then ++ ! number of entries in the symmetric btensor plus the jacobian ++ b_size = (num_dims*(num_dims + 1))/2 + 1 ++ tensor_size = num_dims**2 + 1 ++ xi_idx%beg = sys_size + 1 ++ xi_idx%end = sys_size + num_dims ++ ! adding three more equations for the \xi field and the elastic energy ++ sys_size = xi_idx%end + 1 ++ end if ++ + if (.not. f_is_default(sigma)) then + c_idx = sys_size + 1 + sys_size = c_idx +@@ -605,6 +638,24 @@ contains + internalEnergies_idx%end = adv_idx%end + num_fluids + sys_size = internalEnergies_idx%end + ++ if (hypoelasticity .or. hyperelasticity) then ++ elasticity = .true. ++ stress_idx%beg = sys_size + 1 ++ stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ++ ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D ++ sys_size = stress_idx%end ++ end if ++ ++ if (hyperelasticity) then ++ ! number of entries in the symmetric btensor plus the jacobian ++ b_size = (num_dims*(num_dims + 1))/2 + 1 ++ tensor_size = num_dims**2 + 1 ++ xi_idx%beg = sys_size + 1 ++ xi_idx%end = sys_size + num_dims ++ ! adding three more equations for the \xi field and the elastic energy ++ sys_size = xi_idx%end + 1 ++ end if ++ + if (.not. f_is_default(sigma)) then + c_idx = sys_size + 1 + sys_size = c_idx +@@ -681,6 +732,8 @@ contains + strxe = stress_idx%end + intxb = internalEnergies_idx%beg + intxe = internalEnergies_idx%end ++ xibeg = xi_idx%beg ++ xiend = xi_idx%end + + ! ================================================================== + +diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp +index 5d58d46e..869194b5 100644 +--- a/src/pre_process/m_initial_condition.fpp ++++ b/src/pre_process/m_initial_condition.fpp +@@ -238,6 +238,10 @@ contains + elseif (patch_icpp(i)%geometry == 7) then + call s_2D_analytical(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) ++ + ! Spiral patch + elseif (patch_icpp(i)%geometry == 17) then + call s_spiral(i, patch_id_fp, q_prim_vf) +@@ -311,8 +315,7 @@ contains + if (instability_wave) call s_superposition_instability_wave() + + ! Converting the primitive variables to the conservative ones +- call s_convert_primitive_to_conservative_variables(q_prim_vf, & +- q_cons_vf) ++ call s_convert_primitive_to_conservative_variables(q_prim_vf, q_cons_vf) + + if (qbmm .and. .not. polytropic) then + !Initialize pb and mv +diff --git a/src/pre_process/m_mpi_proxy.fpp b/src/pre_process/m_mpi_proxy.fpp +index 257f7fb3..6b04bf0f 100644 +--- a/src/pre_process/m_mpi_proxy.fpp ++++ b/src/pre_process/m_mpi_proxy.fpp +@@ -55,7 +55,7 @@ contains + & 'cyl_coord','mpp_lim','hypoelasticity', 'relax', & + & 'parallel_io', 'perturb_flow', 'vel_profile', 'instability_wave',& + & 'perturb_sph', 'bubbles', 'polytropic', 'polydisperse', 'qbmm', & +- & 'file_per_process', 'adv_n', 'ib' ] ++ & 'file_per_process', 'adv_n', 'ib', 'hyperelasticity','pre_stress'] + call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) + #:endfor + call MPI_BCAST(fluid_rho(1), num_fluids_max, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) +@@ -76,6 +76,7 @@ contains + #:endfor + + call MPI_BCAST(patch_icpp(i)%smoothen, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) ++ call MPI_BCAST(patch_icpp(i)%non_axis_sym, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(patch_icpp(i)%alter_patch(0), num_patches_max, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) + + #:for VAR in [ 'x_centroid', 'y_centroid', 'z_centroid', & +@@ -86,6 +87,10 @@ contains + call MPI_BCAST(patch_icpp(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + #:endfor + ++ #:for VAR in [ 'a2', 'a3', 'a4', 'a5', 'a6', 'a7', 'a8', 'a9', 'a10', 'a11', 'a12'] ++ call MPI_BCAST(patch_icpp(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) ++ #:endfor ++ + call MPI_BCAST(patch_icpp(i)%model%filepath, len(patch_icpp(i)%model%filepath), MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr) + + #:for VAR in [ 'model%translate', 'model%scale', 'model%rotate', & +diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp +index 708ada19..d14d2273 100644 +--- a/src/pre_process/m_patches.fpp ++++ b/src/pre_process/m_patches.fpp +@@ -70,7 +70,8 @@ module m_patches + !! 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(kind(0d0)) :: cart_y, cart_z ++ real(kind(0d0)) :: r_cyl, theta_cyl, x_cart, y_cart, z_cart ++ real(kind(0d0)) :: cart_x, cart_y, cart_z + real(kind(0d0)) :: sph_phi !< + !! Variables to be used to hold cell locations in Cartesian coordinates if + !! 3D simulation is using cylindrical coordinates +@@ -794,7 +795,7 @@ contains + ((y_cc(j) - y_centroid)/b)**2) & + - 1d0))*(-0.5d0) + 0.5d0 + end if +- ++ print *, "a :", a, "b :", b + if ((((x_cc(i) - x_centroid)/a)**2 + & + ((y_cc(j) - y_centroid)/b)**2 <= 1d0 & + .and. & +@@ -1421,128 +1422,240 @@ contains + !! @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, 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, intent(IN) :: patch_id ++ integer, intent(INOUT), dimension(0:m, 0:n, 0:p) :: patch_id_fp ++ type(scalar_field), dimension(1:sys_size) :: q_prim_vf ++ ++ real(kind(0d0)) :: r, x_p, P2, P3, P4, P5, P6, P7, P8, P9, P10, P11, P12, eps, phi ++ real(kind(0d0)) :: a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 ++ real(kind(0d0)) :: radius, x_centroid, y_centroid, z_centroid, eta, smooth_coeff ++ logical :: non_axis_sym + + integer :: i, j, k !< generic loop iterators +- real(kind(0d0)) :: radius, epsilon, beta +- complex(kind(0d0)) :: cmplx_i = (0d0, 1d0) +- complex(kind(0d0)) :: H + + ! Transferring the patch's centroid and radius 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 ++ smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id ++ smooth_coeff = patch_icpp(patch_id)%smooth_coeff + radius = patch_icpp(patch_id)%radius +- epsilon = patch_icpp(patch_id)%epsilon +- beta = patch_icpp(patch_id)%beta ++ a2 = patch_icpp(patch_id)%a2 ++ a3 = patch_icpp(patch_id)%a3 ++ a4 = patch_icpp(patch_id)%a4 ++ a5 = patch_icpp(patch_id)%a5 ++ a6 = patch_icpp(patch_id)%a6 ++ a7 = patch_icpp(patch_id)%a7 ++ a8 = patch_icpp(patch_id)%a8 ++ a9 = patch_icpp(patch_id)%a9 ++ a10 = patch_icpp(patch_id)%a10 ++ a11 = patch_icpp(patch_id)%a11 ++ a12 = patch_icpp(patch_id)%a12 ++ non_axis_sym = 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 = 1d0 ++ eps = 1.d-32 + + ! 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. +- do k = 0, p ++ if (p > 0 .and. .not. non_axis_sym) 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 = dsqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) + eps ++ if (x_cc(i) - x_centroid <= 0) then ++ x_p = -dabs(x_cc(i) - x_centroid + eps)/r ++ else ++ x_p = dabs(x_cc(i) - x_centroid + eps)/r ++ end if ++ ++ P2 = unassociated_legendre(x_p, 2) ++ P3 = unassociated_legendre(x_p, 3) ++ P4 = unassociated_legendre(x_p, 4) ++ P5 = unassociated_legendre(x_p, 5) ++ P6 = unassociated_legendre(x_p, 6) ++ P7 = unassociated_legendre(x_p, 7) ++ if ((x_cc(i) - x_centroid >= 0 & ++ .and. & ++ r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7 <= 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 = tanh(smooth_coeff/min(dx, dy, dz)* & ++ ((r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7) & ++ - radius))*(-0.5d0) + 0.5d0 ++ end if ++ ++ call s_assign_patch_primitive_variables(patch_id, i, j, k, & ++ eta, 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 (grid_geometry == 3) then +- call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) ++ if (non_axis_sym) then ++ phi = atan(((y_cc(j) - y_centroid) + eps)/((x_cc(i) - x_centroid) + eps)) ++ r = dsqrt((x_cc(i) - x_centroid)**2d0 + (y_cc(j) - y_centroid)**2d0) + eps ++ x_p = (eps)/r ++ P2 = spherical_harmonic_func(x_p, phi, 2, 2) ++ P3 = spherical_harmonic_func(x_p, phi, 3, 3) ++ P4 = spherical_harmonic_func(x_p, phi, 4, 4) ++ P5 = spherical_harmonic_func(x_p, phi, 5, 5) ++ P6 = spherical_harmonic_func(x_p, phi, 6, 6) ++ P7 = spherical_harmonic_func(x_p, phi, 7, 7) ++ P8 = spherical_harmonic_func(x_p, phi, 8, 8) ++ P9 = spherical_harmonic_func(x_p, phi, 9, 9) ++ ! P10 = spherical_harmonic_func(x_p, phi, 10, 10) ++ ! P11 = spherical_harmonic_func(x_p, phi, 11, 11) ++ ! P12 = spherical_harmonic_func(x_p, phi, 12, 12) + else +- cart_y = y_cc(j) +- cart_z = z_cc(k) ++ r = dsqrt((x_cc(i) - x_centroid)**2d0 + (y_cc(j) - y_centroid)**2d0) + eps ++ x_p = dabs(x_cc(i) - x_centroid + eps)/r ++ P2 = unassociated_legendre(x_p, 2) ++ P3 = unassociated_legendre(x_p, 3) ++ P4 = unassociated_legendre(x_p, 4) ++ P5 = unassociated_legendre(x_p, 5) ++ P6 = unassociated_legendre(x_p, 6) ++ P7 = unassociated_legendre(x_p, 7) ++ P8 = unassociated_legendre(x_p, 8) ++ P9 = unassociated_legendre(x_p, 9) + end if + +- 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)))) & ++ if (x_cc(i) - x_centroid >= 0 & ++ .and. & ++ r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7 - a8*P8 - a9*P9 <= 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, q_prim_vf, patch_id_fp) + +- call s_convert_cylindrical_to_spherical_coord(x_cc(i), y_cc(j)) +- +- if (epsilon == 1d0) then +- if (beta == 0d0) then +- H = 5d-1*sqrt(3d0/pi)*cos(sph_phi) +- elseif (beta == 1d0) then +- H = -5d-1*sqrt(3d0/(2d0*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi) +- end if +- elseif (epsilon == 2d0) then +- if (beta == 0d0) then +- H = 25d-2*sqrt(5d0/pi)*(3d0*cos(sph_phi)**2 - 1d0) +- elseif (beta == 1d0) then +- H = -5d-1*sqrt(15d0/(2d0*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)*cos(sph_phi) +- elseif (beta == 2d0) then +- H = 25d-2*sqrt(15d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))*sin(sph_phi)**2 +- end if +- elseif (epsilon == 3d0) then +- if (beta == 0d0) then +- H = 25d-2*sqrt(7d0/pi)*(5d0*cos(sph_phi)**3d0 - 3d0*cos(sph_phi)) +- elseif (beta == 1d0) then +- H = -125d-3*sqrt(21d0/pi)*exp(cmplx_i*z_cc(k))*sin(sph_phi)* & +- (5d0*cos(sph_phi)**2 - 1d0) +- elseif (beta == 2d0) then +- H = 25d-2*sqrt(105d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & +- sin(sph_phi)**2*cos(sph_phi) +- elseif (beta == 3d0) then +- H = -125d-3*sqrt(35d0/pi)*exp(3d0*cmplx_i*z_cc(k))*sin(sph_phi)**3d0 +- end if +- elseif (epsilon == 4d0) then +- if (beta == 0d0) then +- H = 3d0/16d0*sqrt(1d0/pi)*(35d0*cos(sph_phi)**4d0 - & +- 3d1*cos(sph_phi)**2 + 3d0) +- elseif (beta == 1d0) then +- H = -3d0/8d0*sqrt(5d0/pi)*exp(cmplx_i*z_cc(k))* & +- sin(sph_phi)*(7d0*cos(sph_phi)**3d0 - 3d0*cos(sph_phi)) +- elseif (beta == 2d0) then +- H = 3d0/8d0*sqrt(5d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & +- sin(sph_phi)**2*(7d0*cos(sph_phi)**2 - 1d0) +- elseif (beta == 3d0) then +- H = -3d0/8d0*sqrt(35d0/pi)*exp(3d0*cmplx_i*z_cc(k))* & +- sin(sph_phi)**3d0*cos(sph_phi) +- elseif (beta == 4d0) then +- H = 3d0/16d0*sqrt(35d0/(2d0*pi))*exp(4d0*cmplx_i*z_cc(k))* & +- sin(sph_phi)**4d0 +- end if +- elseif (epsilon == 5d0) then +- if (beta == 0d0) then +- H = 1d0/16d0*sqrt(11d0/pi)*(63d0*cos(sph_phi)**5d0 - & +- 7d1*cos(sph_phi)**3d0 + 15d0*cos(sph_phi)) +- elseif (beta == 1d0) then +- H = -1d0/16d0*sqrt(165d0/(2d0*pi))*exp(cmplx_i*z_cc(k))* & +- sin(sph_phi)*(21d0*cos(sph_phi)**4d0 - 14d0*cos(sph_phi)**2 + 1d0) +- elseif (beta == 2d0) then +- H = 125d-3*sqrt(1155d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & +- sin(sph_phi)**2*(3d0*cos(sph_phi)**3d0 - cos(sph_phi)) +- elseif (beta == 3d0) then +- H = -1d0/32d0*sqrt(385d0/pi)*exp(3d0*cmplx_i*z_cc(k))* & +- sin(sph_phi)**3d0*(9d0*cos(sph_phi)**2 - 1d0) +- elseif (beta == 4d0) then +- H = 3d0/16d0*sqrt(385d0/(2d0*pi))*exp(4d0*cmplx_i*z_cc(k))* & +- sin(sph_phi)**4d0*cos(sph_phi) +- elseif (beta == 5d0) then +- H = -3d0/32d0*sqrt(77d0/pi)*exp(5d0*cmplx_i*z_cc(k))* & +- sin(sph_phi)**5d0 +- end if +- end if +- +- q_prim_vf(adv_idx%beg)%sf(i, j, k) = 1d0 - abs(real(H, kind(0d0))) ++ elseif (x_cc(i) - x_centroid < 0 & ++ .and. & ++ r - a2*P2 + a3*P3 - a4*P4 + a5*P5 - a6*P6 + a7*P7 - a8*P8 + a9*P9 <= 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, q_prim_vf, patch_id_fp) + + end if +- + end do + end do +- end do ++ end if + + end subroutine s_spherical_harmonic + ++ !! This function generates the unassociated legendre poynomials with input ++ ! mode number and evaluates them at input x ++ ++ recursive function unassociated_legendre(x, l) result(P) ++ integer, intent(in) :: l ++ real(kind(0d0)), intent(in) :: x ++ real(kind(0d0)) :: P ++ ++ if (l == 0) then ++ P = 1d0 ++ else if (l == 1) then ++ P = x ++ else ++ P = ((2*l - 1)*x*unassociated_legendre(x, l - 1) - (l - 1)*unassociated_legendre(x, l - 2))/l ++ end if ++ ++ end function unassociated_legendre ++ ++ !! This function generated the spherical harmonic function valu, Y, ++ !based on inputs of x, phi, l and m ++ ++ recursive function spherical_harmonic_func(x, phi, l, m) result(Y) ++ integer, intent(in) :: l, m ++ real(kind(0d0)), intent(in) :: x, phi ++ real(kind(0d0)) :: Y, prefactor, pi ++ ++ pi = acos(-1d0) ++ prefactor = sqrt((2*l + 1)/(4*pi)*factorial(l - m)/factorial(l + m)); ++ if (m == 0) then ++ Y = prefactor*associated_legendre(x, l, m); ++ elseif (m > 0) then ++ Y = (-1d0)**m*sqrt(2d0)*prefactor*associated_legendre(x, l, m)*cos(m*phi); ++ end if ++ end function spherical_harmonic_func ++ ++ !! This function generates the associated legendre polynomials evaluated ++ !at x with inputs l and m ++ ++ recursive function associated_legendre(x, l, m) result(P) ++ integer, intent(in) :: l, m ++ real(kind(0d0)), intent(in) :: x ++ real(kind(0d0)) :: P ++ ++ if (m <= 0 .and. l <= 0) then ++ P = 1; ++ elseif (l == 1 .and. m <= 0) then ++ P = x; ++ elseif (l == 1 .and. m == 1) then ++ P = -(1 - x**2)**(1/2); ++ elseif (m == l) then ++ P = (-1)**l*double_factorial(2*l - 1)*(1 - x**2)**(l/2); ++ elseif (m == l - 1) then ++ P = x*(2*l - 1)*associated_legendre(x, l - 1, l - 1); ++ else ++ P = ((2*l - 1)*x*associated_legendre(x, l - 1, m) - (l + m - 1)*associated_legendre(x, l - 2, m))/(l - m); ++ end if ++ ++ end function associated_legendre ++ ++ !! This function calculates the double factorial value of an integer ++ ++ recursive function double_factorial(n) result(R) ++ integer, intent(in) :: n ++ integer, parameter :: int64_kind = selected_int_kind(18) ! 18 bytes for 64-bit integer ++ integer(kind=int64_kind) :: R ++ ++ if (n <= 0) then ++ R = 1 ++ else if (n == 1) then ++ R = 1 ++ else ++ R = n*double_factorial(n - 2) ++ end if ++ ++ end function double_factorial ++ ++ !! The following function calculates the factorial value of an integer ++ ++ recursive function factorial(n) result(R) ++ integer, intent(in) :: n ++ integer, parameter :: int64_kind = selected_int_kind(18) ! 18 bytes for 64-bit integer ++ integer(kind=int64_kind) :: R ++ ++ if (n == 0) then ++ R = 1 ++ else ++ R = n*factorial(n - 1) ++ end if ++ ++ end function factorial ++ + !> 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 +@@ -2110,7 +2223,7 @@ contains + + end subroutine s_convert_cylindrical_to_spherical_coord + +- !> Archimedes spiral function ++ !> Archimedes spiral funcreal(kind(0d0)) :: theta_cc, r, x_p, P2, P3, P4, P5, P6, P7tion + !! @param myth Angle + !! @param offset Thickness + !! @param a Starting position +diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp +index 546de9c5..6db827ca 100644 +--- a/src/pre_process/m_start_up.fpp ++++ b/src/pre_process/m_start_up.fpp +@@ -140,7 +140,7 @@ contains + sigR, sigV, dist_type, rhoRV, R0_type, & + file_per_process, relax, relax_model, & + palpha_eps, ptgalpha_eps, ib, num_ibs, patch_ib, & +- sigma, adv_n ++ sigma, adv_n, hyperelasticity, pre_stress + + ! Inquiring the status of the pre_process.inp file + file_loc = 'pre_process.inp' +diff --git a/src/simulation/m_boundary_conditions.fpp b/src/simulation/m_boundary_conditions.fpp +index ca77632d..2b9eee16 100644 +--- a/src/simulation/m_boundary_conditions.fpp ++++ b/src/simulation/m_boundary_conditions.fpp +@@ -357,6 +357,12 @@ contains + q_prim_vf(i)%sf(-j, k, l) = & + q_prim_vf(i)%sf(j - 1, k, l) + end do ++ ++ if(hyperelasticity) then ++ q_prim_vf(xibeg)%sf(-j, k, l) = & ++ -q_prim_vf(xibeg)%sf(j - 1, k, l) ++ end if ++ + end do + end do + end do +@@ -401,6 +407,11 @@ contains + q_prim_vf(i)%sf(m - (j - 1), k, l) + end do + ++ if(hyperelasticity) then ++ q_prim_vf(xibeg)%sf(m + j, k, l) = & ++ -q_prim_vf(xibeg)%sf(m - (j - 1), k, l) ++ end if ++ + end do + end do + end do +@@ -448,6 +459,11 @@ contains + q_prim_vf(i)%sf(l, -j, k) = & + q_prim_vf(i)%sf(l, j - 1, k) + end do ++ ++ if(hyperelasticity) then ++ q_prim_vf(xibeg + 1)%sf(l, -j, k) = & ++ -q_prim_vf(xibeg + 1)%sf(l, j - 1, k) ++ end if + end do + end do + end do +@@ -490,6 +506,11 @@ contains + q_prim_vf(i)%sf(l, n + j, k) = & + q_prim_vf(i)%sf(l, n - (j - 1), k) + end do ++ ++ if(hyperelasticity) then ++ q_prim_vf(xibeg + 1)%sf(l, n + j, k) = & ++ -q_prim_vf(xibeg + 1)%sf(l, n - (j - 1), k) ++ end if + end do + end do + end do +@@ -537,6 +558,11 @@ contains + q_prim_vf(i)%sf(k, l, -j) = & + q_prim_vf(i)%sf(k, l, j - 1) + end do ++ ++ if(hyperelasticity) then ++ q_prim_vf(xiend)%sf(k, l, -j) = & ++ -q_prim_vf(xiend)%sf(k, l, j - 1) ++ end if + end do + end do + end do +@@ -579,6 +605,11 @@ contains + q_prim_vf(i)%sf(k, l, p + j) = & + q_prim_vf(i)%sf(k, l, p - (j - 1)) + end do ++ ++ if(hyperelasticity) then ++ q_prim_vf(xiend)%sf(k, l, p + j) = & ++ -q_prim_vf(xiend)%sf(k, l, p - (j - 1)) ++ end if + end do + end do + end do +diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp +index d9513675..c3523ec9 100644 +--- a/src/simulation/m_checker.fpp ++++ b/src/simulation/m_checker.fpp +@@ -31,6 +31,7 @@ contains + call s_check_inputs_model_eqns + if (acoustic_source) call s_check_inputs_acoustic_src + if (hypoelasticity) call s_check_inputs_hypoelasticity ++ if (hyperelasticity) call s_check_inputs_hyperelasticity + if (bubbles) call s_check_inputs_bubbles + if (adap_dt) call s_check_inputs_adapt_dt + if (alt_soundspeed) call s_check_inputs_alt_soundspeed +@@ -369,10 +370,20 @@ contains + !> Checks constraints on hypoelasticity parameters + subroutine s_check_inputs_hypoelasticity + if (riemann_solver /= 1) then +- call s_mpi_abort('hypoelasticity requires HLL Riemann solver '// & +- '(riemann_solver = 1). Exiting ...') ++ call s_mpi_abort('hypoelasticity requires HLL '// & ++ '(riemann_solver = 1) Riemann solver. '// & ++ 'Exiting ...') ++ end if ++ end subroutine s_check_inputs_hypoelasticity ++ ++ !> Checks constraints on hyperelasticity parameters ++ subroutine s_check_inputs_hyperelasticity ++ if (riemann_solver /= 2) then ++ call s_mpi_abort('hyperelasticity requires HLLC '// & ++ '(riemann_solver = 2) Riemann solver. '// & ++ 'Exiting ...') + end if +- end subroutine ++ end subroutine s_check_inputs_hyperelasticity + + !> Checks constraints on bubble parameters + subroutine s_check_inputs_bubbles +diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp +index 875f0a90..53973bd1 100644 +--- a/src/simulation/m_data_output.fpp ++++ b/src/simulation/m_data_output.fpp +@@ -1,4 +1,4 @@ +-!> ++ + !! @file m_data_output.f90 + !! @brief Contains module m_data_output + +@@ -37,13 +37,16 @@ module m_data_output + private; + public :: s_initialize_data_output_module, & + s_open_run_time_information_file, & ++ s_open_com_files, & + s_open_probe_files, & + s_write_run_time_information, & + s_write_data_files, & + s_write_serial_data_files, & + s_write_parallel_data_files, & ++ s_write_com_files, & + s_write_probe_files, & + s_close_run_time_information_file, & ++ s_close_com_files, & + s_close_probe_files, & + s_finalize_data_output_module + +@@ -63,11 +66,12 @@ module m_data_output + + type(scalar_field), & + dimension(sys_size), & +- intent(inout) :: q_prim_vf ++ intent(inOUT) :: q_prim_vf + + integer, intent(in) :: t_step + +- end subroutine s_write_abstract_data_files ++ end subroutine s_write_abstract_data_files ! ------------------- ++ + end interface ! ======================================================== + #ifdef CRAY_ACC_WAR + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), icfl_sf) +@@ -80,6 +84,8 @@ module m_data_output + real(kind(0d0)), allocatable, dimension(:, :, :) :: vcfl_sf !< VCFL stability criterion + real(kind(0d0)), allocatable, dimension(:, :, :) :: ccfl_sf !< CCFL stability criterion + real(kind(0d0)), allocatable, dimension(:, :, :) :: Rc_sf !< Rc stability criterion ++ real(kind(0d0)), public, allocatable, dimension(:, :) :: c_mass ++ + !$acc declare create(icfl_sf, vcfl_sf, ccfl_sf, Rc_sf) + #endif + +@@ -169,6 +175,44 @@ contains + + end subroutine s_open_run_time_information_file + ++ !> This opens a formatted data file where the root processor ++ !! can write out the CoM information ++ subroutine s_open_com_files() ! ---------------------------------------- ++ character(len=path_len + 3*name_len) :: file_path !< ++ !! Relative path to the CoM file in the case directory ++ integer :: i !< Generic loop iterator ++ do i = 1, num_fluids ++ ! Generating the relative path to the CoM data file ++ write (file_path, '(A,I0,A)') '/fluid', i, '_com.dat' ++ file_path = trim(case_dir)//trim(file_path) ++ ! Creating the formatted data file and setting up its ++ ! structure ++ open (i + 120, file=trim(file_path), & ++ form='formatted', & ++ position='append', & ++ status='unknown') ++ if (n == 0) then ++ write (i + 120, '(A)') '=== Non-Dimensional Time '// & ++ '=== Total Mass '// & ++ '=== x-loc '// & ++ '=== Total Volume ===' ++ elseif (p == 0) then ++ write (i + 120, '(A)') '=== Non-Dimensional Time '// & ++ '=== Total Mass '// & ++ '=== x-loc '// & ++ '=== y-loc '// & ++ '=== Total Volume ===' ++ else ++ write (i + 120, '(A)') '=== Non-Dimensional Time '// & ++ '=== Total Mass '// & ++ '=== x-loc '// & ++ '=== y-loc '// & ++ '=== z-loc '// & ++ '=== Total Volume ===' ++ end if ++ end do ++ end subroutine s_open_com_files ! -------------------------------------- ++ + !> This opens a formatted data file where the root processor + !! can write out flow probe information + subroutine s_open_probe_files +@@ -189,12 +233,12 @@ contains + FORM='formatted', & + STATUS='unknown') + ! POSITION = 'append', & +- !WRITE(i+30,'(A,I0,A)') 'Probe ',i, ' located at:' +- !WRITE(i+30,'(A,F10.6)') 'x = ',probe(i)%x +- !WRITE(i+30,'(A,F10.6)') 'y = ',probe(i)%y +- !WRITE(i+30,'(A,F10.6)') 'z = ',probe(i)%z +- !WRITE(i+30, *) +- !WRITE(i+30,'(A)') '=== Non-Dimensional Time ' // & ++ !write(i+30,'(A,I0,A)') 'Probe ',i, ' located at:' ++ !write(i+30,'(A,F10.6)') 'x = ',probe(i)%x ++ !write(i+30,'(A,F10.6)') 'y = ',probe(i)%y ++ !write(i+30,'(A,F10.6)') 'z = ',probe(i)%z ++ !write(i+30, *) ++ !write(i+30,'(A)') '=== Non-Dimensional Time ' // & + ! '=== Density ' // & + ! '=== Velocity ' // & + ! '=== Pressure ' // & +@@ -227,8 +271,8 @@ contains + !! @param t_step Current time step + subroutine s_write_run_time_information(q_prim_vf, t_step) + +- type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf +- integer, intent(IN) :: t_step ++ type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf ++ integer, intent(in) :: t_step + + real(kind(0d0)), dimension(num_fluids) :: alpha_rho !< Cell-avg. partial density + real(kind(0d0)) :: rho !< Cell-avg. density +@@ -250,7 +294,6 @@ contains + + real(kind(0d0)) :: blkmod1, blkmod2 !< + !! Fluid bulk modulus for Woods mixture sound speed +- + integer :: i, j, k, l, q !< Generic loop iterators + + integer :: Nfq +@@ -262,7 +305,6 @@ contains + do l = 0, p + do k = 0, n + do j = 0, m +- + do i = 1, num_fluids + alpha_rho(i) = q_prim_vf(i)%sf(j, k, l) + alpha(i) = q_prim_vf(E_idx + i)%sf(j, k, l) +@@ -292,6 +334,14 @@ contains + ! Compute mixture sound speed + call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c) + ++ if (c /= c) then ++ print *, 'crashed at processor: ', proc_rank, ', at j :: ', j, ', k :: ', k, ' l :: ', l ++ print *, 'alpha1 ::', alpha(1), 'and alpha2 ::', alpha(2), ' alpha3 :: ', alpha(3) ++ print *, 'alpha_rho1 ::', alpha_rho(1), ', alpha_rho2 ::', alpha_rho(2), ' alpha_rho3 :: ', alpha_rho(3) ++ print *, 'E :: ', E, ', pres :: ', pres, ', rho :: ', rho ++ call s_mpi_abort('Exiting ...') ++ end if ++ + if (grid_geometry == 3) then + if (k == 0) then + fltr_dtheta = 2d0*pi*y_cb(0)/3d0 +@@ -369,7 +419,7 @@ contains + end do + end do + end do +- ! END: Computing Stability Criteria at Current Time-step =========== ++ ! end: Computing Stability Criteria at Current Time-step =========== + + ! Determining local stability criteria extrema at current time-step + +@@ -430,6 +480,7 @@ contains + t_step, t_step*dt, icfl_max_glb, & + vcfl_max_glb, & + Rc_min_glb ++ + else + write (1, '(13X,I8,14X,F10.6,13X,F9.6)') & + t_step, t_step*dt, icfl_max_glb +@@ -840,11 +891,11 @@ contains + + integer :: ifile, ierr, data_size + integer, dimension(MPI_STATUS_SIZE) :: status +- integer(KIND=MPI_OFFSET_KIND) :: disp +- integer(KIND=MPI_OFFSET_KIND) :: m_MOK, n_MOK, p_MOK +- integer(KIND=MPI_OFFSET_KIND) :: WP_MOK, var_MOK, str_MOK +- integer(KIND=MPI_OFFSET_KIND) :: NVARS_MOK +- integer(KIND=MPI_OFFSET_KIND) :: MOK ++ integer(kind=MPI_OFFSET_kind) :: disp ++ integer(kind=MPI_OFFSET_kind) :: m_MOK, n_MOK, p_MOK ++ integer(kind=MPI_OFFSET_kind) :: WP_MOK, var_MOK, str_MOK ++ integer(kind=MPI_OFFSET_kind) :: NVARS_MOK ++ integer(kind=MPI_OFFSET_kind) :: MOK + + character(LEN=path_len + 2*name_len) :: file_loc + logical :: file_exist, dir_check +@@ -876,7 +927,6 @@ contains + call DelayFileAccess(proc_rank) + + ! Initialize MPI data I/O +- + call s_initialize_mpi_data(q_cons_vf) + + ! Open the file to write all flow variables +@@ -969,7 +1019,7 @@ contains + + call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + 'native', mpi_info_int, ierr) +- call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & ++ call MPI_FILE_write_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & + MPI_DOUBLE_PRECISION, status, ierr) + end do + !Write pb and mv for non-polytropic qbmm +@@ -1009,6 +1059,57 @@ contains + + end subroutine s_write_parallel_data_files + ++ !> This writes a formatted data file where the root processor ++ !! can write out the CoM information ++ !! @param t_step Current time-step ++ !! @param q_com Center of mass information ++ !! @param moments Higher moment information ++ subroutine s_write_com_files(t_step, c_mass) ! ------------------- ++ ++ integer, intent(in) :: t_step ++ real(kind(0d0)), dimension(num_fluids, 5), intent(in) :: c_mass ++ integer :: i, j !< Generic loop iterator ++ real(kind(0d0)) :: nondim_time !< Non-dimensional time ++ ++ ! Non-dimensional time calculation ++ if (t_step_old /= dflt_int) then ++ nondim_time = real(t_step + t_step_old, kind(0d0))*dt ++ else ++ nondim_time = real(t_step, kind(0d0))*dt ++ end if ++ ++ if (proc_rank == 0) then ++ if (n == 0) then ! 1D simulation ++ do i = 1, num_fluids ! Loop through fluids ++ write (i + 120, '(6X,4F24.12)') & ++ nondim_time, & ++ c_mass(i, 1), & ++ c_mass(i, 2), & ++ c_mass(i, 5) ++ end do ++ elseif (p == 0) then ! 2D simulation ++ do i = 1, num_fluids ! Loop through fluids ++ write (i + 120, '(6X,5F24.12)') & ++ nondim_time, & ++ c_mass(i, 1), & ++ c_mass(i, 2), & ++ c_mass(i, 3), & ++ c_mass(i, 5) ++ end do ++ else ! 3D simulation ++ do i = 1, num_fluids ! Loop through fluids ++ write (i + 120, '(6X,6F24.12)') & ++ nondim_time, & ++ c_mass(i, 1), & ++ c_mass(i, 2), & ++ c_mass(i, 3), & ++ c_mass(i, 4), & ++ c_mass(i, 5) ++ end do ++ end if ++ end if ++ end subroutine s_write_com_files ! ------------------------------------- ++ + !> This writes a formatted data file for the flow probe information + !! @param t_step Current time-step + !! @param q_cons_vf Conservative variables +@@ -1057,7 +1158,7 @@ contains + real(kind(0d0)) :: nondim_time !< Non-dimensional time + + real(kind(0d0)) :: tmp !< +- !! Temporary variable to store quantity for mpi_allreduce ++ !! Temporary variable to store quantity for mpi_allreduce + + real(kind(0d0)) :: blkmod1, blkmod2 !< + !! Fluid bulk modulus for Woods mixture sound speed +@@ -1118,7 +1219,7 @@ contains + l = 0 + + ! Computing/Sharing necessary state variables +- if (hypoelasticity) then ++ if (elasticity) then + call s_convert_to_mixture_variables(q_cons_vf, j - 2, k, l, & + rho, gamma, pi_inf, qv, & + Re, G, fluid_pp(:)%G) +@@ -1132,7 +1233,8 @@ contains + + dyn_p = 0.5d0*rho*dot_product(vel, vel) + +- if (hypoelasticity) then ++ if (elasticity) then ++ + call s_compute_pressure( & + q_cons_vf(1)%sf(j - 2, k, l), & + q_cons_vf(alf_idx)%sf(j - 2, k, l), & +@@ -1148,7 +1250,7 @@ contains + + if (model_eqns == 4) then + lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 +- else if (hypoelasticity) then ++ else if (elasticity) then + tau_e(1) = q_cons_vf(stress_idx%end)%sf(j - 2, k, l)/rho + end if + +@@ -1232,7 +1334,7 @@ contains + + dyn_p = 0.5d0*rho*dot_product(vel, vel) + +- if (hypoelasticity) then ++ if (elasticity) then + call s_compute_pressure( & + q_cons_vf(1)%sf(j - 2, k - 2, l), & + q_cons_vf(alf_idx)%sf(j - 2, k - 2, l), & +@@ -1247,7 +1349,7 @@ contains + + if (model_eqns == 4) then + lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 +- else if (hypoelasticity) then ++ else if (elasticity) then + do s = 1, 3 + tau_e(s) = q_cons_vf(s)%sf(j - 2, k - 2, l)/rho + end do +@@ -1274,15 +1376,13 @@ contains + R(:) = nR(:)/nbub + Rdot(:) = nRdot(:)/nbub + end if +- + ! Compute mixture sound speed + call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & + ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) + +- accel = accel_mag(j - 2, k - 2, l) + end if + end if +- else ! 3D simulation ++ else ! 3D f (t_step == t_step_stop)simulation + if ((probe(i)%x >= x_cb(-1)) .and. (probe(i)%x <= x_cb(m))) then + if ((probe(i)%y >= y_cb(-1)) .and. (probe(i)%y <= y_cb(n))) then + if ((probe(i)%z >= z_cb(-1)) .and. (probe(i)%z <= z_cb(p))) then +@@ -1315,7 +1415,7 @@ contains + + dyn_p = 0.5d0*rho*dot_product(vel, vel) + +- if (hypoelasticity) then ++ if (elasticity) then + call s_compute_pressure( & + q_cons_vf(1)%sf(j - 2, k - 2, l - 2), & + q_cons_vf(alf_idx)%sf(j - 2, k - 2, l - 2), & +@@ -1337,7 +1437,6 @@ contains + end if + end if + end if +- + if (num_procs > 1) then + #:for VAR in ['rho','pres','gamma','pi_inf','qv','c','accel'] + tmp = ${VAR}$ +@@ -1363,14 +1462,13 @@ contains + end if + end if + +- if (hypoelasticity) then ++ if (elasticity) then + do s = 1, (num_dims*(num_dims + 1))/2 + tmp = tau_e(s) + call s_mpi_allreduce_sum(tmp, tau_e(s)) + end do + end if + end if +- + if (proc_rank == 0) then + if (n == 0) then + if (bubbles .and. (num_fluids <= 2)) then +@@ -1457,7 +1555,7 @@ contains + nRdot(1), & + R(1), & + Rdot(1) +- else if (hypoelasticity) then ++ else if (elasticity) then + write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,'// & + 'F24.8,F24.8,F24.8)') & + nondim_time, & +@@ -1474,6 +1572,7 @@ contains + rho, & + vel(1), & + pres ++ print *, 'time =', nondim_time, 'rho =', rho, 'pres =', pres + end if + else + write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,'// & +@@ -1659,6 +1758,16 @@ contains + + end subroutine s_close_run_time_information_file + ++ !> Closes communication files ++ subroutine s_close_com_files() ! --------------------------------------- ++ ++ integer :: i !< Generic loop iterator ++ do i = 1, num_fluids ++ close (i + 120) ++ end do ++ ++ end subroutine s_close_com_files ! ------------------------------------- ++ + !> Closes probe files + subroutine s_close_probe_files + +@@ -1679,6 +1788,8 @@ contains + + integer :: i !< Generic loop iterator + ++ allocate (c_mass(1:num_fluids, 1:5)) ++ + ! Allocating/initializing ICFL, VCFL, CCFL and Rc stability criteria + @:ALLOCATE_GLOBAL(icfl_sf(0:m, 0:n, 0:p)) + icfl_max = 0d0 +@@ -1718,6 +1829,8 @@ contains + + integer :: i !< Generic loop iterator + ++ deallocate (c_mass) ++ + ! Deallocating the ICFL, VCFL, CCFL, and Rc stability criteria + @:DEALLOCATE_GLOBAL(icfl_sf) + if (any(Re_size > 0)) then +diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 +index 4cbe11ab..8f01d478 100644 +--- a/src/simulation/m_derived_variables.f90 ++++ b/src/simulation/m_derived_variables.f90 +@@ -20,6 +20,8 @@ module m_derived_variables + + use m_time_steppers !< Time-stepping algorithms + ++ use m_compile_specific ++ + use m_helper + ! ========================================================================== + +@@ -90,8 +92,8 @@ contains + ! Opening and writing header of flow probe files + if (proc_rank == 0) then + call s_open_probe_files() ++ call s_open_com_files() + end if +- + ! Computing centered finite difference coefficients + call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & + fd_number, fd_order) +@@ -100,12 +102,10 @@ contains + call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & + fd_number, fd_order) + end if +- + if (p > 0) then + call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & + fd_number, fd_order) + end if +- + end if + + end subroutine s_initialize_derived_variables +@@ -115,7 +115,6 @@ contains + subroutine s_compute_derived_variables(t_step) + + integer, intent(in) :: t_step +- + integer :: i, j, k !< Generic loop iterators + + if (probe_wrt) then +@@ -124,7 +123,6 @@ contains + q_prim_ts(2)%vf, & + q_prim_ts(3)%vf, & + x_accel) +- + if (n > 0) then + call s_derive_acceleration_component(2, q_prim_ts(0)%vf, & + q_prim_ts(1)%vf, & +@@ -132,7 +130,6 @@ contains + q_prim_ts(3)%vf, & + y_accel) + end if +- + if (p > 0) then + call s_derive_acceleration_component(3, q_prim_ts(0)%vf, & + q_prim_ts(1)%vf, & +@@ -140,7 +137,6 @@ contains + q_prim_ts(3)%vf, & + z_accel) + end if +- + do k = 0, p + do j = 0, n + do i = 0, m +@@ -157,8 +153,10 @@ contains + end do + end do + end do ++ call s_derive_center_of_mass(q_prim_ts(3)%vf, c_mass) + + call s_write_probe_files(t_step, q_cons_ts(1)%vf, accel_mag) ++ call s_write_com_files(t_step, c_mass) + end if + + end subroutine s_compute_derived_variables +@@ -194,7 +192,6 @@ contains + do l = 0, p + do k = 0, n + do j = 0, m +- + q_sf(j, k, l) = (11d0*q_prim_vf0(mom_idx%beg)%sf(j, k, l) & + - 18d0*q_prim_vf1(mom_idx%beg)%sf(j, k, l) & + + 9d0*q_prim_vf2(mom_idx%beg)%sf(j, k, l) & +@@ -234,18 +231,15 @@ contains + end do + end do + end do +- + ! Computing the acceleration component in the y-coordinate direction + elseif (i == 2) then + do l = 0, p + do k = 0, n + do j = 0, m +- + q_sf(j, k, l) = (11d0*q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf1(mom_idx%beg + 1)%sf(j, k, l) & + + 9d0*q_prim_vf2(mom_idx%beg + 1)%sf(j, k, l) & + - 2d0*q_prim_vf3(mom_idx%beg + 1)%sf(j, k, l))/(6d0*dt) +- + do r = -fd_number, fd_number + if (p == 0) then ! 2D simulation + q_sf(j, k, l) = q_sf(j, k, l) & +@@ -316,11 +310,154 @@ contains + + end subroutine s_derive_acceleration_component + ++ !> This subroutine is used together with the volume fraction ++ !! model and when called upon, it computes the location of ++ !! of the center of mass for each fluid from the inputted ++ !! primitive variables, q_prim_vf. The computed location ++ !! is then written to a formatted data file by the root process. ++ !! @param q_prim_vf Primitive variables ++ !! @param c_m Mass,x-location,y-location,z-location ++ subroutine s_derive_center_of_mass(q_vf, c_m) ++ type(scalar_field), dimension(sys_size), intent(IN) :: q_vf ++ real(kind(0d0)), dimension(1:num_fluids, 1:5), intent(INOUT) :: c_m ++ integer :: i, j, k, l !< Generic loop iterators ++ real(kind(0d0)) :: tmp, tmp_out !< Temporary variable to store quantity for mpi_allreduce ++ real(kind(0d0)) :: dV !< Discrete cell volume ++ ++ do i = 1, num_fluids ++ do j = 1, 5 ++ c_m(i, j) = 0.0d0 ++ end do ++ end do ++ ++ if (n == 0) then !1D simulation ++ do i = 1, num_fluids !Loop over individual fluids ++ do l = 0, p !Loop over grid ++ do k = 0, n ++ do j = 0, m ++ dV = dx(j) ++ ! Mass ++ c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV ++ ! x-location weighted ++ c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) ++ ! Volume fraction ++ c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 1)%sf(j, k, l)*dV ++ end do ++ end do ++ end do ++ end do ++ elseif (p == 0) then !2D simulation ++ do i = 1, num_fluids !Loop over individual fluids ++ do l = 0, p !Loop over grid ++ do k = 0, n ++ do j = 0, m ++ dV = dx(j)*dy(k) ++ ! Mass ++ c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV ++ ! x-location weighted ++ c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) ++ ! y-location weighted ++ c_m(i, 3) = c_m(i, 3) + q_vf(i)%sf(j, k, l)*dV*y_cc(k) ++ ! Volume fraction ++ c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 1)%sf(j, k, l)*dV ++ end do ++ end do ++ end do ++ end do ++ else !3D simulation ++ do i = 1, num_fluids !Loop over individual fluids ++ do l = 0, p !Loop over grid ++ do k = 0, n ++ do j = 0, m ++ dV = dx(j)*dy(k)*dz(l) ++ ! Mass ++ c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV ++ ! x-location weighted ++ c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) ++ ! y-location weighted ++ c_m(i, 3) = c_m(i, 3) + q_vf(i)%sf(j, k, l)*dV*y_cc(k) ++ ! z-location weighted ++ c_m(i, 4) = c_m(i, 4) + q_vf(i)%sf(j, k, l)*dV*z_cc(l) ++ ! Volume fraction ++ c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 1)%sf(j, k, l)*dV ++ end do ++ end do ++ end do ++ end do ++ end if ++ if (n == 0) then !1D simulation ++ do i = 1, num_fluids !Loop over individual fluids ++ ! Sum all components across all processors using MPI_ALLREDUCE ++ if (num_procs > 1) then ++ tmp = c_m(i, 1) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 1) = tmp_out ++ tmp = c_m(i, 2) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 2) = tmp_out ++ tmp = c_m(i, 5) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 5) = tmp_out ++ end if ++ ! Compute quotients ++ c_m(i, 2) = c_m(i, 2)/c_m(i, 1) ++ end do ++ elseif (p == 0) then !2D simulation ++ do i = 1, num_fluids !Loop over individual fluids ++ ! Sum all components across all processors using MPI_ALLREDUCE ++ if (num_procs > 1) then ++ tmp = c_m(i, 1) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 1) = tmp_out ++ tmp = c_m(i, 2) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 2) = tmp_out ++ tmp = c_m(i, 3) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 3) = tmp_out ++ tmp = c_m(i, 5) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 5) = tmp_out ++ end if ++ ! Compute quotients ++ c_m(i, 2) = c_m(i, 2)/c_m(i, 1) ++ c_m(i, 3) = c_m(i, 3)/c_m(i, 1) ++ end do ++ else !3D simulation ++ do i = 1, num_fluids !Loop over individual fluids ++ ! Sum all components across all processors using MPI_ALLREDUCE ++ if (num_procs > 1) then ++ tmp = c_m(i, 1) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 1) = tmp_out ++ tmp = c_m(i, 2) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 2) = tmp_out ++ tmp = c_m(i, 3) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 3) = tmp_out ++ tmp = c_m(i, 4) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 4) = tmp_out ++ tmp = c_m(i, 5) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 5) = tmp_out ++ end if ++ ! Compute quotients ++ c_m(i, 2) = c_m(i, 2)/c_m(i, 1) ++ c_m(i, 3) = c_m(i, 3)/c_m(i, 1) ++ c_m(i, 4) = c_m(i, 4)/c_m(i, 1) ++ end do ++ end if ++ ++ end subroutine s_derive_center_of_mass ! ---------------------------------- ++ + !> Deallocation procedures for the module + subroutine s_finalize_derived_variables_module + + ! Closing CoM and flow probe files + if (proc_rank == 0) then ++ call s_close_com_files() + if (probe_wrt) then + call s_close_probe_files() + end if +diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp +index a703eb5c..539d3b56 100644 +--- a/src/simulation/m_global_parameters.fpp ++++ b/src/simulation/m_global_parameters.fpp +@@ -144,9 +144,12 @@ module m_global_parameters + integer :: wave_speeds !< Wave speeds estimation method + integer :: avg_state !< Average state evaluation method + logical :: alt_soundspeed !< Alternate mixture sound speed +- logical :: null_weights !< Null undesired WENO weights +- logical :: mixture_err !< Mixture properties correction +- logical :: hypoelasticity !< hypoelasticity modeling ++ logical :: null_weights !< Null undesired WENO weights ++ logical :: mixture_err !< Mixture properties correction ++ logical :: hypoelasticity !< hypoelasticity modeling ++ logical :: hyperelasticity !< hyperelasticity modeling ++ integer :: hyper_model !< hyperelasticity solver algorithm ++ logical :: elasticity !< elasticity modeling, true for hyper or hypo + logical :: cu_tensor + + logical :: bodyForces +@@ -166,7 +169,7 @@ module m_global_parameters + !$acc declare create(num_dims, weno_polyn, weno_order, num_fluids, wenojs, mapped_weno, wenoz, teno) + #:endif + +- !$acc declare create(mpp_lim, model_eqns, mixture_err, alt_soundspeed, avg_state, mp_weno, weno_eps, teno_CT, hypoelasticity, low_Mach) ++ !$acc declare create(mpp_lim, model_eqns, mixture_err, alt_soundspeed, avg_state, mp_weno, weno_eps, teno_CT, hypoelasticity, hyperelasticity, elasticity, low_Mach) + + logical :: relax !< activate phase change + integer :: relax_model !< Relaxation model +@@ -182,6 +185,8 @@ module m_global_parameters + type(int_bounds_info) :: bc_x, bc_y, bc_z + !> @} + type(bounds_info) :: x_domain, y_domain, z_domain ++ real(kind(0d0)) :: x_a, y_a, z_a ++ real(kind(0d0)) :: x_b, y_b, z_b + + logical :: parallel_io !< Format of the data files + logical :: file_per_process !< shared file or not when using parallel io +@@ -208,19 +213,22 @@ module m_global_parameters + !> @name Annotations of the structure of the state and flux vectors in terms of the + !! size and the configuration of the system of equations to which they belong + !> @{ +- integer :: sys_size !< Number of unknowns in system of eqns. ++ integer :: sys_size !< Number of unknowns in system of eqns. + type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. + type(int_bounds_info) :: mom_idx !< Indexes of first & last momentum eqns. +- integer :: E_idx !< Index of energy equation +- integer :: n_idx !< Index of number density ++ integer :: E_idx !< Index of energy equation ++ integer :: n_idx !< Index of number density + type(int_bounds_info) :: adv_idx !< Indexes of first & last advection eqns. + type(int_bounds_info) :: internalEnergies_idx !< Indexes of first & last internal energy eqns. +- type(bub_bounds_info) :: bub_idx !< Indexes of first & last bubble variable eqns. +- integer :: alf_idx !< Index of void fraction +- integer :: gamma_idx !< Index of specific heat ratio func. eqn. +- integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. ++ type(bub_bounds_info) :: bub_idx !< Indexes of first & last bubble variable eqns. ++ integer :: alf_idx !< Index of void fraction ++ integer :: gamma_idx !< Index of specific heat ratio func. eqn. ++ integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. + type(int_bounds_info) :: stress_idx !< Indexes of first and last shear stress eqns. +- integer :: c_idx ! Index of the color function ++ type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. ++ integer :: b_size !< Number of elements in the symmetric b tensor, plus one ++ integer :: tensor_size !< Number of elements in the full tensor plus one ++ integer :: c_idx !< Index of the color function + !> @} + + !$acc declare create(bub_idx) +@@ -273,7 +281,7 @@ module m_global_parameters + + integer :: startx, starty, startz + +- !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx) ++ !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx,b_size, tensor_size, xi_idx) + + ! END: Simulation Algorithm Parameters ===================================== + +@@ -299,6 +307,7 @@ module m_global_parameters + !! The finite-difference number is given by MAX(1, fd_order/2). Essentially, + !! it is a measure of the half-size of the finite-difference stencil for the + !! selected order of accuracy. ++ !$acc declare create(fd_order,fd_number) + + logical :: probe_wrt + logical :: integral_wrt +@@ -435,7 +444,9 @@ module m_global_parameters + integer :: intxb, intxe + integer :: bubxb, bubxe + integer :: strxb, strxe ++ integer :: xibeg, xiend + !$acc declare create(momxb, momxe, advxb, advxe, contxb, contxe, intxb, intxe, bubxb, bubxe, strxb, strxe) ++!$acc declare create(xibeg,xiend) + + #ifdef CRAY_ACC_WAR + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps) +@@ -515,6 +526,9 @@ contains + palpha_eps = dflt_real + ptgalpha_eps = dflt_real + hypoelasticity = .false. ++ hyperelasticity = .false. ++ elasticity = .false. ++ hyper_model = dflt_int + weno_flat = .true. + riemann_flat = .true. + rdma_mpi = .false. +@@ -828,13 +842,26 @@ contains + end if + end if + +- if (hypoelasticity) then ++ if (hypoelasticity .or. hyperelasticity) then ++ elasticity = .true. + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end + end if + ++ if (hyperelasticity) then ++ ! number of entries in the symmetric btensor plus the jacobian ++ b_size = (num_dims*(num_dims + 1))/2 + 1 ++ ! storing the jacobian in the last entry ++ tensor_size = num_dims**2 + 1 ++ xi_idx%beg = sys_size + 1 ++ xi_idx%end = sys_size + num_dims ++ ! adding three more equations for the \xi field and the elastic energy ++ sys_size = xi_idx%end + 1 ++ hyper_model = 1 ++ end if ++ + if (.not. f_is_default(sigma)) then + c_idx = sys_size + 1 + sys_size = c_idx +@@ -853,6 +880,25 @@ contains + internalEnergies_idx%end = adv_idx%end + num_fluids + sys_size = internalEnergies_idx%end + ++ if (hypoelasticity .or. hyperelasticity) then ++ elasticity = .true. ++ stress_idx%beg = sys_size + 1 ++ stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ++ ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D ++ sys_size = stress_idx%end ++ end if ++ ++ if (hyperelasticity) then ++ ! number of entries in the symmetric btensor plus the jacobian ++ b_size = (num_dims*(num_dims + 1))/2 + 1 ++ ! storing the jacobian in the last entry ++ tensor_size = num_dims**2 + 1 ++ xi_idx%beg = sys_size + 1 ++ xi_idx%end = sys_size + num_dims ++ ! adding three more equations for the \xi field and the elastic energy ++ sys_size = xi_idx%end + 1 ++ end if ++ + if (.not. f_is_default(sigma)) then + c_idx = sys_size + 1 + sys_size = c_idx +@@ -989,12 +1035,18 @@ contains + ! the next one + if (any(Re_size > 0)) then + buff_size = 2*weno_polyn + 2 +-! else if (hypoelasticity) then !TODO: check if necessary ++! else if (elasticity) then !TODO: check if necessary + ! buff_size = 2*weno_polyn + 2 + else + buff_size = weno_polyn + 2 + end if + ++ if (elasticity) then ++ fd_order = 4 ++ fd_number = max(1, fd_order/2) ++ !buff_size = buff_size + fd_number ++ end if ++ + ! Configuring Coordinate Direction Indexes ========================= + if (bubbles) then + ix%beg = -buff_size; iy%beg = 0; iz%beg = 0 +@@ -1024,7 +1076,8 @@ contains + if (p > 0) then + startz = -buff_size + end if +- ++ ++ !$acc update device(fd_order,fd_number) + !$acc update device(startx, starty, startz) + + if (cyl_coord .neqv. .true.) then ! Cartesian grid +@@ -1047,19 +1100,23 @@ contains + strxe = stress_idx%end + intxb = internalEnergies_idx%beg + intxe = internalEnergies_idx%end ++ xibeg = xi_idx%beg ++ xiend = xi_idx%end + +- !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe) ++ !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe, b_size, xibeg, xiend, tensor_size) + !$acc update device(m, n, p) + + !$acc update device(alt_soundspeed, acoustic_source, num_source) +- !$acc update device(dt, sys_size, buff_size, pref, rhoref, gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim, bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids, model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord, mp_weno, weno_eps, teno_CT, low_Mach) ++ !$acc update device(dt, sys_size, buff_size, pref, rhoref, gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim, bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids, model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord, mp_weno, weno_eps, teno_CT, hyperelasticity, elasticity, xi_idx, low_Mach) + + #:if not MFC_CASE_OPTIMIZATION + !$acc update device(wenojs, mapped_weno, wenoz, teno) + #:endif + + !$acc enter data copyin(nb, R0ref, Ca, Web, Re_inv, weight, R0, V0, bubbles, polytropic, polydisperse, qbmm, R0_type, ptil, bubble_model, thermal, poly_sigma) +- !$acc enter data copyin(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v, k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN , mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam) ++ ++ !$acc enter data copyin(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v, k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN, mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam) ++ + !$acc enter data copyin(dir_idx, dir_flg, dir_idx_tau) + + !$acc enter data copyin(relax, relax_model, palpha_eps,ptgalpha_eps) +diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp +new file mode 100644 +index 00000000..9d8b6a4f +--- /dev/null ++++ b/src/simulation/m_hyperelastic.fpp +@@ -0,0 +1,364 @@ ++!> ++!! @file m_hyperelastic.f90 ++!! @brief Contains module m_hyperelastic ++ ++#:include 'macros.fpp' ++ ++!> @brief This module consists of subroutines used in the calculation ++!! of the cauchy tensor ++ ++module m_hyperelastic ++ ++ ! Dependencies ============================================================= ++ ++ use m_derived_types !< Definitions of the derived types ++ ++ use m_global_parameters !< Definitions of the global parameters ++ ++ use m_variables_conversion !< State variables type conversion procedures ++ ++ use m_helper ++ ++ ! ========================================================================== ++ ++ implicit none ++ ++ private; public :: s_hyperelastic_rmt_stress_update, & ++ s_initialize_hyperelastic_module, & ++ s_finalize_hyperelastic_module ++ ++ !> @name Abstract interface for creating function pointers ++ !> @{ ++ abstract interface ++ ++ !> @name Abstract subroutine for the infinite relaxation solver ++ !> @{ ++ subroutine s_abstract_hyperelastic_solver(btensor, q_prim_vf, G, j, k, l) ++ !$acc routine seq ++ import :: scalar_field, sys_size, b_size ++ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf ++ type(scalar_field), dimension(b_size), intent(inout) :: btensor ++ real(kind(0d0)), intent(in) :: G ++ integer, intent(in) :: j, k, l ++ ++ end subroutine s_abstract_hyperelastic_solver ++ !> @} ++ ++ end interface ++ !> @} ++ ++ procedure(s_abstract_hyperelastic_solver), & ++ pointer :: s_compute_cauchy_solver => null() ++ ++ !! The btensor at the cell-interior Gaussian quadrature points. ++ !! These tensor is needed to be calculated once and make the code DRY. ++ type(vector_field) :: btensor !< ++ !$acc declare create(btensor) ++ ++#ifdef CRAY_ACC_WAR ++ @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), allocatable, dimension(:, :), fd_coeff_x, fd_coeff_y, fd_coeff_z) ++ !$acc declare link(fd_coeff_x,fd_coeff_y,fd_coeff_z) ++ ++#else ++ ++ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_x ++ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_y ++ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_z ++ !$acc declare create(fd_coeff_x,fd_coeff_y,fd_coeff_z) ++ real(kind(0d0)), allocatable, dimension(:) :: Gs ++ !$acc declare create(Gs) ++#endif ++ ++contains ++ ++ !> The following subroutine handles the calculation of the btensor. ++ !! The calculation of the btensor takes qprimvf. ++ !! @param q_prim_vf Primitive variables ++ !! @param btensor is the output ++ !! calculate the grad_xi, grad_xi is a nxn tensor ++ !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor ++ !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor ++ !! btensor is symmetric, save the data space ++ subroutine s_initialize_hyperelastic_module() ++ integer :: i !< generic iterator ++ ++ @:ALLOCATE(btensor%vf(1:b_size)) ++ do i = 1, b_size ++ @:ALLOCATE(btensor%vf(i)%sf(0:m, 0:n, 0:p)) ++ end do ++ @:ACC_SETUP_VFs(btensor) ++ ++ @:ALLOCATE(Gs(1:num_fluids)) ++ !$acc loop seq ++ do i = 1, num_fluids ++ Gs(i) = fluid_pp(i)%G ++ end do ++ !$acc update device(Gs) ++ ++ ! Associating procedural pointer to the subroutine that will be ++ ! utilized to calculate the solution of a given Riemann problem ++ if (hyper_model == 1) then ++ s_compute_cauchy_solver => s_neoHookean_cauchy_solver ++ elseif (riemann_solver == 2) then ++ s_compute_cauchy_solver => s_Mooney_Rivlin_cauchy_solver ++ end if ++ ++ @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) ++ if (n > 0) then ++ @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) ++ end if ++ if (p > 0) then ++ @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) ++ end if ++ ++ ! Computing centered finite difference coefficients ++ call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & ++ fd_number, fd_order) ++ !$acc update device(fd_coeff_x) ++ if (n > 0) then ++ call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & ++ fd_number, fd_order) ++ !$acc update device(fd_coeff_y) ++ end if ++ if (p > 0) then ++ call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & ++ fd_number, fd_order) ++ !$acc update device(fd_coeff_z) ++ end if ++ ++ end subroutine s_initialize_hyperelastic_module ++ ++ !> The following subroutine handles the calculation of the btensor. ++ !! The calculation of the btensor takes qprimvf. ++ !! @param q_prim_vf Primitive variables ++ !! @param btensor is the output ++ !! calculate the grad_xi, grad_xi is a nxn tensor ++ !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor ++ !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor ++ !! btensor is symmetric, save the data space ++ subroutine s_hyperelastic_rmt_stress_update(q_cons_vf,q_prim_vf) ++ ++ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf ++ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf ++ ++ real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb ++ real(kind(0d0)), dimension(num_fluids) :: alpha_K, alpha_rho_K ++ real(kind(0d0)), dimension(2) :: Re_K ++ real(kind(0d0)) :: rho_K, gamma_K, pi_inf_K, qv_K ++ real(kind(0d0)) :: G_K ++ integer :: j, k, l, i, r ++ ++ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,Re_K, tensora, tensorb) ++ do l = 0, p-2 ++ do k = 0, n-2 ++ do j = 2, m-2 ++ !$acc loop seq ++ do i = 1, num_fluids ++ alpha_rho_K(i) = q_cons_vf(i)%sf(j, k, l) ++ alpha_K(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) ++ end do ++ ! If in simulation, use acc mixture subroutines ++ call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & ++ alpha_rho_K, Re_K, j, k, l, G_K, Gs) ++ rho_K = max(rho_K, sgm_eps) ++ if ( G_K .le. verysmall ) G_K = 0d0 ++ ++ if ( G_K .gt. 20d0 ) then ++ !$acc loop seq ++ do i = 1, tensor_size ++ tensora(i) = 0d0 ++ end do ++ ! STEP 1: computing the grad_xi tensor using finite differences ++ ! grad_xi definition / organization ++ ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx ++ ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy ++ ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz ++ !$acc loop seq ++ do r = -fd_number, fd_number ++ ! derivatives in the x-direction ++ tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) ++ tensora(2) = tensora(2) + q_prim_vf(xibeg+1)%sf(j + r, k, l)*fd_coeff_x(r, j) ++ tensora(3) = tensora(3) + q_prim_vf(xiend)%sf(j + r, k, l)*fd_coeff_x(r, j) ++ ! derivatives in the y-direction ++ tensora(4) = tensora(4) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) ++ tensora(5) = tensora(5) + q_prim_vf(xibeg+1)%sf(j, k + r, l)*fd_coeff_y(r, k) ++ tensora(6) = tensora(6) + q_prim_vf(xiend)%sf(j, k + r, l)*fd_coeff_y(r, k) ++ ! derivatives in the z-direction ++ tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_z(r, l) ++ tensora(8) = tensora(8) + q_prim_vf(xibeg+1)%sf(j, k, l + r)*fd_coeff_z(r, l) ++ tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_z(r, l) ++ end do ++ ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse ++ tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) ++ tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) ++ tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) ++ tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) ++ tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) ++ tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) ++ tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) ++ tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) ++ tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) ++ ++ ! STEP 2b: computing the determinant of the grad_xi tensor ++ tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & ++ - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & ++ + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) ++ ++ if (tensorb(tensor_size) > 0d0) then ++ ! STEP 2c: computing the inverse of grad_xi tensor = F ++ ! tensorb is the adjoint, tensora becomes F ++ !$acc loop seq ++ do i = 1, tensor_size - 1 ++ tensora(i) = tensorb(i)/tensorb(tensor_size) ++ end do ++ ++ ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) ++ tensorb(tensor_size) = 1d0/tensorb(tensor_size) ++ ++ ! STEP 3: computing F tranpose F ++ tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 ++ tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 ++ tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 ++ tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) ++ tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) ++ tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) ++ ! STEP 4: update the btensor, this is consistent with Riemann solvers ++ ! \tau_xx ++ btensor%vf(1)%sf(j, k, l) = tensorb(1) ++ ! \tau_xy ++ btensor%vf(2)%sf(j, k, l) = tensorb(2) ++ ! \tau_yy ++ btensor%vf(3)%sf(j, k, l) = tensorb(5) ++ ! \tau_xz ++ btensor%vf(4)%sf(j, k, l) = tensorb(3) ++ ! \tau_yz ++ btensor%vf(5)%sf(j, k, l) = tensorb(6) ++ ! \tau_zz ++ btensor%vf(6)%sf(j, k, l) = tensorb(9) ++ ! store the determinant at the last entry of the btensor ++ btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) ++ ! STEP 5a: updating the Cauchy stress primitive scalar field ++ call s_compute_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) ++ ! STEP 5b: updating the pressure field ++ q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & ++ G_K*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma_K ++ ! STEP 5c: updating the Cauchy stress conservative scalar field ++ !$acc loop seq ++ do i = 1, b_size - 1 ++ q_cons_vf(strxb + i - 1)%sf(j, k, l) = & ++ rho_K*q_prim_vf(strxb + i - 1)%sf(j, k, l) ++ end do ++ end if ++ end if ++ end do ++ end do ++ end do ++ !$acc end parallel loop ++ end subroutine s_hyperelastic_rmt_stress_update ++ ++ !> The following subroutine handles the calculation of the btensor. ++ !! The calculation of the btensor takes qprimvf. ++ !! @param q_prim_vf Primitive variables ++ !! @param btensor is the output ++ !! calculate the grad_xi, grad_xi is a nxn tensor ++ !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor ++ !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor ++ !! btensor is symmetric, save the data space ++ subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) ++ !$acc routine seq ++ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf ++ type(scalar_field), dimension(b_size), intent(inout) :: btensor ++ real(kind(0d0)), intent(in) :: G ++ integer, intent(in) :: j, k, l ++ ++ real(kind(0d0)) :: trace ++ real(kind(0d0)) :: f13 = 1d0/3d0 ++ integer :: i !< Generic loop iterators ++ ++ !TODO Make this 1D and 2D capable ++ ! tensor is the symmetric tensor & calculate the trace of the tensor ++ trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) ++ ++ ! calculate the deviatoric of the tensor ++ btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace ++ btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace ++ btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace ++ ++ ! dividing by the jacobian for neo-Hookean model ++ ! setting the tensor to the stresses for riemann solver ++ !$acc loop seq ++ do i = 1, b_size - 1 ++ q_prim_vf(strxb + i - 1)%sf(j, k, l) = & ++ G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) ++ end do ++ ! compute the invariant without the elastic modulus ++ q_prim_vf(xiend + 1)%sf(j, k, l) = & ++ 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) ++ ++ end subroutine s_neoHookean_cauchy_solver ++ ++ !> The following subroutine handles the calculation of the btensor. ++ !! The calculation of the btensor takes qprimvf. ++ !! @param q_prim_vf Primitive variables ++ !! @param btensor is the output ++ !! calculate the grad_xi, grad_xi is a nxn tensor ++ !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor ++ !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor ++ !! btensor is symmetric, save the data space ++ subroutine s_Mooney_Rivlin_cauchy_solver(btensor, q_prim_vf, G, j, k, l) ++ !$acc routine seq ++ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf ++ type(scalar_field), dimension(b_size), intent(inout) :: btensor ++ real(kind(0d0)), intent(in) :: G ++ integer, intent(in) :: j, k, l ++ ++ real(kind(0d0)) :: trace ++ real(kind(0d0)) :: f13 = 1d0/3d0 ++ integer :: i !< Generic loop iterators ++ ++ !TODO Make this 1D and 2D capable ++ ! tensor is the symmetric tensor & calculate the trace of the tensor ++ trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) ++ ++ ! calculate the deviatoric of the tensor ++ btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace ++ btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace ++ btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace ++ ++ ! dividing by the jacobian for neo-Hookean model ++ ! setting the tensor to the stresses for riemann solver ++ !$acc loop seq ++ do i = 1, b_size - 1 ++ q_prim_vf(strxb + i - 1)%sf(j, k, l) = & ++ G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) ++ end do ++ ! compute the invariant without the elastic modulus ++ q_prim_vf(xiend + 1)%sf(j, k, l) = & ++ 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) ++ ++ end subroutine s_Mooney_Rivlin_cauchy_solver ++ ++ ++ subroutine s_finalize_hyperelastic_module() ++ ++ integer :: i !< iterator ++ ++ ! Disassociating procedural pointer to the subroutine which was ++ ! utilized to calculate the solution of a given Riemann problem ++ s_compute_cauchy_solver => null() ++ ++ ! Deallocating memory ++ do i = 1, b_size ++ @:DEALLOCATE_GLOBAL(btensor%vf(i)%sf) ++ end do ++ @:DEALLOCATE_GLOBAL(fd_coeff_x) ++ if (n > 0) then ++ @:DEALLOCATE_GLOBAL(fd_coeff_y) ++ if (p > 0) then ++ @:DEALLOCATE_GLOBAL(fd_coeff_z) ++ end if ++ end if ++ ++ end subroutine s_finalize_hyperelastic_module ++ ++end module m_hyperelastic +diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp +index e3bb7ec0..7f3d54c3 100644 +--- a/src/simulation/m_hypoelastic.fpp ++++ b/src/simulation/m_hypoelastic.fpp +@@ -13,13 +13,16 @@ module m_hypoelastic + + use m_global_parameters !< Definitions of the global parameters + +- use m_mpi_proxy !< Message passing interface (MPI) module proxy ++! use m_mpi_proxy !< Message passing interface (MPI) module proxy ++ ++ use m_helper + + ! ========================================================================== + + implicit none + + private; public :: s_initialize_hypoelastic_module, & ++ s_finalize_hypoelastic_module, & + s_compute_hypoelastic_rhs + + #ifdef CRAY_ACC_WAR +@@ -33,6 +36,10 @@ module m_hypoelastic + + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), rho_K_field, G_K_field) + !$acc declare link(rho_K_field, G_K_field) ++ ++ @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), allocatable, dimension(:, :), fd_coeff_x, fd_coeff_y, fd_coeff_z) ++ !$acc declare link(fd_coeff_x,fd_coeff_y,fd_coeff_z) ++ + #else + real(kind(0d0)), allocatable, dimension(:) :: Gs + !$acc declare create(Gs) +@@ -45,13 +52,17 @@ module m_hypoelastic + real(kind(0d0)), allocatable, dimension(:, :, :) :: rho_K_field, G_K_field + !$acc declare create(rho_K_field, G_K_field) + ++ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_x ++ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_y ++ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_z ++ !$acc declare create(fd_coeff_x,fd_coeff_y,fd_coeff_z) + #endif + + contains + + subroutine s_initialize_hypoelastic_module + +- integer :: i ++ integer :: i, k, r + + @:ALLOCATE_GLOBAL(Gs(1:num_fluids)) + @:ALLOCATE_GLOBAL(rho_K_field(0:m,0:n,0:p), G_K_field(0:m,0:n,0:p)) +@@ -69,6 +80,29 @@ contains + end do + !$acc update device(Gs) + ++ @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) ++ if (n > 0) then ++ @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) ++ end if ++ if (p > 0) then ++ @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) ++ end if ++ ++ ! Computing centered finite difference coefficients ++ call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & ++ fd_number, fd_order) ++ !$acc update device(fd_coeff_x) ++ if (n > 0) then ++ call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & ++ fd_number, fd_order) ++ !$acc update device(fd_coeff_y) ++ end if ++ if (p > 0) then ++ call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & ++ fd_number, fd_order) ++ !$acc update device(fd_coeff_z) ++ end if ++ + end subroutine s_initialize_hypoelastic_module + + !> The purpose of this procedure is to compute the source terms +@@ -84,7 +118,7 @@ contains + + real(kind(0d0)) :: rho_K, G_K + +- integer :: i, k, l, q !< Loop variables ++ integer :: i, k, l, q, r !< Loop variables + integer :: ndirs !< Number of coordinate directions + + ndirs = 1; if (n > 0) ndirs = 2; if (p > 0) ndirs = 3 +@@ -97,82 +131,91 @@ contains + do q = 0, p + do l = 0, n + do k = 0, m +- du_dx(k, l, q) = & +- (q_prim_vf(momxb)%sf(k - 2, l, q) & +- - 8d0*q_prim_vf(momxb)%sf(k - 1, l, q) & +- + 8d0*q_prim_vf(momxb)%sf(k + 1, l, q) & +- - q_prim_vf(momxb)%sf(k + 2, l, q)) & +- /(12d0*dx(k)) ++ du_dx(k, l, q) = 0d0; + end do + end do + end do ++ !$acc end parallel loop ++ ++ !$acc parallel loop collapse(3) gang vector default(present) ++ do q = 0, p ++ do l = 0, n ++ do k = 0, m ++ !$acc loop seq ++ do r = -fd_number, fd_number ++ du_dx(k, l, q) = du_dx(k, l, q) & ++ + q_prim_vf(momxb)%sf(k + r, l, q)*fd_coeff_x(r, k) ++ end do ++ ++ end do ++ end do ++ end do ++ !$acc end parallel loop + + if (ndirs > 1) then + !$acc parallel loop collapse(3) gang vector default(present) + do q = 0, p +- do l = 0, n +- do k = 0, m +- du_dy(k, l, q) = & +- (q_prim_vf(momxb)%sf(k, l - 2, q) & +- - 8d0*q_prim_vf(momxb)%sf(k, l - 1, q) & +- + 8d0*q_prim_vf(momxb)%sf(k, l + 1, q) & +- - q_prim_vf(momxb)%sf(k, l + 2, q)) & +- /(12d0*dy(l)) +- dv_dx(k, l, q) = & +- (q_prim_vf(momxb + 1)%sf(k - 2, l, q) & +- - 8d0*q_prim_vf(momxb + 1)%sf(k - 1, l, q) & +- + 8d0*q_prim_vf(momxb + 1)%sf(k + 1, l, q) & +- - q_prim_vf(momxb + 1)%sf(k + 2, l, q)) & +- /(12d0*dx(k)) +- dv_dy(k, l, q) = & +- (q_prim_vf(momxb + 1)%sf(k, l - 2, q) & +- - 8d0*q_prim_vf(momxb + 1)%sf(k, l - 1, q) & +- + 8d0*q_prim_vf(momxb + 1)%sf(k, l + 1, q) & +- - q_prim_vf(momxb + 1)%sf(k, l + 2, q)) & +- /(12d0*dy(l)) +- end do ++ do l = 0, n ++ do k = 0, m ++ du_dy(k, l, q) = 0d0; dv_dx(k, l, q) = 0d0; dv_dy(k, l, q) = 0d0; + end do ++ end do ++ end do ++ !$acc end parallel loop ++ ++ !$acc parallel loop collapse(3) gang vector default(present) ++ do q = 0, p ++ do l = 0, n ++ do k = 0, m ++ !$acc loop seq ++ do r = -fd_number, fd_number ++ du_dy(k, l, q) = du_dy(k, l, q) & ++ + q_prim_vf(momxb)%sf(k, l + r, q)*fd_coeff_y(r, l) ++ dv_dx(k, l, q) = dv_dx(k, l, q) & ++ + q_prim_vf(momxb + 1)%sf(k + r, l, q)*fd_coeff_x(r, k) ++ dv_dy(k, l, q) = dv_dy(k, l, q) & ++ + q_prim_vf(momxb + 1)%sf(k, l + r, q)*fd_coeff_y(r, l) ++ end do ++ end do ++ end do + end do ++ !$acc end parallel loop + + ! 3D + if (ndirs == 3) then ++ + !$acc parallel loop collapse(3) gang vector default(present) + do q = 0, p +- do l = 0, n +- do k = 0, m +- du_dz(k, l, q) = & +- (q_prim_vf(momxb)%sf(k, l, q - 2) & +- - 8d0*q_prim_vf(momxb)%sf(k, l, q - 1) & +- + 8d0*q_prim_vf(momxb)%sf(k, l, q + 1) & +- - q_prim_vf(momxb)%sf(k, l, q + 2)) & +- /(12d0*dz(q)) +- dv_dz(k, l, q) = & +- (q_prim_vf(momxb + 1)%sf(k, l, q - 2) & +- - 8d0*q_prim_vf(momxb + 1)%sf(k, l, q - 1) & +- + 8d0*q_prim_vf(momxb + 1)%sf(k, l, q + 1) & +- - q_prim_vf(momxb + 1)%sf(k, l, q + 2)) & +- /(12d0*dz(q)) +- dw_dx(k, l, q) = & +- (q_prim_vf(momxe)%sf(k - 2, l, q) & +- - 8d0*q_prim_vf(momxe)%sf(k - 1, l, q) & +- + 8d0*q_prim_vf(momxe)%sf(k + 1, l, q) & +- - q_prim_vf(momxe)%sf(k + 2, l, q)) & +- /(12d0*dx(k)) +- dw_dy(k, l, q) = & +- (q_prim_vf(momxe)%sf(k, l - 2, q) & +- - 8d0*q_prim_vf(momxe)%sf(k, l - 1, q) & +- + 8d0*q_prim_vf(momxe)%sf(k, l + 1, q) & +- - q_prim_vf(momxe)%sf(k, l + 2, q)) & +- /(12d0*dy(l)) +- dw_dz(k, l, q) = & +- (q_prim_vf(momxe)%sf(k, l, q - 2) & +- - 8d0*q_prim_vf(momxe)%sf(k, l, q - 1) & +- + 8d0*q_prim_vf(momxe)%sf(k, l, q + 1) & +- - q_prim_vf(momxe)%sf(k, l, q + 2)) & +- /(12d0*dz(q)) +- end do ++ do l = 0, n ++ do k = 0, m ++ du_dz(k, l, q) = 0d0; dv_dz(k, l, q) = 0d0; dw_dx(k, l, q) = 0d0; ++ dw_dy(k, l, q) = 0d0; dw_dz(k, l, q) = 0d0; + end do ++ end do ++ end do ++ !$acc end parallel loop ++ ++ !$acc parallel loop collapse(3) gang vector default(present) ++ do q = 0, p ++ do l = 0, n ++ do k = 0, m ++ !$acc loop seq ++ do r = -fd_number, fd_number ++ du_dz(k, l, q) = du_dz(k, l, q) & ++ + q_prim_vf(momxb)%sf(k, l, q + r)*fd_coeff_z(r, q) ++ dv_dz(k, l, q) = dv_dz(k, l, q) & ++ + q_prim_vf(momxb + 1)%sf(k, l, q + r)*fd_coeff_z(r, q) ++ dw_dx(k, l, q) = dw_dx(k, l, q) & ++ + q_prim_vf(momxe)%sf(k + r, l, q)*fd_coeff_x(r, k) ++ dw_dy(k, l, q) = dw_dy(k, l, q) & ++ + q_prim_vf(momxe)%sf(k, l + r, q)*fd_coeff_y(r, l) ++ dw_dz(k, l, q) = dw_dz(k, l, q) & ++ + q_prim_vf(momxe)%sf(k, l, q + r)*fd_coeff_z(r, q) ++ end do ++ end do ++ end do + end do ++ !$acc end parallel loop + end if + end if + +@@ -189,7 +232,7 @@ contains + G_K_field(k, l, q) = G_K + + !TODO: take this out if not needed +- if (G_K < 1000) then ++ if (G_K < verysmall) then + G_K_field(k, l, q) = 0 + end if + end do +@@ -314,4 +357,21 @@ contains + + end subroutine s_compute_hypoelastic_rhs + ++ subroutine s_finalize_hypoelastic_module() ! -------------------- ++ ++ @:DEALLOCATE_GLOBAL(Gs) ++ @:DEALLOCATE_GLOBAL(rho_K_field, G_K_field) ++ @:DEALLOCATE_GLOBAL(du_dx) ++ @:DEALLOCATE_GLOBAL(fd_coeff_x) ++ if (n > 0) then ++ @:DEALLOCATE_GLOBAL(du_dy,dv_dx,dv_dy) ++ @:DEALLOCATE_GLOBAL(fd_coeff_y) ++ if (p > 0) then ++ @:DEALLOCATE_GLOBAL(du_dz, dv_dz, dw_dx, dw_dy, dw_dz) ++ @:DEALLOCATE_GLOBAL(fd_coeff_z) ++ end if ++ end if ++ ++ end subroutine s_finalize_hypoelastic_module ++ + end module m_hypoelastic +diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp +index a0fa5972..01c34581 100644 +--- a/src/simulation/m_ibm.fpp ++++ b/src/simulation/m_ibm.fpp +@@ -208,7 +208,7 @@ contains + + if (model_eqns /= 4) then + ! If in simulation, use acc mixture subroutines +- if (hypoelasticity) then ++ if (elasticity) then + call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv_K, alpha_IP, & + alpha_rho_IP, Re_K, j, k, l, G_K, Gs) + else if (bubbles) then +diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp +index 26700d16..513d5bec 100644 +--- a/src/simulation/m_mpi_proxy.fpp ++++ b/src/simulation/m_mpi_proxy.fpp +@@ -173,7 +173,40 @@ contains + !! available to the other processors. Then, the purpose of + !! this subroutine is to distribute the user inputs to the + !! remaining processors in the communicator. +- subroutine s_mpi_bcast_user_inputs ++ ++ subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root) ++ ++#ifdef MFC_MPI ++ ++ implicit none ++ integer, intent(in) :: counts ! Array of vector lengths for each process ++ real(kind(0d0)), intent(in), dimension(counts) :: my_vector ! Input vector on each process ++ integer, intent(in) :: root ! Rank of the root process ++ real(kind(0d0)), allocatable, intent(out) :: gathered_vector(:) ! Gathered vector on the root process ++ ++ integer :: i, offset, ierr ++ integer, allocatable :: recounts(:), displs(:) ++ ++ allocate (recounts(num_procs)) ++ ++ call MPI_GATHER(counts, 1, MPI_INTEGER, recounts, 1, MPI_INTEGER, root, & ++ MPI_COMM_WORLD, ierr) ++ ++ allocate (displs(size(recounts))) ++ ++ displs(1) = 0 ++ ++ do i = 2, size(recounts) ++ displs(i) = displs(i - 1) + recounts(i - 1) ++ end do ++ ++ allocate (gathered_vector(sum(recounts))) ++ call MPI_GATHERV(my_vector, counts, MPI_DOUBLE_PRECISION, gathered_vector, recounts, displs, MPI_DOUBLE_PRECISION, & ++ root, MPI_COMM_WORLD, ierr) ++#endif ++ end subroutine s_mpi_gather_data ++ ++ subroutine s_mpi_bcast_user_inputs() ! --------------------------------- + + #ifdef MFC_MPI + +@@ -202,7 +235,8 @@ contains + & 'parallel_io', 'hypoelasticity', 'bubbles', 'polytropic', & + & 'polydisperse', 'qbmm', 'acoustic_source', 'probe_wrt', 'integral_wrt', & + & 'prim_vars_wrt', 'weno_avg', 'file_per_process', 'relax', & +- & 'adv_n', 'adap_dt', 'ib', 'bodyForces', 'bf_x', 'bf_y', 'bf_z' ] ++ & 'adv_n', 'adap_dt', 'ib', 'bodyForces', 'bf_x', 'bf_y', 'bf_z', & ++ & 'hyperelasticity' ] + call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) + #:endfor + +@@ -212,7 +246,8 @@ contains + & 'bc_y%vb1','bc_y%vb2','bc_y%vb3','bc_y%ve1','bc_y%ve2','bc_y%ve3', & + & 'bc_z%vb1','bc_z%vb2','bc_z%vb3','bc_z%ve1','bc_z%ve2','bc_z%ve3', & + & 'x_domain%beg', 'x_domain%end', 'y_domain%beg', 'y_domain%end', & +- & 'z_domain%beg', 'z_domain%end'] ++ & 'z_domain%beg', 'z_domain%end', 'x_a', 'x_b', 'y_a', 'y_b', 'z_a', & ++ & 'z_b'] + call MPI_BCAST(${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + #:endfor + +diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp +index c2056b42..72bb1c87 100644 +--- a/src/simulation/m_rhs.fpp ++++ b/src/simulation/m_rhs.fpp +@@ -39,6 +39,8 @@ module m_rhs + + use m_hypoelastic + ++ use m_hyperelastic ++ + use m_acoustic_src + + use m_viscous +@@ -615,7 +617,6 @@ contains + if (riemann_solver /= 1) then + do l = adv_idx%beg + 1, adv_idx%end + flux_src_n(i)%vf(l)%sf => flux_src_n(i)%vf(adv_idx%beg)%sf +- + !$acc enter data attach(flux_src_n(i)%vf(l)%sf) + end do + end if +@@ -623,7 +624,6 @@ contains + do l = 1, sys_size + flux_n(i)%vf(l)%sf => flux_n(1)%vf(l)%sf + flux_src_n(i)%vf(l)%sf => flux_src_n(1)%vf(l)%sf +- + !$acc enter data attach(flux_n(i)%vf(l)%sf,flux_src_n(i)%vf(l)%sf) + end do + end if +@@ -778,7 +778,7 @@ contains + end do + end do + end if +- ++ !print *, "I got here A" + call nvtxStartRange("RHS-CONVERT") + call s_convert_conservative_to_primitive_variables( & + q_cons_qp%vf, & +@@ -786,10 +786,16 @@ contains + gm_alpha_qp%vf, & + ix, iy, iz) + call nvtxEndRange ++ !print *, "I got here B" + + call nvtxStartRange("RHS-MPI") + call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) + call nvtxEndRange ++ !print *, "I got here c" ++ ++ call nvtxStartRange("RHS-ELASTIC") ++ if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_qp%vf,q_prim_qp%vf) ++ call nvtxEndRange + + if (t_step == t_step_stop) return + ! ================================================================== +@@ -897,10 +903,8 @@ contains + end if + ix%end = m; iy%end = n; iz%end = p + ! =============================================================== +- call nvtxStartRange("RHS_riemann_solver") +- + ! Computing Riemann Solver Flux and Source Flux ================= +- ++ call nvtxStartRange("RHS_riemann_solver") + call s_riemann_solver(qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, & + dqR_prim_dx_n(id)%vf, & + dqR_prim_dy_n(id)%vf, & +@@ -917,9 +921,10 @@ contains + flux_gsrc_n(id)%vf, & + id, ix, iy, iz) + call nvtxEndRange ++ !print *, "I got here e" + +- ! Additional physics and source terms ============================== +- ++ ! =============================================================== ++ ! Additional physics and source terms =========================== + ! RHS addition for advection source + call nvtxStartRange("RHS_advection_source") + call s_compute_advection_source_term(id, & +@@ -935,6 +940,7 @@ contains + q_prim_qp%vf, & + rhs_vf) + call nvtxEndRange ++ !print *, "I got here f" + + ! RHS additions for viscosity + call nvtxStartRange("RHS_add_phys") +@@ -1006,6 +1012,7 @@ contains + rhs_vf) + call nvtxEndRange + ! END: Additional pphysics and source terms ============================ ++ !print *, "I got here g" + + if (run_time_info .or. probe_wrt .or. ib) then + +@@ -1033,6 +1040,7 @@ contains + time_avg = 0d0 + end if + ! ================================================================== ++ !print *, "I got here h" + + call nvtxEndRange + end subroutine s_compute_rhs +diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp +index bfca7142..f0d4b3e6 100644 +--- a/src/simulation/m_riemann_solvers.fpp ++++ b/src/simulation/m_riemann_solvers.fpp +@@ -162,14 +162,14 @@ module m_riemann_solvers + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsx_vf, flux_src_rsx_vf) + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsy_vf, flux_src_rsy_vf) + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsz_vf, flux_src_rsz_vf) +- !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & +- !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) ++ !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & ++ !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) + #else + real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsx_vf, flux_src_rsx_vf + real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsy_vf, flux_src_rsy_vf + real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsz_vf, flux_src_rsz_vf +- !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & +- !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) ++ !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & ++ !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf) + #endif + !> @} + +@@ -313,6 +313,7 @@ contains + real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R + real(kind(0d0)) :: G_L, G_R + real(kind(0d0)), dimension(2) :: Re_L, Re_R ++ real(kind(0d0)), dimension(3) :: xi_field_L, xi_field_R + + real(kind(0d0)) :: rho_avg + real(kind(0d0)), dimension(num_dims) :: vel_avg +@@ -356,8 +357,7 @@ contains + #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] + + if (norm_dir == ${NORM_DIR}$) then +- !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, & +- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S) ++ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, xi_field_L, xi_field_R) + do l = is3%beg, is3%end + do k = is2%beg, is2%end + do j = is1%beg, is1%end +@@ -440,31 +440,24 @@ contains + !$acc loop seq + do i = 1, 2 + Re_L(i) = dflt_real +- + if (Re_size(i) > 0) Re_L(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_L(i) = alpha_L(Re_idx(i, q))/Res(i, q) & + + Re_L(i) + end do +- + Re_L(i) = 1d0/max(Re_L(i), sgm_eps) +- + end do + + !$acc loop seq + do i = 1, 2 + Re_R(i) = dflt_real +- + if (Re_size(i) > 0) Re_R(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_R(i) = alpha_R(Re_idx(i, q))/Res(i, q) & + + Re_R(i) + end do +- + Re_R(i) = 1d0/max(Re_R(i), sgm_eps) + end do + end if +@@ -472,26 +465,17 @@ contains + E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L + E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R + +- H_L = (E_L + pres_L)/rho_L +- H_R = (E_R + pres_R)/rho_R +- ++ ! elastic energy update + if (hypoelasticity) then +- !$acc loop seq +- do i = 1, strxe - strxb + 1 +- tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) +- tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) +- end do +- +- G_L = 0d0 +- G_R = 0d0 +- ++ G_L = 0d0; G_R = 0d0 + !$acc loop seq + do i = 1, num_fluids + G_L = G_L + alpha_L(i)*Gs(i) + G_R = G_R + alpha_R(i)*Gs(i) + end do +- + do i = 1, strxe - strxb + 1 ++ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + ! Elastic contribution to energy if G large enough + !TODO take out if statement if stable without + if ((G_L > 1000) .and. (G_R > 1000)) then +@@ -506,19 +490,57 @@ contains + end do + end if + ++ ! elastic energy update ++ !if ( hyperelasticity ) then ++ ! G_L = 0d0 ++ ! G_R = 0d0 ++ ! ++ ! !$acc loop seq ++ ! do i = 1, num_fluids ++ ! G_L = G_L + alpha_L(i)*Gs(i) ++ ! G_R = G_R + alpha_R(i)*Gs(i) ++ ! end do ++ ! ! Elastic contribution to energy if G large enough ++ ! if ((G_L > 1d-3) .and. (G_R > 1d-3)) then ++ ! E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) ++ ! E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) ++ ! !$acc loop seq ++ ! do i = 1, b_size-1 ++ ! tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ ! tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ++ ! end do ++ ! !$acc loop seq ++ ! do i = 1, b_size-1 ++ ! tau_e_L(i) = 0d0 ++ ! tau_e_R(i) = 0d0 ++ ! end do ++ ! !$acc loop seq ++ ! do i = 1, num_dims ++ ! xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) ++ ! xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) ++ ! end do ++ ! end if ++ !end if ++ ++ ! Enthalpy with elastic energy ++ H_L = (E_L + pres_L)/rho_L ++ H_R = (E_R + pres_R)/rho_R ++ + @:compute_average_state() + + call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & +- vel_L_rms, c_L) ++ vel_L_rms, c_L, Gs) + + call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & +- vel_R_rms, c_R) ++ vel_R_rms, c_R, Gs) + + !> The computation of c_avg does not require all the variables, and therefore the non '_avg' + ! variables are placeholders to call the subroutine. + + call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & +- vel_avg_rms, c_avg) ++ vel_avg_rms, c_avg, Gs) ++ ++ !SGR added Gs to all of the above speed of sound clacs + + if (any(Re_size > 0)) then + !$acc loop seq +@@ -541,6 +563,11 @@ contains + , vel_L(dir_idx(1)) + sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + & + tau_e_L(dir_idx_tau(1)))/rho_L)) ++ else if (hyperelasticity) then ++ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L) & ++ , vel_R(dir_idx(1)) - sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R)) ++ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R) & ++ , vel_L(dir_idx(1)) + sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L)) + else + s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) + s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) +@@ -716,6 +743,18 @@ contains + /(s_M - s_P) + end do + ++ ! Xi field ++ !if ( hyperelasticity ) then ++ ! do i = 1, num_dims ++ ! flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & ++ ! (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & ++ ! - s_P*rho_L*vel_L(dir_idx(1))*xi_field_L(i) & ++ ! + s_M*s_P*(rho_L*xi_field_L(i) & ++ ! - rho_R*xi_field_R(i))) & ++ ! /(s_M - s_P) ++ ! end do ++ !end if ++ + ! Div(U)? + !$acc loop seq + do i = 1, num_dims +@@ -822,7 +861,6 @@ contains + + real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf + type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf +- + type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf + + type(scalar_field), & +@@ -862,6 +900,11 @@ contains + real(kind(0d0)) :: s_L, s_R, s_M, s_P, s_S + real(kind(0d0)) :: xi_L, xi_R !< Left and right wave speeds functions + real(kind(0d0)) :: xi_M, xi_P ++ real(kind(0d0)) :: xi_MP, xi_PP ++ ++ real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R ++ real(kind(0d0)), dimension(num_dims) :: xi_field_L, xi_field_R ++ real(kind(0d0)) :: G_L, G_R + + real(kind(0d0)) :: nbub_L, nbub_R + real(kind(0d0)), dimension(nb) :: R0_L, R0_R +@@ -880,9 +923,10 @@ contains + real(kind(0d0)) :: vel_L_rms, vel_R_rms, vel_avg_rms + real(kind(0d0)) :: vel_L_tmp, vel_R_tmp + real(kind(0d0)) :: blkmod1, blkmod2 +- real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star ++ real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star, vel_K_Star + real(kind(0d0)) :: pres_SL, pres_SR, Ms_L, Ms_R + real(kind(0d0)) :: start, finish ++ real(kind(0d0)) :: flux_ene_e + real(kind(0d0)) :: zcoef, pcorr !< low Mach number correction + integer :: i, j, k, l, q !< Generic loop iterators + integer :: idx1, idxi +@@ -909,15 +953,16 @@ contains + flux_gsrc_vf, & + norm_dir, ix, iy, iz) + ++ idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 ++ + #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] + + if (norm_dir == ${NORM_DIR}$) then ++ ++ ! 6-EQUATION MODEL WITH HLLC + if (model_eqns == 3) then + !ME3 +- +- !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & +- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R) +- ++ !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R, flux_ene_e, xi_field_L, xi_field_R) + do l = is3%beg, is3%end + do k = is2%beg, is2%end + do j = is1%beg, is1%end +@@ -994,39 +1039,85 @@ contains + !$acc loop seq + do i = 1, 2 + Re_L(i) = dflt_real +- + if (Re_size(i) > 0) Re_L(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + + Re_L(i) + end do +- + Re_L(i) = 1d0/max(Re_L(i), sgm_eps) +- + end do + + !$acc loop seq + do i = 1, 2 + Re_R(i) = dflt_real +- + if (Re_size(i) > 0) Re_R(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + + Re_R(i) + end do +- + Re_R(i) = 1d0/max(Re_R(i), sgm_eps) + end do + end if + + E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L +- + E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R + ++ ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY ++ if (hypoelasticity) then ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ++ end do ++ G_L = 0d0; G_R = 0d0 ++ !$acc loop seq ++ do i = 1, num_fluids ++ G_L = G_L + alpha_L(i)*Gs(i) ++ G_R = G_R + alpha_R(i)*Gs(i) ++ end do ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ ! Elastic contribution to energy if G large enough ++ if ((G_L > verysmall) .and. (G_R > verysmall)) then ++ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) ++ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) ++ ! Additional terms in 2D and 3D ++ if ((i == 2) .or. (i == 4) .or. (i == 5)) then ++ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) ++ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) ++ end if ++ end if ++ end do ++ end if ++ ++ ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY ++ if (hyperelasticity) then ++ !$acc loop seq ++ do i = 1, num_dims ++ xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) ++ xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) ++ end do ++ G_L = 0d0; G_R = 0d0; ++ !$acc loop seq ++ do i = 1, num_fluids ++ ! Mixture left and right shear modulus ++ G_L = G_L + alpha_L(i)*Gs(i) ++ G_R = G_R + alpha_R(i)*Gs(i) ++ end do ++ ! Elastic contribution to energy if G large enough ++ if ( G_L > verysmall .and. G_R > verysmall ) then ++ E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) ++ E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) ++ end if ++ !$acc loop seq ++ do i = 1, b_size - 1 ++ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ++ end do ++ end if ++ + H_L = (E_L + pres_L)/rho_L + H_R = (E_R + pres_R)/rho_R + +@@ -1034,13 +1125,10 @@ contains + + call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & + vel_L_rms, c_L) +- + call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & + vel_R_rms, c_R) +- + !> The computation of c_avg does not require all the variables, and therefore the non '_avg' + ! variables are placeholders to call the subroutine. +- + call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & + vel_avg_rms, c_avg) + +@@ -1051,222 +1139,226 @@ contains + end do + end if + ++ ! COMPUTING THE DIRECT WAVE SPEEDS + if (wave_speeds == 1) then +- s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) +- s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) ++ if (elasticity) then ++ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & ++ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & ++ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) ++ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & ++ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & ++ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) ++ s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & ++ tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & ++ rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & ++ rho_R*(s_R - vel_R(idx1))) ++ else ++ s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) ++ s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) ++ s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & ++ (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & ++ /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) + +- s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & +- (s_L - vel_L(dir_idx(1))) - & +- rho_R*vel_R(dir_idx(1))* & +- (s_R - vel_R(dir_idx(1)))) & +- /(rho_L*(s_L - vel_L(dir_idx(1))) - & +- rho_R*(s_R - vel_R(dir_idx(1)))) ++ end if + elseif (wave_speeds == 2) then + pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & + (vel_L(dir_idx(1)) - & + vel_R(dir_idx(1)))) +- + pres_SR = pres_SL +- + Ms_L = max(1d0, sqrt(1d0 + ((5d-1 + gamma_L)/(1d0 + gamma_L))* & + (pres_SL/pres_L - 1d0)*pres_L/ & + ((pres_L + pi_inf_L/(1d0 + gamma_L))))) + Ms_R = max(1d0, sqrt(1d0 + ((5d-1 + gamma_R)/(1d0 + gamma_R))* & + (pres_SR/pres_R - 1d0)*pres_R/ & + ((pres_R + pi_inf_R/(1d0 + gamma_R))))) +- + s_L = vel_L(dir_idx(1)) - c_L*Ms_L + s_R = vel_R(dir_idx(1)) + c_R*Ms_R +- + s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & + (pres_L - pres_R)/ & + (rho_avg*c_avg)) + end if + +- if (s_L >= 0d0) then +- p_Star = pres_L ! Only useful to recalculate the radial momentum geometric source flux +- !$acc loop seq +- do i = 1, num_fluids +- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)*s_S ++ ! follows Einfeldt et al. ++ ! s_M/P = min/max(0.,s_L/R) ++ s_M = min(0d0, s_L); s_P = max(0d0, s_R) + +- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)*vel_L(dir_idx(1)) ++ ! goes with q_star_L/R = xi_L/R * (variable) ++ ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) ) ++ xi_L = (s_L - vel_L(idx1))/(s_L - s_S) ++ xi_R = (s_R - vel_R(idx1))/(s_R - s_S) + +- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & +- (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & +- (gammas(i)*pres_L + pi_infs(i)) + & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & +- qvs(i))*vel_L(dir_idx(1)) +- end do +- !$acc loop seq +- do i = 1, num_dims +- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & +- rho_L*vel_L(dir_idx(1))*vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*pres_L ++ ! goes with numerical star velocity in x/y/z directions ++ ! xi_P/M = 0.5 +/m sgn(0.5,s_star) ++ xi_M = (5d-1 + sign(5d-1, s_S)) ++ xi_P = (5d-1 - sign(5d-1, s_S)) + +- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & +- dir_flg(dir_idx(i))*(s_S - vel_L(dir_idx(i))) +- ! Compute the star velocities for the non-conservative terms +- end do +- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_L + pres_L)*vel_L(dir_idx(1)) ++ ! goes with the numerical velocity in x/y/z directions ++ ! xi_P/M (pressure) = min/max(0. sgn(1,sL/sR)) ++ xi_MP = -min(0d0, sign(1d0, s_L)) ++ xi_PP = max(0d0, sign(1d0, s_R)) + +- if (.not. f_is_default(sigma)) then +- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, c_idx)*s_S +- end if ++ ! COMPUTING FLUXES ++ ! MASS FLUX. ++ !$acc loop seq ++ do i = 1, contxe ++ flux_rs${XYZ}$_vf(j, k, l, i) = & ++ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & ++ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) ++ end do + +- ! Compute right solution state +- else if (s_R <= 0d0) then +- p_Star = pres_R +- ! Only useful to recalculate the radial momentum geometric source flux +- !$acc loop seq +- do i = 1, num_fluids +- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)*s_S ++ ! MOMENTUM FLUX. ++ ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) ++ !$acc loop seq ++ do i = 1, num_dims ++ !idxi = dir_idx(i) ++ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & ++ xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & ++ (1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & ++ xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & ++ (1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) ++ end do + +- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)*vel_R(dir_idx(1)) ++ ! ENERGY FLUX. ++ ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) ++ flux_rs${XYZ}$_vf(j, k, l, E_idx) = & ++ xi_M*(vel_L(idx1)*(E_L + pres_L) + & ++ s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & ++ + xi_P*(vel_R(idx1)*(E_R + pres_R) + & ++ s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) ++ ++ ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux ++ if (elasticity) then ++ flux_ene_e = 0d0; ++ !$acc loop seq ++ do i = 1, num_dims ++ ! MOMENTUM ELASTIC FLUX. ++ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & ++ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) & ++ - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) ++ ! ENERGY ELASTIC FLUX. ++ flux_ene_e = flux_ene_e - & ++ xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & ++ s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & ++ xi_P*(vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & ++ s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) ++ end do ++ flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e ++ end if + +- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & +- (qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)* & +- (gammas(i)*pres_R + pi_infs(i)) + & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)* & +- qvs(i))*vel_R(dir_idx(1)) +- end do +- !$acc loop seq +- do i = 1, num_dims +- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & +- rho_R*vel_R(dir_idx(1))*vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*pres_R ++ ! VOLUME FRACTION FLUX. ++ !$acc loop seq ++ do i = advxb, advxe ++ flux_rs${XYZ}$_vf(j, k, l, i) = & ++ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*s_S + & ++ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*s_S ++ end do + +- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & +- dir_flg(dir_idx(i))*(s_S - vel_R(dir_idx(i))) +- ! Compute the star velocities for the non-conservative terms +- end do +- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_R + pres_R)*vel_R(dir_idx(1)) ++ ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. ++ !$acc loop seq ++ do i = 1, num_dims ++ !idxi = dir_idx(i) ++ vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = & ++ xi_M*(vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_MP*(xi_L - 1) + 1) - vel_L(dir_idx(i)))) + & ++ xi_P*(vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(dir_idx(i)))) ++ end do + +- if (.not. f_is_default(sigma)) then +- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx)*s_S +- end if ++ ! INTERNAL ENERGIES ADVECTION FLUX. ++ ! K-th pressure and velocity in preparation for the internal energy flux ++ vel_K_Star = vel_L(idx1)*(1d0 - xi_MP) + xi_MP*vel_R(idx1) + & ++ xi_MP*xi_PP*(s_S - vel_R(idx1)) ++ !$acc loop seq ++ do i = 1, num_fluids ++ p_K_Star = xi_M*(xi_MP*((pres_L + pi_infs(i)/(1d0 + gammas(i)))* & ++ xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - pres_L) + pres_L) + & ++ xi_P*(xi_PP*((pres_R + pi_infs(i)/(1d0 + gammas(i)))* & ++ xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - pres_R) + pres_R) ++ ++ flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & ++ (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & ++ (gammas(i)*p_K_Star + pi_infs(i)) + & ++ qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & ++ qvs(i))*vel_K_Star ++ end do + +- ! Compute left star solution state +- else if (s_S >= 0d0) then +- xi_L = (s_L - vel_L(dir_idx(1)))/(s_L - s_S) +- rho_Star = rho_L*xi_L +- E_Star = xi_L*(E_L + (s_S - vel_L(dir_idx(1)))* & +- (rho_L*s_S + pres_L/(s_L - vel_L(dir_idx(1))))) +- p_Star = rho_L*(s_L - vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1))) + pres_L +- !$acc loop seq +- do i = 1, num_fluids +- p_K_Star = (pres_L + pi_infs(i)/(1d0 + gammas(i)))* & +- xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) ++ flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) + +- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)*s_S ++ ! HYPOELASTIC STRESS EVOLUTION FLUX. ++ if (hypoelasticity) then ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & ++ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & ++ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) ++ end do ++ end if + +- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)*xi_L*s_S ++ ! REFERENCE MAP FLUX. ++ if (hyperelasticity) then ++ !$acc loop seq ++ do i = 1, num_dims ++ flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & ++ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*xi_field_L(i) & ++ - rho_L*vel_L(idx1)*xi_field_L(i)) + & ++ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*xi_field_R(i) & ++ - rho_R*vel_R(idx1)*xi_field_R(i)) ++ end do ++ end if + +- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & +- (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & +- (gammas(i)*p_K_Star + pi_infs(i)) + & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & +- qvs(i))*s_S +- end do +- !$acc loop seq +- do i = 1, num_dims +- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & +- rho_Star*s_S*(s_S*dir_flg(dir_idx(i)) + vel_L(dir_idx(i))* & +- (1d0 - dir_flg(dir_idx(i)))) + dir_flg(dir_idx(i))*p_Star ++ ! SURFACE TENSION FLUX. need to check ++ if (.not. f_is_default(sigma)) then ++ flux_rs${XYZ}$_vf(j, k, l, c_idx) = & ++ (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & ++ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S ++ end if + +- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & +- dir_flg(dir_idx(i))*(s_S*xi_L - vel_L(dir_idx(i))) +- ! Compute the star velocities for the non-conservative terms +- end do +- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_Star + p_Star)*s_S ++ ! correction pressure for the cylindrical terms ++ p_Star = xi_M*(pres_L + xi_MP*rho_L*(s_L - & ++ vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1)))) + & ++ xi_P*(pres_R + xi_PP*rho_R*(s_R - & ++ vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1)))) + +- if (.not. f_is_default(sigma)) then +- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, c_idx)*s_S ++ ! Geometrical source flux for cylindrical coordinates ++ #:if (NORM_DIR == 2) ++ if (cyl_coord) then ++ !Substituting the advective flux into the inviscid geometrical source flux ++ !$acc loop seq ++ do i = 1, E_idx ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) ++ end do ++ !$acc loop seq ++ do i = intxb, intxe ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) ++ end do ++ ! Recalculating the radial momentum geometric source flux ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star ++ ! Geometrical source of the void fraction(s) is zero ++ !$acc loop seq ++ do i = advxb, advxe ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 ++ end do + end if ++ #:endif ++ #:if (NORM_DIR == 3) ++ if (grid_geometry == 3) then ++ !$acc loop seq ++ do i = 1, sys_size ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 ++ end do ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star + +- ! Compute right star solution state +- else +- xi_R = (s_R - vel_R(dir_idx(1)))/(s_R - s_S) +- +- rho_Star = rho_R*xi_R +- +- E_Star = xi_R*(E_R + (s_S - vel_R(dir_idx(1)))* & +- (rho_R*s_S + pres_R/(s_R - vel_R(dir_idx(1))))) +- +- p_Star = rho_R*(s_R - vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1))) + pres_R +- !$acc loop seq +- do i = 1, num_fluids +- p_K_Star = (pres_R + pi_infs(i)/(1d0 + gammas(i)))* & +- xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) +- +- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)*s_S +- +- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)*xi_R*s_S +- +- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & +- (qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)* & +- (gammas(i)*p_K_Star + pi_infs(i)) + & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)* & +- qvs(i))*s_S +- end do +- !$acc loop seq +- do i = 1, num_dims +- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = rho_Star*s_S* & +- (s_S*dir_flg(dir_idx(i)) + vel_R(dir_idx(i))*(1d0 - dir_flg(dir_idx(i)))) + & +- dir_flg(dir_idx(i))*p_Star +- +- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & +- dir_flg(dir_idx(i))*(s_S*xi_R - vel_R(dir_idx(i))) +- ! Compute the star velocities for the non-conservative terms +- end do +- +- if (.not. f_is_default(sigma)) then +- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx)*s_S ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) + end if +- +- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_Star + p_Star)*s_S +- +- end if +- +- flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) +- +- ! Geometrical source flux for cylindrical coordinates +- if (cyl_coord .and. norm_dir == 2) then +- ! Substituting the advective flux into the inviscid geometrical source flux +- !$acc loop seq +- do i = 1, E_idx +- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) +- end do +- !$acc loop seq +- do i = intxb, intxe +- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) +- end do +- ! Recalculating the radial momentum geometric source flux (subtracting the pressure part) +- flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & +- flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star +- ! Geometrical source of the void fraction(s) is zero +- !$acc loop seq +- do i = advxb, advxe +- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 +- end do +- end if ++ #:endif + + end do + end do + end do ++ + elseif (model_eqns == 4) then + !ME4 +- !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, & +- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) ++ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) + do l = is3%beg, is3%end + do k = is2%beg, is2%end + do j = is1%beg, is1%end +@@ -1632,11 +1724,11 @@ contains + end if + + E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms +- + E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + + H_L = (E_L + pres_L)/rho_L + H_R = (E_R + pres_R)/rho_R ++ + if (avg_state == 2) then + !$acc loop seq + do i = 1, nb +@@ -1749,13 +1841,11 @@ contains + + call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & + vel_L_rms, c_L) +- + call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & + vel_R_rms, c_R) + + !> The computation of c_avg does not require all the variables, and therefore the non '_avg' + ! variables are placeholders to call the subroutine. +- + call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & + vel_avg_rms, c_avg) + +@@ -1861,7 +1951,6 @@ contains + + ! Energy flux. + ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) +- + flux_rs${XYZ}$_vf(j, k, l, E_idx) = & + xi_M*(vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) + & + s_M*(xi_L*(E_L + (s_S - vel_L(dir_idx(1)))* & +@@ -1874,7 +1963,6 @@ contains + + (s_M/s_L)*(s_P/s_R)*pcorr*s_S + + ! Volume fraction flux +- + !$acc loop seq + do i = advxb, advxe + flux_rs${XYZ}$_vf(j, k, l, i) = & +@@ -1980,8 +2068,10 @@ contains + end do + !$acc end parallel loop + else ++ ! 5-EQUATION MODEL WITH HLLC, INTERFACE CAPTURING ONLY + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & +- !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp) copyin(is1,is2,is3) ++ !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, & ++ !$acc tau_e_L, tau_e_R, xi_field_L, xi_field_R, vel_L_tmp, vel_R_tmp) copyin(is1,is2,is3) + do l = is3%beg, is3%end + do k = is2%beg, is2%end + do j = is1%beg, is1%end +@@ -2064,39 +2154,85 @@ contains + !$acc loop seq + do i = 1, 2 + Re_L(i) = dflt_real +- + if (Re_size(i) > 0) Re_L(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + + Re_L(i) + end do +- + Re_L(i) = 1d0/max(Re_L(i), sgm_eps) +- + end do + + !$acc loop seq + do i = 1, 2 + Re_R(i) = dflt_real +- + if (Re_size(i) > 0) Re_R(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + + Re_R(i) + end do +- + Re_R(i) = 1d0/max(Re_R(i), sgm_eps) + end do + end if + + E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L +- + E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R + ++ ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY ++ if (hypoelasticity) then ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ++ end do ++ G_L = 0d0; G_R = 0d0 ++ !$acc loop seq ++ do i = 1, num_fluids ++ G_L = G_L + alpha_L(i)*Gs(i) ++ G_R = G_R + alpha_R(i)*Gs(i) ++ end do ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ ! Elastic contribution to energy if G large enough ++ if ((G_L > verysmall) .and. (G_R > verysmall)) then ++ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) ++ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) ++ ! Additional terms in 2D and 3D ++ if ((i == 2) .or. (i == 4) .or. (i == 5)) then ++ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) ++ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) ++ end if ++ end if ++ end do ++ end if ++ ++ ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY ++ if (hyperelasticity) then ++ !$acc loop seq ++ do i = 1, num_dims ++ xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) ++ xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) ++ end do ++ G_L = 0d0; G_R = 0d0; ++ !$acc loop seq ++ do i = 1, num_fluids ++ ! Mixture left and right shear modulus ++ G_L = G_L + alpha_L(i)*Gs(i) ++ G_R = G_R + alpha_R(i)*Gs(i) ++ end do ++ ! Elastic contribution to energy if G large enough ++ if ( G_L > verysmall .and. G_R > verysmall ) then ++ E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) ++ E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) ++ end if ++ !$acc loop seq ++ do i = 1, b_size - 1 ++ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ++ end do ++ end if ++ + H_L = (E_L + pres_L)/rho_L + H_R = (E_R + pres_R)/rho_R + +@@ -2110,7 +2246,6 @@ contains + + !> The computation of c_avg does not require all the variables, and therefore the non '_avg' + ! variables are placeholders to call the subroutine. +- + call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & + vel_avg_rms, c_avg) + +@@ -2126,16 +2261,25 @@ contains + end if + + if (wave_speeds == 1) then +- s_L = min(vel_L(idx1) - c_L, vel_R(idx1) - c_R) +- s_R = max(vel_R(idx1) + c_R, vel_L(idx1) + c_L) +- +- s_S = (pres_R - pres_L + rho_L*vel_L(idx1)* & +- (s_L - vel_L(idx1)) - & +- rho_R*vel_R(idx1)* & +- (s_R - vel_R(idx1))) & +- /(rho_L*(s_L - vel_L(idx1)) - & +- rho_R*(s_R - vel_R(idx1))) ++ if (elasticity) then ++ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & ++ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & ++ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) ++ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & ++ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & ++ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) ++ s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & ++ tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & ++ rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & ++ rho_R*(s_R - vel_R(idx1))) ++ else ++ s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) ++ s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) ++ s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & ++ (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & ++ /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) + ++ end if + elseif (wave_speeds == 2) then + pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & + (vel_L(idx1) - & +@@ -2172,6 +2316,8 @@ contains + xi_M = (5d-1 + sign(5d-1, s_S)) + xi_P = (5d-1 - sign(5d-1, s_S)) + ++ ! COMPUTING THE HLLC FLUXES ++ ! MASS FLUX. + if (low_Mach == 1) then + @:compute_low_Mach_correction() + else +@@ -2181,75 +2327,88 @@ contains + !$acc loop seq + do i = 1, contxe + flux_rs${XYZ}$_vf(j, k, l, i) = & +- xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & +- *(vel_L(idx1) + s_M*(xi_L - 1d0)) & +- + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & +- *(vel_R(idx1) + s_P*(xi_R - 1d0)) ++ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & ++ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) + end do + +- ! Momentum flux. +- ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w) +- !$acc loop seq ++ ! MOMENTUM FLUX. ++ ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) ++ !$acc loop seq + do i = 1, num_dims +- idxi = dir_idx(i) +- flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & +- xi_M*(rho_L*(vel_L(idx1)* & +- vel_L(idxi) + & +- s_M*(xi_L*(dir_flg(idxi)*s_S + & +- (1d0 - dir_flg(idxi))* & +- vel_L(idxi)) - vel_L(idxi))) + & +- dir_flg(idxi)*(pres_L)) & +- + xi_P*(rho_R*(vel_R(idx1)* & +- vel_R(idxi) + & +- s_P*(xi_R*(dir_flg(idxi)*s_S + & +- (1d0 - dir_flg(idxi))* & +- vel_R(idxi)) - vel_R(idxi))) + & +- dir_flg(idxi)*(pres_R)) & +- + (s_M/s_L)*(s_P/s_R)*dir_flg(idxi)*pcorr ++ !idxi = dir_idx(i) ++ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & ++ xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & ++ (1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & ++ xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & ++ (1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) & ++ + (s_M/s_L)*(s_P/s_R)*dir_flg(dir_idx(i))*pcorr + end do + +- ! Energy flux. +- ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) ++ ! ENERGY FLUX. ++ ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) + flux_rs${XYZ}$_vf(j, k, l, E_idx) = & + xi_M*(vel_L(idx1)*(E_L + pres_L) + & +- s_M*(xi_L*(E_L + (s_S - vel_L(idx1))* & +- (rho_L*s_S + pres_L/ & +- (s_L - vel_L(idx1)))) - E_L)) & ++ s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & + + xi_P*(vel_R(idx1)*(E_R + pres_R) + & +- s_P*(xi_R*(E_R + (s_S - vel_R(idx1))* & +- (rho_R*s_S + pres_R/ & +- (s_R - vel_R(idx1)))) - E_R)) & ++ s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) & + + (s_M/s_L)*(s_P/s_R)*pcorr*s_S + +- ! Volume fraction flux ++ ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux ++ if (elasticity) then ++ flux_ene_e = 0d0; ++ !$acc loop seq ++ do i = 1, num_dims ++ ! MOMENTUM ELASTIC FLUX. ++ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & ++ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) & ++ - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) ++ ! ENERGY ELASTIC FLUX. ++ flux_ene_e = flux_ene_e - & ++ xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & ++ s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & ++ xi_P*(vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & ++ s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) ++ end do ++ flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e ++ end if ++ ++ ! HYPOELASTIC STRESS EVOLUTION FLUX. ++ if (hypoelasticity) then ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & ++ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & ++ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) ++ end do ++ end if ++ ++ ! VOLUME FRACTION FLUX. + !$acc loop seq + do i = advxb, advxe +- flux_rs${XYZ}$_vf(j, k, l, i) = & +- xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & +- *(vel_L(idx1) + s_M*(xi_L - 1d0)) & +- + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & +- *(vel_R(idx1) + s_P*(xi_R - 1d0)) ++ flux_rs${XYZ}$_vf(j, k, l, i) = & ++ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & ++ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) + end do + +- ! Source for volume fraction advection equation ++ ! VOLUME FRACTION SOURCE FLUX. + !$acc loop seq + do i = 1, num_dims + idxi = dir_idx(i) + vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & +- xi_M*(vel_L(idxi) + & +- dir_flg(idxi)* & +- s_M*(xi_L - 1d0)) & +- + xi_P*(vel_R(idxi) + & +- dir_flg(idxi)* & +- s_P*(xi_R - 1d0)) +- +- !if ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0d0 ++ xi_M*(vel_L(idxi) + dir_flg(idxi)*s_M*(xi_L - 1d0)) + & ++ xi_P*(vel_R(idxi) + dir_flg(idxi)*s_P*(xi_R - 1d0)) + end do + + flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) + +- ! Geometrical source flux for cylindrical coordinates ++ ! SURFACE TENSION FLUX. need to check ++ !if (.not. f_is_default(sigma)) then ++ ! flux_rs${XYZ}$_vf(j, k, l, c_idx) = & ++ ! (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & ++ ! xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S ++ !end if + ++ ! Geometrical source flux for cylindrical coordinates + #:if (NORM_DIR == 2) + if (cyl_coord) then + !Substituting the advective flux into the inviscid geometrical source flux +@@ -2544,7 +2703,7 @@ contains + + !$acc update device(is1, is2, is3) + +- if (hypoelasticity) then ++ if (elasticity) then + if (norm_dir == 1) then + dir_idx_tau = (/1, 2, 4/) + else if (norm_dir == 2) then +diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp +index 5e1c6f6e..10158e8e 100644 +--- a/src/simulation/m_start_up.fpp ++++ b/src/simulation/m_start_up.fpp +@@ -46,9 +46,10 @@ module m_start_up + + use m_derived_variables !< Procedures used to compute quantities derived + !! from the conservative and primitive variables +- + use m_hypoelastic + ++ use m_hyperelastic ++ + use m_phase_change !< Phase-change module + + use m_viscous +@@ -139,6 +140,7 @@ contains + teno_CT, mp_weno, weno_avg, & + riemann_solver, low_Mach, wave_speeds, avg_state, & + bc_x, bc_y, bc_z, & ++ x_a, y_a, z_a, x_b, y_b, z_b, & + x_domain, y_domain, z_domain, & + hypoelasticity, & + ib, num_ibs, patch_ib, & +@@ -146,8 +148,8 @@ contains + fd_order, probe, num_probes, t_step_old, & + alt_soundspeed, mixture_err, weno_Re_flux, & + null_weights, precision, parallel_io, cyl_coord, & +- rhoref, pref, bubbles, bubble_model, & +- R0ref, & ++ rhoref, pref, bubbles, bubble_model, & ++ + #:if not MFC_CASE_OPTIMIZATION + nb, mapped_weno, wenoz, teno, weno_order, num_fluids, & + #:endif +@@ -161,7 +163,7 @@ contains + R0_type, file_per_process, sigma, & + pi_fac, adv_n, adap_dt, bf_x, bf_y, bf_z, & + k_x, k_y, k_z, w_x, w_y, w_z, p_x, p_y, p_z, & +- g_x, g_y, g_z ++ g_x, g_y, g_z, hyperelasticity, R0ref + + ! Checking that an input file has been provided by the user. If it + ! has, then the input file is read in, otherwise, simulation exits. +@@ -359,7 +361,7 @@ contains + end if + end do + +- if ((bubbles .eqv. .true.) .or. (hypoelasticity .eqv. .true.)) then ++ if ((bubbles .eqv. .true.) .or. (elasticity .eqv. .true.)) then + ! Read pb and mv for non-polytropic qbmm + if (qbmm .and. .not. polytropic) then + do i = 1, nb +@@ -589,7 +591,7 @@ contains + NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) + + ! Read the data for each variable +- if (bubbles .or. hypoelasticity) then ++ if ( bubbles .or. elasticity ) then + + do i = 1, sys_size!adv_idx%end + var_MOK = int(i, MPI_OFFSET_KIND) +@@ -614,6 +616,7 @@ contains + MPI_DOUBLE_PRECISION, status, ierr) + end do + end if ++ + + call s_mpi_barrier() + +@@ -679,9 +682,9 @@ contains + NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) + + ! Read the data for each variable +- if (bubbles .or. hypoelasticity) then ++ if ( bubbles .or. elasticity ) then + +- do i = 1, sys_size!adv_idx%end ++ do i = 1, sys_size !adv_idx%end + var_MOK = int(i, MPI_OFFSET_KIND) + ! Initial displacement to skip at beginning of file + disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) +@@ -1120,7 +1123,7 @@ contains + ! Time-stepping loop controls + if ((mytime + dt) >= finaltime) dt = finaltime - mytime + t_step = t_step + 1 +- ++ + end subroutine s_perform_time_step + + subroutine s_save_performance_metrics(t_step, time_avg, time_final, io_time_avg, io_time_final, proc_time, io_proc_time, file_exists, start, finish, nt) +@@ -1272,7 +1275,6 @@ contains + call acc_present_dump() + #endif + +- if (hypoelasticity) call s_initialize_hypoelastic_module() + if (relax) call s_initialize_phasechange_module() + call s_initialize_data_output_module() + call s_initialize_derived_variables_module() +@@ -1312,9 +1314,11 @@ contains + #endif + + call s_initialize_cbc_module() +- + call s_initialize_derived_variables() + ++ if (hypoelasticity) call s_initialize_hypoelastic_module() ++ if (hyperelasticity) call s_initialize_hyperelastic_module() ++ + end subroutine s_initialize_modules + + subroutine s_initialize_mpi_domain +@@ -1395,6 +1399,7 @@ contains + do i = 1, sys_size + !$acc update device(q_cons_ts(1)%vf(i)%sf) + end do ++ + if (qbmm .and. .not. polytropic) then + !$acc update device(pb_ts(1)%sf, mv_ts(1)%sf) + end if +@@ -1410,7 +1415,6 @@ contains + !$acc update device(bc_y%vb1, bc_y%vb2, bc_y%vb3, bc_y%ve1, bc_y%ve2, bc_y%ve3) + !$acc update device(bc_z%vb1, bc_z%vb2, bc_z%vb3, bc_z%ve1, bc_z%ve2, bc_z%ve3) + +- + !$acc update device(relax, relax_model) + if (relax) then + !$acc update device(palpha_eps, ptgalpha_eps) +@@ -1428,6 +1432,8 @@ contains + s_write_data_files => null() + + call s_finalize_time_steppers_module() ++ if (hypoelasticity) call s_finalize_hypoelastic_module() ++ if (hyperelasticity) call s_finalize_hyperelastic_module() + call s_finalize_derived_variables_module() + call s_finalize_data_output_module() + call s_finalize_rhs_module() +diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp +index 2e9ca8fe..b5faba05 100644 +--- a/src/simulation/m_surface_tension.fpp ++++ b/src/simulation/m_surface_tension.fpp +@@ -1,7 +1,7 @@ + #:include 'macros.fpp' + #:include 'inline_capillary.fpp' + +-!> @brief This module is used to compute source terms for hypoelastic model ++!> @brief This module is used to compute source terms for surface tension model + module m_surface_tension + + ! Dependencies ============================================================= +diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp +index d34c1fc0..b940bdc8 100644 +--- a/src/simulation/m_time_steppers.fpp ++++ b/src/simulation/m_time_steppers.fpp +@@ -25,6 +25,8 @@ module m_time_steppers + + use m_ibm + ++ use m_hyperelastic ++ + use m_mpi_proxy !< Message passing interface (MPI) module proxy + + use m_boundary_conditions +@@ -181,8 +183,7 @@ contains + end if + end if + +- if (hypoelasticity) then +- ++ if (elasticity) then + do i = stress_idx%beg, stress_idx%end + @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & + iy_t%beg:iy_t%end, & +@@ -191,6 +192,15 @@ contains + end do + end if + ++ if (hyperelasticity) then ++ do i = xibeg, xiend + 1 ++ @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & ++ iy_t%beg:iy_t%end, & ++ iz_t%beg:iz_t%end)) ++ @:ACC_SETUP_SFs(q_prim_vf(i)) ++ end do ++ end if ++ + if (model_eqns == 3) then + do i = internalEnergies_idx%beg, internalEnergies_idx%end + @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & +@@ -812,6 +822,10 @@ contains + call s_pressure_relaxation_procedure(q_cons_ts(1)%vf) + end if + ++ call nvtxStartRange("RHS-ELASTIC") ++ if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_ts(1)%vf, q_prim_vf) ++ call nvtxEndRange ++ + if (adv_n) call s_comp_alpha_from_n(q_cons_ts(1)%vf) + + if (ib) then +@@ -829,7 +843,6 @@ contains + time = time + (finish - start) + end if + ! ================================================================== +- + end subroutine s_3rd_order_tvd_rk + + !> Strang splitting scheme with 3rd order TVD RK time-stepping algorithm for +@@ -959,6 +972,7 @@ contains + end if + + end subroutine s_time_step_cycling ++ + !> Module deallocation and/or disassociation procedures + subroutine s_finalize_time_steppers_module + +@@ -993,12 +1007,18 @@ contains + @:DEALLOCATE(q_prim_vf(i)%sf) + end do + +- if (hypoelasticity) then ++ if (elasticity) then + do i = stress_idx%beg, stress_idx%end + @:DEALLOCATE(q_prim_vf(i)%sf) + end do + end if + ++ if (hyperelasticity) then ++ do i = xibeg, xiend + 1 ++ @:DEALLOCATE(q_prim_vf(i)%sf) ++ end do ++ end if ++ + if (bubbles) then + do i = bub_idx%beg, bub_idx%end + @:DEALLOCATE(q_prim_vf(i)%sf) +diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp +index 0019779e..5bdf4b84 100644 +--- a/src/simulation/m_viscous.fpp ++++ b/src/simulation/m_viscous.fpp +@@ -12,8 +12,6 @@ module m_viscous + use m_global_parameters !< Definitions of the global parameters + + use m_weno +- +- use m_helper + ! ========================================================================== + + private; public s_get_viscous, & +diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp +index 3f0e885c..8fc4523f 100644 +--- a/src/simulation/p_main.fpp ++++ b/src/simulation/p_main.fpp +@@ -36,7 +36,6 @@ program p_main + + !Initialize MPI + call s_initialize_mpi_domain() +- + !Initialize Modules + call s_initialize_modules() + +@@ -56,7 +55,7 @@ program p_main + + ! Time-stepping Loop ======================================================= + do +- if (t_step == t_step_stop) then ++ if (t_step > t_step_stop) then + call s_save_performance_metrics(t_step, time_avg, time_final, io_time_avg, & + io_time_final, proc_time, io_proc_time, file_exists, start, finish, nt) + exit +@@ -65,7 +64,7 @@ program p_main + call s_perform_time_step(t_step, time_avg, time_final, io_time_avg, io_time_final, & + proc_time, io_proc_time, file_exists, start, finish, nt) + +- if (mod(t_step - t_step_start, t_step_save) == 0 .or. t_step == t_step_stop) then ++ if (mod(t_step - t_step_start, t_step_save) == 0 .or. t_step > t_step_stop) then + call s_save_data(t_step, start, finish, io_time_avg, nt) + end if + +diff --git a/submit_gpu.sh b/submit_gpu.sh +new file mode 100755 +index 00000000..b29b29be +--- /dev/null ++++ b/submit_gpu.sh +@@ -0,0 +1,49 @@ ++#!/bin/bash ++ ++### A100s ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwex_pre -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta ++ ++### A40s ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwex_pre -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# test -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 03:00:00 -# test_sim -t simulation -a bciv-delta-gpu -c delta ++ ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# bwex_post -t post_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# test_post -t post_process -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 02:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta ++ ++./mfc.sh run tests/6954E28B/case.py -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta ++./mfc.sh run tests/6954E28B/case.py -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta ++ +diff --git a/submit_hyper.sh b/submit_hyper.sh +new file mode 100755 +index 00000000..ba197a99 +--- /dev/null ++++ b/submit_hyper.sh +@@ -0,0 +1,7 @@ ++#!/bin/bash ++ ++./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar ++./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta ++ ++ +diff --git a/submit_pc.sh b/submit_pc.sh +new file mode 100755 +index 00000000..e45b98db +--- /dev/null ++++ b/submit_pc.sh +@@ -0,0 +1,9 @@ ++#!/bin/bash ++ ++#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar ++#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta ++ ++./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t pre_process -c delta ++./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t simulation -c delta ++ +diff --git a/submit_test.sh b/submit_test.sh +new file mode 100755 +index 00000000..69b80bbe +--- /dev/null ++++ b/submit_test.sh +@@ -0,0 +1,52 @@ ++#!/bin/bash ++ ++#./mfc.sh run ./examples/3D_phasechange_bubble/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ++#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t simulation -c delta ++#./mfc.sh run ./examples/3D_phasechange_bubble/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++ ++#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ++#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta ++#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++ ++#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ++#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c delta ++#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++ ++#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 00:10:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 04:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.3/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 01:00:00 -# pre_bubingel -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# sim_bubingel -t simulation -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# pre_bubinwater -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# sim_bubinwater -t simulation -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta ++./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++ ++ ++#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar ++#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 02:00:00 -# test1 -t simulation -c oscar ++#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar ++ ++ ++#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/finalruns/elcom/bubliq/25wv/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/finalruns/elcom/bubliq/75wv/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++ +diff --git a/toolchain/bootstrap/docker.sh b/toolchain/bootstrap/docker.sh +index 73e61372..60e34d92 100644 +--- a/toolchain/bootstrap/docker.sh ++++ b/toolchain/bootstrap/docker.sh +@@ -30,4 +30,4 @@ if (($?)); then + error "Error running Docker container with $@." + + exit 1 +-fi +\ No newline at end of file ++fi +diff --git a/toolchain/bootstrap/modules.sh b/toolchain/bootstrap/modules.sh +index 097dca13..b437157f 100644 +--- a/toolchain/bootstrap/modules.sh ++++ b/toolchain/bootstrap/modules.sh +@@ -23,8 +23,9 @@ if [ -v $u_c ]; then + log "$C""ACCESS$W: Bridges2 (b) | Expanse (e) | Delta (d)" + log "$Y""Gatech$W: Phoenix (p)" + log "$R""Caltech$W: Richardson (r)" ++ log "$BR""Brown$W: Oscar (o)" + log "$B""DoD$W: Carpenter (c) | Nautilus (n)" +- log_n "($G""a$W/$G""f$W/$G""s$W/$G""w$W/$C""b$W/$C""e$CR/$C""d$CR/$Y""p$CR/$R""r$CR/$B""c$CR/$B""n$CR): " ++ log_n "($G""a$W/$G""f$W/$G""s$W/$G""w$W/$C""b$W/$C""e$CR/$C""d$CR/$Y""p$CR/$R""r$CR/$B""c$CR/$B""n$CR/$BR""o"$CR"): " + read u_c + log + fi +diff --git a/toolchain/mfc/bench.py b/toolchain/mfc/bench.py +index 52792f26..98e34309 100644 +--- a/toolchain/mfc/bench.py ++++ b/toolchain/mfc/bench.py +@@ -16,7 +16,6 @@ class BenchCase: + path: str + args: typing.List[str] + +- + def bench(targets = None): + if targets is None: + targets = ARG("targets") +diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py +index b39507d3..88eb7b00 100644 +--- a/toolchain/mfc/run/case_dicts.py ++++ b/toolchain/mfc/run/case_dicts.py +@@ -19,6 +19,7 @@ class ParamType(Enum): + + COMMON = { + 'hypoelasticity': ParamType.LOG, ++ 'hyperelasticity': ParamType.LOG, + 'cyl_coord': ParamType.LOG, + 'pref': ParamType.REAL, + 'p': ParamType.INT, +@@ -47,6 +48,7 @@ COMMON = { + 'relax_model': ParamType.INT, + 'sigma': ParamType.REAL, + 'adv_n': ParamType.LOG, ++ 'hyperelasticity': ParamType.LOG, + } + + PRE_PROCESS = COMMON.copy() +@@ -75,6 +77,7 @@ PRE_PROCESS.update({ + 'pi_fac': ParamType.REAL, + 'ib': ParamType.LOG, + 'num_ibs': ParamType.INT, ++ 'pre_stress': ParamType.LOG, + }) + + for ib_id in range(1, 10+1): +@@ -107,14 +110,16 @@ for f_id in range(1, 10+1): + "mu_v", "k_v", "G", "cv", "qv", "qvp" ]: + PRE_PROCESS[f"fluid_pp({f_id})%{real_attr}"] = ParamType.REAL + +-for p_id in range(1, 10+1): ++for p_id in range(1, 10+4): + for attribute, ty in [("geometry", ParamType.INT), ("smoothen", ParamType.LOG), + ("smooth_patch_id", ParamType.INT), ("hcid", ParamType.INT)]: + PRE_PROCESS[f"patch_icpp({p_id})%{attribute}"] = ty + +- for real_attr in ["radius", "radii", "epsilon", "beta", "normal", "alpha_rho", +- "smooth_coeff", "rho", "vel", "alpha", "gamma", ++ for real_attr in ["radius", "radii", "epsilon", "beta", "normal", "alpha_rho", "a2", ++ "a3", "a4", "a5", "a6", "a7","a8", "a9", "a10", "a11", "a12", 'non_axis_sym', ++ "normal", "smooth_coeff", "rho", "vel", "pres", "alpha", "gamma", + "pi_inf", "r0", "v0", "p0", "m0", "cv", "qv", "qvp", "cf_val"]: ++ + PRE_PROCESS[f"patch_icpp({p_id})%{real_attr}"] = ParamType.REAL + PRE_PROCESS[f"patch_icpp({p_id})%pres"] = ParamType.REAL.analytic() + +@@ -279,7 +284,6 @@ for f_id in range(1,10+1): + SIMULATION[f"integral({int_id})%{cmp}min"] = ParamType.REAL + SIMULATION[f"integral({int_id})%{cmp}max"] = ParamType.REAL + +- + # Removed: 'fourier_modes%beg', 'fourier_modes%end', 'chem_wrt' + # Feel free to return them if they are needed once more. + POST_PROCESS = COMMON.copy() +@@ -314,6 +318,7 @@ POST_PROCESS.update({ + 'qbmm': ParamType.LOG, + 'qm_wrt': ParamType.LOG, + 'cf_wrt': ParamType.LOG, ++ 'sim_data': ParamType.LOG, + 'ib': ParamType.LOG + }) + +diff --git a/toolchain/modules b/toolchain/modules +index 178d9966..bc0566a3 100644 +--- a/toolchain/modules ++++ b/toolchain/modules +@@ -60,6 +60,12 @@ d-cpu gcc/11.4.0 openmpi + d-gpu nvhpc/22.11 openmpi+cuda/4.1.5+cuda cmake + d-gpu CC=nvc CXX=nvc++ FC=nvfortran + ++o Brown Oscar ++o-all python ++o-cpu hpcx-mpi ++o-gpu nvhpc cuda/12.3.0 cmake/3.26.3 ++o-gpu CC=nvc CXX=nvc++ FC=nvfortran ++ + c DoD Carpenter + c-all python/3.12.1 + c-cpu compiler-rt/2024.2.0 ifort/2024.2.0 icc/2023.1.0 mpi/latest cmake/3.28.1-intel-2023.0.0 +@@ -70,3 +76,4 @@ n-all slurm + n-cpu penguin/openmpi/4.1.5/gcc-8.5.0 + n-gpu penguin/openmpi/4.1.5/nvhpc-22.3 nvidia/nvhpc/22.3 cuda/cuda-11.6 + n-gpu CC=nvc CXX=nvc++ FC=nvfortran ++ +diff --git a/toolchain/templates/oscar.mako b/toolchain/templates/oscar.mako +new file mode 100644 +index 00000000..158a217c +--- /dev/null ++++ b/toolchain/templates/oscar.mako +@@ -0,0 +1,56 @@ ++#!/usr/bin/env bash ++ ++<%namespace name="helpers" file="helpers.mako"/> ++ ++% if engine == 'batch': ++#SBATCH --nodes=${nodes} ++#SBATCH --ntasks-per-node=${tasks_per_node} ++#SBATCH --cpus-per-task=1 ++#SBATCH --job-name="${name}" ++#SBATCH --time=${walltime} ++% if partition: ++#SBATCH --partition=${partition} ++% endif ++% if account: ++#SBATCH --account="${account}" ++% endif ++% if gpu: ++#SBATCH --gpus-per-node=${tasks_per_node} ++#SBATCH --mem=64G ++#SBATCH --gpu-bind=closest ++% endif ++#SBATCH --output="${name}.out" ++#SBATCH --error="${name}.err" ++#SBATCH --export=ALL ++% if email: ++#SBATCH --mail-user=${email} ++#SBATCH --mail-type="BEGIN, END, FAIL" ++% endif ++% endif ++ ++${helpers.template_prologue()} ++ ++ok ":) Loading modules:\n" ++cd "${MFC_ROOTDIR}" ++. ./mfc.sh load -c o -m ${'g' if gpu else 'c'} ++cd - > /dev/null ++echo ++ ++% for target in targets: ++ ${helpers.run_prologue(target)} ++ ++ % if not mpi: ++ (set -x; ${profiler} "${target.get_install_binpath(case)}") ++ % else: ++ (set -x; ${profiler} \ ++ mpirun -np ${nodes*tasks_per_node} \ ++ ${' '.join([f"'{x}'" for x in ARG('--') ])} \ ++ "${target.get_install_binpath(case)}") ++ % endif ++ ++ ${helpers.run_epilogue(target)} ++ ++ echo ++% endfor ++ ++${helpers.template_epilogue()} +diff --git a/toolchain/util.sh b/toolchain/util.sh +index c67c9cad..fddbe22a 100644 +--- a/toolchain/util.sh ++++ b/toolchain/util.sh +@@ -1,10 +1,10 @@ + #!/bin/bash + + if [ -t 1 ]; then +- RED="\x1B[31m"; CYAN="\x1B[36m"; GREEN="\x1B[32m" ++ RED="\x1B[31m"; CYAN="\x1B[36m"; GREEN="\x1B[32m"; BROWN="\x1B[38;5;58m" + YELLOW="\x1B[33m"; MAGENTA="\x1B[35m"; BLUE="\x1B[34m"; COLOR_RESET="\033[m" + +- R=$RED; C=$CYAN; G=$GREEN ++ R=$RED; C=$CYAN; G=$GREEN; BR=$BROWN + Y=$YELLOW; M=$MAGENTA; B=$BLUE; CR=$COLOR_RESET; W=$CR + fi + diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index f862aa8e14..93637a1b93 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -1019,7 +1019,7 @@ contains call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) - call MPI_FILE_write_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & MPI_DOUBLE_PRECISION, status, ierr) end do !Write pb and mv for non-polytropic qbmm @@ -1303,7 +1303,7 @@ contains ! Compute mixture sound Speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & - ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c, fluid_pp(:)%G) + ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) accel = accel_mag(j - 2, k, l) end if @@ -1378,11 +1378,11 @@ contains end if ! Compute mixture sound speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & - ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c, fluid_pp(:)%G) + ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) end if end if - else ! 3D f (t_step == t_step_stop)simulation + else ! 3D if ((probe(i)%x >= x_cb(-1)) .and. (probe(i)%x <= x_cb(m))) then if ((probe(i)%y >= y_cb(-1)) .and. (probe(i)%y <= y_cb(n))) then if ((probe(i)%z >= z_cb(-1)) .and. (probe(i)%z <= z_cb(p))) then @@ -1430,7 +1430,7 @@ contains ! Compute mixture sound speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & - ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c, fluid_pp(:)%G) + ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) accel = accel_mag(j - 2, k - 2, l - 2) end if @@ -1556,7 +1556,7 @@ contains R(1), & Rdot(1) else if (elasticity) then - write (i + 30, '(6X,F12.12,F24.8,F24.8,F24.8,F24.8,'// & + write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,'// & 'F24.8,F24.8,F24.8)') & nondim_time, & rho, & diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 7b54091b78..16b20b02f3 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -162,12 +162,14 @@ module m_riemann_solvers @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsx_vf, flux_src_rsx_vf) @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsy_vf, flux_src_rsy_vf) @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsz_vf, flux_src_rsz_vf) - !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) + !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & + !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) #else real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsx_vf, flux_src_rsx_vf real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsy_vf, flux_src_rsy_vf real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsz_vf, flux_src_rsz_vf - !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf) + !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & + !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf) #endif !> @} @@ -2073,6 +2075,9 @@ contains do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end + + idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 + !$acc loop seq do i = 1, num_fluids alpha_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) @@ -2234,17 +2239,15 @@ contains @:compute_average_state() call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & - vel_L_rms, c_L, Gs) + vel_L_rms, c_L) call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & - vel_R_rms, c_R, Gs) + vel_R_rms, c_R) !> The computation of c_avg does not require all the variables, and therefore the non '_avg' ! variables are placeholders to call the subroutine. - call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & - vel_avg_rms, c_avg, Gs) - !SGR added Gs contribution to the speed of sound + vel_avg_rms, c_avg) if (any(Re_size > 0)) then !$acc loop seq @@ -2332,12 +2335,29 @@ contains ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) !$acc loop seq do i = 1, num_dims + idxi = dir_idx(i) + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & + xi_M*(rho_L*(vel_L(idx1)* & + vel_L(idxi) + & + s_M*(xi_L*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))* & + vel_L(idxi)) - vel_L(idxi))) + & + dir_flg(idxi)*(pres_L)) & + + xi_P*(rho_R*(vel_R(idx1)* & + vel_R(idxi) + & + s_P*(xi_R*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))* & + vel_R(idxi)) - vel_R(idxi))) + & + dir_flg(idxi)*(pres_R)) & + + (s_M/s_L)*(s_P/s_R)*dir_flg(idxi)*pcorr + !idxi = dir_idx(i) - flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & - xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & - (1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & - xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & - (1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) + !flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & + ! xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & + !(1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & + ! xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & + !(1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) & + ! + (s_M/s_L)*(s_P/s_R)*dir_flg(dir_idx(i))*pcorr end do ! ENERGY FLUX. @@ -2346,7 +2366,8 @@ contains xi_M*(vel_L(idx1)*(E_L + pres_L) + & s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & + xi_P*(vel_R(idx1)*(E_R + pres_R) + & - s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) + s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) & + + (s_M/s_L)*(s_P/s_R)*pcorr*s_S ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux if (elasticity) then @@ -2371,18 +2392,23 @@ contains if (hypoelasticity) then !$acc loop seq do i = 1, strxe - strxb + 1 - flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & - xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & - xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) + flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & + xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & + xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) end do end if ! VOLUME FRACTION FLUX. !$acc loop seq do i = advxb, advxe - flux_rs${XYZ}$_vf(j, k, l, i) = & - xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & - xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) + flux_rs${XYZ}$_vf(j, k, l, i) = & + xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & + *(vel_L(idx1) + s_M*(xi_L - 1d0)) & + + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & + *(vel_R(idx1) + s_P*(xi_R - 1d0)) + !flux_rs${XYZ}$_vf(j, k, l, i) = & + ! xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & + ! xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) end do ! VOLUME FRACTION SOURCE FLUX. @@ -2390,18 +2416,24 @@ contains do i = 1, num_dims idxi = dir_idx(i) vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & - xi_M*(vel_L(idxi) + dir_flg(idxi)*s_M*(xi_L - 1d0)) + & - xi_P*(vel_R(idxi) + dir_flg(idxi)*s_P*(xi_R - 1d0)) + xi_M*(vel_L(idxi) + & + dir_flg(idxi)* & + s_M*(xi_L - 1d0)) & + + xi_P*(vel_R(idxi) + & + dir_flg(idxi)* & + s_P*(xi_R - 1d0)) + !xi_M*(vel_L(idxi) + dir_flg(idxi)*s_M*(xi_L - 1d0)) + & + !xi_P*(vel_R(idxi) + dir_flg(idxi)*s_P*(xi_R - 1d0)) end do flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) ! SURFACE TENSION FLUX. need to check - if (.not. f_is_default(sigma)) then - flux_rs${XYZ}$_vf(j, k, l, c_idx) = & - (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & - xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S - end if + !if (.not. f_is_default(sigma)) then + ! flux_rs${XYZ}$_vf(j, k, l, c_idx) = & + ! (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & + ! xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S + !end if ! Geometrical source flux for cylindrical coordinates #:if (NORM_DIR == 2) diff --git a/submit_gpu.sh b/submit_gpu.sh index b29b29be39..2c77cc9276 100755 --- a/submit_gpu.sh +++ b/submit_gpu.sh @@ -44,6 +44,6 @@ #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 02:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -./mfc.sh run tests/6954E28B/case.py -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -./mfc.sh run tests/6954E28B/case.py -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +./mfc.sh run tests/6FC6A809/case.py -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +./mfc.sh run tests/6FC6A809/case.py -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta From 4b02bd766f3f6d2b8b06f2628177894ed341655e Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 4 Aug 2024 21:53:00 -0500 Subject: [PATCH 273/380] removing diff.txt file --- diff.txt | 8069 ------------------------------------------------------ 1 file changed, 8069 deletions(-) delete mode 100644 diff.txt diff --git a/diff.txt b/diff.txt deleted file mode 100644 index be07509475..0000000000 --- a/diff.txt +++ /dev/null @@ -1,8069 +0,0 @@ -diff --git a/batch_mfc.sh b/batch_mfc.sh -new file mode 100755 -index 00000000..41df3c34 ---- /dev/null -+++ b/batch_mfc.sh -@@ -0,0 +1,14 @@ -+#!/bin/bash -+ -+./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar -+ -+./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar -+ -+./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar -+ -diff --git a/examples/2D_lungwave/case.py b/examples/2D_lungwave/case.py -new file mode 100644 -index 00000000..e5888cbe ---- /dev/null -+++ b/examples/2D_lungwave/case.py -@@ -0,0 +1,193 @@ -+#!/usr/bin/env python3 -+ -+import math -+import json -+ -+pi = 3.141592653589 -+# material parameters -+ -+#material1 :: gas -+#patterson 2018 -+ -+gammag = 1.4 #unitless -+Bg =0 #pascals -+rhog = 1.18 #kg/m^3 -+c_g = 347.2 #m/s -+G_g = 0 #pa -+ -+ #material2 :: lung -+ -+gammal = 5.5 -+Bl = 492.E+06 -+rhol = 996.0 -+c_l = 1648.7 -+G_l = 1E3 -+ -+#primitive vartiables -+patmos = 101325. #pa -+ -+#problem specific variable -+lambda_wave = 1E-3 -+ -+#define pulse -+P_amp = 10.E+6 -+P_len = 45 #length of the impulse -+theta = -math.pi/2 #direction of propagation -+ -+#non-dim -+ -+#define characteristic density, length, time, stress material -+rho_char = rhog -+length_char = lambda_wave -+c_char = c_g -+time_char = length_char/c_char -+stress_char = rho_char*c_char*c_char/gammag -+ -+#non-dim the properties -+rhog_n = rhog/rho_char -+c_g_n = c_g/c_char -+rhol_n = rhol/rho_char -+c_l_n = c_l/c_char -+Bg_n = Bg/stress_char -+Bl_n = Bl/stress_char -+G_g_n = G_g/stress_char -+G_l_n = G_l/stress_char -+patmos_n = patmos/stress_char -+P_amp_n = P_amp/stress_char -+ -+#geometry -+dlengx = 1. -+dlengy = 20. -+Nx = 200 -+Ny = dlengy*Nx -+dx = dlengx/Nx -+dy = dlengy/Ny -+alphal_back = 1.0 -+alphag_back = 0.0 -+alphal_lung = 0.0 -+alphag_lung = 1.0 -+ -+interface_amp = 0.5 -+ -+# time stepping requirements -+time_end = 2.5 -+cfl = 0.5 -+ -+dt = cfl * dx/c_l -+Nt = int(time_end/dt) -+Nframes = 50000 -+tstart = 0 -+tstop = Nt -+tsave = int(Nt/Nframes) -+ -+#interface profile -+interface_amp = 0.5 -+ -+# Configuring case dictionary -+print(json.dumps({ -+ # Logistics ================================================================ -+ 'run_time_info' : 'T', -+ # ========================================================================== -+ -+ # Computational Domain Parameters ========================================== -+ 'x_domain%beg' : 0., -+ 'x_domain%end' : dlengx, -+ 'y_domain%beg' : -dlengy/2., -+ 'y_domain%end' : dlengy/2., -+ 'm' : int(Nx), -+ 'n' : int(Ny), -+ 'p' : 0, -+ 'dt' : dt, -+ 't_step_start' : tstart, -+ 't_step_stop' : tstop, -+ 't_step_save' : tsave, -+ # ========================================================================== -+ -+ # Simulation Algorithm Parameters ========================================== -+ 'num_patches' : 2, -+ 'model_eqns' : 2, -+ 'alt_soundspeed' : 'F', -+ 'num_fluids' : 2, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'T', -+ 'mixture_err' : 'T', -+ 'time_stepper' : 3, -+ 'weno_order' : 5, -+ 'weno_eps' : 1.E-16, -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'T', -+ 'riemann_solver' : 2, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -1, -+ 'bc_x%end' : -1, -+ 'bc_y%beg' : -6, -+ 'bc_y%end' : -6, -+ # ========================================================================== -+ -+ # Formatted Database Files Structure Parameters ============================ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt' :'T', -+ 'parallel_io' :'T', -+ # ========================================================================== -+ -+ # Monopole setting ========================================================= -+ 'Monopole' : 'T', # creating an acoustic wave -+ 'num_mono' : 1, # place in the middle and expand -+ 'Mono(1)%pulse' : 3, # sine wave -+ 'Mono(1)%npulse' : 1, # 1 pulse -+ 'Mono(1)%mag' : 10.0*patmos_n, # magnitude -+ 'Mono(1)%length' : 1*dlengx, # impulse length -+ 'Mono(1)%loc(1)' : dlengx/2, # x_center of the domain -+ 'Mono(1)%loc(2)' : 5.0*dlengx, # upper boundary of the domain -+ 'Mono(1)%dir' : -math.pi/2, # direction: -pi/2 -+ #============================================================================== -+ -+ # Patch 1: Background ====================================================== -+ 'patch_icpp(1)%geometry' : 3, -+ 'patch_icpp(1)%x_centroid' : dlengx/2, -+ 'patch_icpp(1)%y_centroid' : 0., -+ 'patch_icpp(1)%length_x' : dlengx, -+ 'patch_icpp(1)%length_y' : dlengy, -+ 'patch_icpp(1)%vel(1)' : 0., -+ 'patch_icpp(1)%vel(2)' : 0.E+00, -+ 'patch_icpp(1)%pres' : patmos_n, -+ 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, -+ 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, -+ 'patch_icpp(1)%alpha(1)' : alphal_back, -+ 'patch_icpp(1)%alpha(2)' : alphag_back, -+ # ========================================================================== -+ -+ -+ # Patch 2: Lung ============================================================ -+ 'patch_icpp(2)%geometry' : 7, -+ 'patch_icpp(2)%hcid' : 205, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ 'patch_icpp(2)%x_centroid' : dlengx/2., -+ 'patch_icpp(2)%y_centroid' : -dlengy/4., -+ 'patch_icpp(2)%length_x' : dlengx, -+ 'patch_icpp(2)%length_y' : dlengy/2.+2, -+ 'patch_icpp(2)%a2' : interface_amp, -+ 'patch_icpp(2)%vel(1)' : 0.E+00, -+ 'patch_icpp(2)%vel(2)' : 0.0, -+ 'patch_icpp(2)%pres' : patmos_n, -+ 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, -+ 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, -+ 'patch_icpp(2)%alpha(1)' : alphal_lung, -+ 'patch_icpp(2)%alpha(2)' : alphag_lung, -+ # ========================================================================== -+ -+ # Fluids Physical Parameters =============================================== -+ 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), -+ 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), -+ 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), -+ 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), -+ # ========================================================================== -+ -+})) -+ -+# ============================================================================== -diff --git a/examples/2D_lungwave_horizontal/case.py b/examples/2D_lungwave_horizontal/case.py -new file mode 100644 -index 00000000..d11aeac2 ---- /dev/null -+++ b/examples/2D_lungwave_horizontal/case.py -@@ -0,0 +1,189 @@ -+#!/usr/bin/env python3 -+ -+import math -+import json -+ -+pi = 3.141592653589 -+# material parameters -+ -+#material1 :: gas -+#patterson 2018 -+ -+gammag = 1.4 #unitless -+Bg =0 #pascals -+rhog = 1.18 #kg/m^3 -+c_g = 347.2 #m/s -+G_g = 0 #pa -+ -+#material2 :: water -+gammal = 5.5 -+Bl = 492.E+06 -+rhol = 996.0 -+c_l = 1648.7 -+G_l = 1E3 -+ -+#primitive vartiables -+patmos = 101325. #pa -+ -+#problem specific variable -+lambda_wave = 1E-3 -+ -+#define pulse -+P_amp = 10.E+6 -+P_len = 45 #length of the impulse -+theta = -math.pi/2 #direction of propagation -+ -+#non-dim -+ -+#define characteristic density, length, time, stress material -+rho_char = rhog -+length_char = lambda_wave -+c_char = c_g -+time_char = length_char/c_char -+stress_char = rho_char*c_char*c_char/gammag -+ -+#non-dim the properties -+rhog_n = rhog/rho_char -+c_g_n = c_g/c_char -+rhol_n = rhol/rho_char -+c_l_n = c_l/c_char -+Bg_n = Bg/stress_char -+Bl_n = Bl/stress_char -+G_g_n = G_g/stress_char -+G_l_n = G_l/stress_char -+patmos_n = patmos/stress_char -+P_amp_n = P_amp/stress_char -+ -+#geometry -+dlengx = 10. -+dlengy = 2. -+Ny = 500 -+Nx = dlengx*Ny -+dx = dlengx/Nx -+dy = dlengy/Ny -+alphal_back = 1.0 -+alphag_back = 0.0 -+alphal_lung = 0.0 -+alphag_lung = 1.0 -+ -+interface_amp = 0.5 -+ -+# time stepping requirements -+time_end = 5 -+cfl = 8.0 -+ -+dt = cfl * dx/c_l -+Nt = int(time_end/dt) -+Nframes = 500 -+tstart = 0 -+tstop = Nt -+tsave = int(Nt/Nframes) -+ -+# Configuring case dictionary -+print(json.dumps({ -+ # Logistics ================================================================ -+ 'run_time_info' : 'T', -+ # ========================================================================== -+ -+ # Computational Domain Parameters ========================================== -+ 'x_domain%beg' : -dlengx/2., -+ 'x_domain%end' : dlengx/2., -+ 'y_domain%beg' : 0., -+ 'y_domain%end' : dlengy, -+ 'm' : int(Nx), -+ 'n' : int(Ny), -+ 'p' : 0, -+ 'dt' : dt, -+ 't_step_start' : tstart, -+ 't_step_stop' : tstop, -+ 't_step_save' : tsave, -+ # ========================================================================== -+ -+ # Simulation Algorithm Parameters ========================================== -+ 'num_patches' : 2, -+ 'model_eqns' : 2, -+ 'alt_soundspeed' : 'F', -+ 'num_fluids' : 2, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'T', -+ 'mixture_err' : 'T', -+ 'time_stepper' : 3, -+ 'weno_order' : 5, -+ 'weno_eps' : 1.E-16, -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'T', -+ 'riemann_solver' : 2, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -6, -+ 'bc_x%end' : -6, -+ 'bc_y%beg' : -1, -+ 'bc_y%end' : -1, -+ # ========================================================================== -+ -+ # Formatted Database Files Structure Parameters ============================ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt' :'T', -+ 'parallel_io' :'T', -+ # ========================================================================== -+ -+ # Monopole setting ========================================================= -+ 'Monopole' : 'T', # creating an acoustic wave -+ 'num_mono' : 1, # place in the middle and expand -+ 'Mono(1)%pulse' : 3, # square wave -+ 'Mono(1)%npulse' : 1, # 1 pulse -+ 'Mono(1)%mag' : 100.0*patmos_n,# magnitude -+ 'Mono(1)%length' : 45.0*dlengy, # pulse length -+ 'Mono(1)%support' : 2, # 2D semi infinite plane (x: -inf,inf; y:-len/2, len/2) -+ 'Mono(1)%support_width' : 30, -+ 'Mono(1)%loc(1)' : 0.7*dlengy, # x_center of the domain -+ 'Mono(1)%loc(2)' : dlengy/2, # upper boundary of the domain -+ 'Mono(1)%dir' : -math.pi, # direction: -pi/2 -+ -+ # Patch 1: Background ====================================================== -+ 'patch_icpp(1)%geometry' : 3, -+ 'patch_icpp(1)%x_centroid' : 0., -+ 'patch_icpp(1)%y_centroid' : dlengy/2., -+ 'patch_icpp(1)%length_x' : dlengx, -+ 'patch_icpp(1)%length_y' : dlengy, -+ 'patch_icpp(1)%vel(1)' : 0., -+ 'patch_icpp(1)%vel(2)' : 0.E+00, -+ 'patch_icpp(1)%pres' : patmos_n, -+ 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, -+ 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, -+ 'patch_icpp(1)%alpha(1)' : alphal_back, -+ 'patch_icpp(1)%alpha(2)' : alphag_back, -+ # ========================================================================== -+ -+ # Patch 2: Lung ============================================================ -+ 'patch_icpp(2)%geometry' : 7, -+ 'patch_icpp(2)%hcid' : 206, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ 'patch_icpp(2)%x_centroid' : -dlengx/4., -+ 'patch_icpp(2)%y_centroid' : dlengy/2., -+ 'patch_icpp(2)%length_x' : dlengx/2.+2, -+ 'patch_icpp(2)%length_y' : dlengy, -+ 'patch_icpp(2)%a2' : interface_amp, -+ 'patch_icpp(2)%vel(1)' : 0.E+00, -+ 'patch_icpp(2)%vel(2)' : 0.0, -+ 'patch_icpp(2)%pres' : patmos_n, -+ 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, -+ 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, -+ 'patch_icpp(2)%alpha(1)' : alphal_lung, -+ 'patch_icpp(2)%alpha(2)' : alphag_lung, -+ # ========================================================================== -+ -+ # Fluids Physical Parameters =============================================== -+ 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), -+ 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), -+ 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), -+ 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), -+ -+ #============================================================================== -+})) -+ -+# ============================================================================== -diff --git a/examples/2D_phasechange_bubble/case.py b/examples/2D_phasechange_bubble/case.py -new file mode 100644 -index 00000000..5fbe5f83 ---- /dev/null -+++ b/examples/2D_phasechange_bubble/case.py -@@ -0,0 +1,286 @@ -+#!/usr/bin/env python3 -+import math, json -+ -+## 1 FOR BACKGROUND, 2 FOR BUBBLE -+# Pressure [Pa] -+p01 = 5E6 -+p02 = 3550 -+ -+# Temperature [K] -+T01 = 298.15 -+T02 = 298.15 -+#T02 = 7.914 -+ -+#### FLUID PROPERTIES #### -+ -+### liquid water ### -+# pi infty -+piwl = 1.0E+09 -+# qv -+qvwl = -1167000 -+# qv' -+qvpwl = 0.0E0 -+# cv -+cvwl = 1816 -+# cp -+cpwl = 4267 -+# gamma -+gamwl = cpwl / cvwl -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) -+rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) -+ -+# speed of sound FOR -+c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) -+c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) -+ -+# part for Gases - relations from IMR -+Ru = 8.3144598 # Universal gas constant (J/mol-K) -+ -+### Vapor water ### -+Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) -+# gamma -+gamwv = 1.4 -+# cp -+cpwv = Rv * gamwv/(gamwv-1) -+# cv -+cvwv = cpwv/gamwv -+# pi infinity -+piwv = 0.0E0 -+# qv -+qvwv = 2030000 -+# qv' -+qvpwv = -23400 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) -+rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) -+ -+# speed of sound -+c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) -+c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) -+ -+### Air ### -+ -+Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) -+# gamma -+gama = 1.4 -+# cp -+cpa = Ra * gama/(gama-1) -+# cv -+cva = cpa/gama -+# pi infinity -+pia = 0.0E0 -+# qv -+qva = 0.0E0 -+# qv' -+qvpa = 0.0E0 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0a1 = (p01 + pia)/((gama-1)*cva*T01) -+rho0a2 = (p02 + pia)/((gama-1)*cva*T02) -+ -+# Speed of sound -+c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) -+c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) -+ -+## SHOCK RELATIONS -+p02Op01 = p02 / p01 -+ -+# Mach number of the shocked region - this should agree with Min, if everything is correct -+Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) -+ -+# shock speed -+ss = Ms * c_a1 -+ -+### volume fractions for each of the patches ### -+C0 = 0.25 # vapor concentration for IMR -+ -+# water liquid -+awl1 = 1.00E00-2.00E-12 -+awl2 = 1.00E-12 -+# water vapor -+awv1 = 1.00E-12 -+awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) -+# air -+aa1 = 1.0 - awl1 - awv1 -+aa2 = 1.0 - awl2 - awv2 -+ -+## SIMULATION PARAMETERS -+ -+# CFL -+cfl = 0.50 -+ -+# Bubble Initial Radius -+R0 = 30E-06 -+ -+# number of elements -+Nx0 = 400 -+Nx = 1600 -+Ny = 1600 -+Nz = 1600 -+ -+# domain boundaries -+xb = 0.00 -+xe = 120E-6 -+ -+yb = 0.00 -+ye = 120E-6 -+ -+zb = 0.00 -+ze = 120E-6 -+ -+# typical cell size -+dx = ( xe - xb ) / Nx -+dy = ( ye - yb ) / Ny -+dz = ( ze - zb ) / Nz -+ -+# time step -+ -+# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) -+SF = 200 -+ -+# Critical time-step -+tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) -+ -+# making Nt divisible by SF -+# tendA = 1.5 * tc -+tend = 1.2 * tc -+ -+# 1 - ensure NtA is sufficient to go a little beyond tendA -+# NtA = int( tendA // dt + 1 ) -+ -+# Array of saves. it is the same as Nt/Sf = t_step_save -+# AS = int( NtA // SF + 1 ) -+ -+# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) -+# Nt = AS * SF -+Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) -+ -+dt = tend / Nt -+ -+AS = int( Nt//SF ) -+ -+# Total physical time -+# tend = Nt * dt -+ -+# Configuring case dictionary ================================================== -+print(json.dumps({ -+ # Logistics ================================================ -+ 'run_time_info': 'T', -+ # ========================================================== -+ # Computational Domain Parameters ========================== -+ 'x_domain%beg' : xb, -+ 'x_domain%end' : xe, -+ 'y_domain%beg' : yb, -+ 'y_domain%end' : ye, -+ 'stretch_x' : 'T', -+ 'loops_x' : 3, -+ 'a_x' : 4.0E0, -+ 'x_a' : -2.0*R0, -+ 'x_b' : 2.0*R0, -+ 'stretch_y' : 'T', -+ 'loops_y' : 3, -+ 'a_y' : 4.0E0, -+ 'y_a' : -2.0*R0, -+ 'y_b' : 2.0*R0, -+ 'cyl_coord' : 'T', -+ 'm' : Nx, -+ 'n' : Ny, -+ 'p' : 0, -+ 'dt' : dt, -+ 't_step_start' : 0, -+ 't_step_stop' : Nt, -+ 't_step_save' : AS, -+ # ========================================================== -+ # Simulation Algorithm Parameters ========================== -+ 'num_patches' : 2, -+ 'model_eqns' : 3, -+ 'num_fluids' : 3, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'T', -+ 'mixture_err' : 'T', -+ 'relax' : 'T', -+ 'relax_model' : 6, -+ 'palpha_eps' : 1.0E-8, -+ 'ptgalpha_eps' : 1.0E-2, -+ 'time_stepper' : 3, -+ 'weno_order' : 3, -+ 'weno_eps' : 1.0E-16, -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'F', -+ 'riemann_solver' : 2, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -2, -+ 'bc_x%end' : -6, -+ 'bc_y%beg' : -2, -+ 'bc_y%end' : -6, -+ # ========================================================== -+ # Formatted Database Files Structure Parameters ============ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt':'T', -+ 'parallel_io' :'T', -+ # ========================================================== -+ # Patch 1: High pressured water ============================ -+ # Specify the cubic water background grid geometry -+ 'patch_icpp(1)%geometry' : 3, -+ 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, -+ 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, -+ 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, -+ 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, -+ 'patch_icpp(1)%vel(1)' : 0.0E+00, -+ 'patch_icpp(1)%vel(2)' : 0.0E+00, -+ 'patch_icpp(1)%pres' : p01, -+ 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, -+ 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, -+ 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, -+ 'patch_icpp(1)%alpha(1)' : awl1, -+ 'patch_icpp(1)%alpha(2)' : awv1, -+ 'patch_icpp(1)%alpha(3)' : aa1, -+ # ========================================================== -+ # Patch 2: (Vapor) Bubble ================================== -+ 'patch_icpp(2)%geometry' : 2, -+ 'patch_icpp(2)%x_centroid' : xb, -+ 'patch_icpp(2)%y_centroid' : yb, -+ 'patch_icpp(2)%radius' : R0, -+ 'patch_icpp(2)%vel(1)' : 0.0E+00, -+ 'patch_icpp(2)%vel(2)' : 0.0E+00, -+ 'patch_icpp(2)%pres' : p02, -+ 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, -+ 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, -+ 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, -+ 'patch_icpp(2)%alpha(1)' : awl2, -+ 'patch_icpp(2)%alpha(2)' : awv2, -+ 'patch_icpp(2)%alpha(3)' : aa2, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ # ========================================================== -+ # Fluids Physical Parameters =============================== -+ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), -+ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), -+ 'fluid_pp(1)%cv' : cvwl, -+ 'fluid_pp(1)%qv' : qvwl, -+ 'fluid_pp(1)%qvp' : qvpwl, -+ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), -+ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), -+ 'fluid_pp(2)%cv' : cvwv, -+ 'fluid_pp(2)%qv' : qvwv, -+ 'fluid_pp(2)%qvp' : qvpwv, -+ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), -+ 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), -+ 'fluid_pp(3)%cv' : cva, -+ 'fluid_pp(3)%qv' : qva, -+ 'fluid_pp(3)%qvp' : qvpa, -+ # ========================================================== -+})) -diff --git a/examples/2D_phasechange_bubble/casefile.py b/examples/2D_phasechange_bubble/casefile.py -new file mode 100644 -index 00000000..722d0049 ---- /dev/null -+++ b/examples/2D_phasechange_bubble/casefile.py -@@ -0,0 +1,300 @@ -+#!/usr/bin/env python3 -+import math, json -+ -+## 1 FOR BACKGROUND, 2 FOR BUBBLE -+# Pressure [Pa] -+p01 = 5E6 -+p02 = 3550 -+ -+# Temperature [K] -+T01 = 298.15 -+T02 = 298.15 -+#T02 = 7.914 -+ -+#### FLUID PROPERTIES #### -+ -+### liquid water ### -+# pi infty -+piwl = 1.0E+09 -+# qv -+qvwl = -1167000 -+# qv' -+qvpwl = 0.0E0 -+# cv -+cvwl = 1816 -+# cp -+cpwl = 4267 -+# gamma -+gamwl = cpwl / cvwl -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) -+rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) -+ -+# speed of sound FOR -+c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) -+c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) -+ -+# part for Gases - relations from IMR -+Ru = 8.3144598 # Universal gas constant (J/mol-K) -+ -+### Vapor water ### -+Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) -+# gamma -+gamwv = 1.4 -+# cp -+cpwv = Rv * gamwv/(gamwv-1) -+# cv -+cvwv = cpwv/gamwv -+# pi infinity -+piwv = 0.0E0 -+# qv -+qvwv = 2030000 -+# qv' -+qvpwv = -23400 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) -+rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) -+ -+# speed of sound -+c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) -+c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) -+ -+### Air ### -+ -+Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) -+# gamma -+gama = 1.4 -+# cp -+cpa = Ra * gama/(gama-1) -+# cv -+cva = cpa/gama -+# pi infinity -+pia = 0.0E0 -+# qv -+qva = 0.0E0 -+# qv' -+qvpa = 0.0E0 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0a1 = (p01 + pia)/((gama-1)*cva*T01) -+rho0a2 = (p02 + pia)/((gama-1)*cva*T02) -+ -+# Speed of sound -+c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) -+c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) -+ -+## SHOCK RELATIONS -+p02Op01 = p02 / p01 -+ -+# Mach number of the shocked region - this should agree with Min, if everything is correct -+Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) -+ -+# shock speed -+ss = Ms * c_a1 -+ -+### volume fractions for each of the patches ### -+C0 = 0.25 # vapor concentration for IMR -+ -+# water liquid -+awl1 = 1.00E00-2.00E-12 -+awl2 = 1.00E-12 -+# water vapor -+awv1 = 1.00E-12 -+awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) -+# air -+aa1 = 1.0 - awl1 - awv1 -+aa2 = 1.0 - awl2 - awv2 -+ -+## SIMULATION PARAMETERS -+ -+# CFL -+cfl = 0.50 -+ -+# Bubble Initial Radius -+R0 = 30E-06 -+ -+# number of elements -+Nx0 = 400 -+Nx = 100 -+Ny = 100 -+Nz = 100 -+ -+# domain boundaries -+xb = 0.00 -+xe = 120E-6 -+ -+yb = 0.00 -+ye = 120E-6 -+ -+zb = 0.00 -+ze = 120E-6 -+ -+# typical cell size -+dx = ( xe - xb ) / Nx -+dy = ( ye - yb ) / Ny -+dz = ( ze - zb ) / Nz -+ -+# time step -+ -+# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) -+SF = 200 -+ -+# Critical time-step -+tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) -+ -+# making Nt divisible by SF -+# tendA = 1.5 * tc -+tend = 1.2 * tc -+ -+# 1 - ensure NtA is sufficient to go a little beyond tendA -+# NtA = int( tendA // dt + 1 ) -+ -+# Array of saves. it is the same as Nt/Sf = t_step_save -+# AS = int( NtA // SF + 1 ) -+ -+# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) -+# Nt = AS * SF -+Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) -+ -+dt = tend / Nt -+ -+AS = int( Nt//SF ) -+ -+# Total physical time -+# tend = Nt * dt -+ -+# Configuring case dictionary ================================================== -+print(json.dumps({ -+ # Logistics ================================================ -+ 'run_time_info': 'T', -+ # ========================================================== -+ # Computational Domain Parameters ========================== -+ 'x_domain%beg' : xb, -+ 'x_domain%end' : xe, -+ 'y_domain%beg' : yb, -+ 'y_domain%end' : ye, -+ 'z_domain%beg' : zb, -+ 'z_domain%end' : ze, -+ 'stretch_x' : 'T', -+ 'loops_x' : 3, -+ 'a_x' : 4.0E0, -+ 'x_a' : -2.0*R0, -+ 'x_b' : 2.0*R0, -+ 'stretch_y' : 'T', -+ 'loops_y' : 3, -+ 'a_y' : 4.0E0, -+ 'y_a' : -2.0*R0, -+ 'y_b' : 2.0*R0, -+ 'stretch_z' : 'T', -+ 'loops_z' : 3, -+ 'a_z' : 4.0E0, -+ 'z_a' : -2.0*R0, -+ 'z_b' : 2.0*R0, -+ 'cyl_coord' : 'F', -+ 'm' : Nx, -+ 'n' : Ny, -+ 'p' : Nz, -+ 'dt' : dt, -+ 't_step_start' : 0, -+ 't_step_stop' : Nt, -+ 't_step_save' : AS, -+ # ========================================================== -+ # Simulation Algorithm Parameters ========================== -+ 'num_patches' : 2, -+ 'model_eqns' : 3, -+ 'num_fluids' : 3, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'T', -+ 'mixture_err' : 'T', -+ 'relax' : 'T', -+ 'relax_model' : 6, -+ 'palpha_eps' : 1.0E-6, -+ 'ptgalpha_eps' : 1.0E-2, -+ 'time_stepper' : 3, -+ 'weno_order' : 3, -+ 'weno_eps' : 1.0E-32, -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'F', -+ 'riemann_solver' : 2, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -2, -+ 'bc_x%end' : -6, -+ 'bc_y%beg' : -2, -+ 'bc_y%end' : -6, -+ 'bc_z%beg' : -2, -+ 'bc_z%end' : -6, -+ # ========================================================== -+ # Formatted Database Files Structure Parameters ============ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt':'T', -+ 'parallel_io' :'T', -+ # ========================================================== -+ # Patch 1: High pressured water ============================ -+ # Specify the cubic water background grid geometry -+ 'patch_icpp(1)%geometry' : 9, -+ 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, -+ 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, -+ 'patch_icpp(1)%z_centroid' : ( ze + zb ) * 500000 / 100, -+ 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, -+ 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, -+ 'patch_icpp(1)%length_z' : ( ze - zb ) * 1000000 / 100, -+ 'patch_icpp(1)%vel(1)' : 0.0E+00, -+ 'patch_icpp(1)%vel(2)' : 0.0E+00, -+ 'patch_icpp(1)%vel(3)' : 0.0E+00, -+ 'patch_icpp(1)%pres' : p01, -+ 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, -+ 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, -+ 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, -+ 'patch_icpp(1)%alpha(1)' : awl1, -+ 'patch_icpp(1)%alpha(2)' : awv1, -+ 'patch_icpp(1)%alpha(3)' : aa1, -+ # ========================================================== -+ # Patch 2: (Vapor) Bubble ================================== -+ 'patch_icpp(2)%geometry' : 8, -+ 'patch_icpp(2)%x_centroid' : xb, -+ 'patch_icpp(2)%y_centroid' : yb, -+ 'patch_icpp(2)%z_centroid' : zb, -+ 'patch_icpp(2)%radius' : R0, -+ 'patch_icpp(2)%vel(1)' : 0.0E+00, -+ 'patch_icpp(2)%vel(2)' : 0.0E+00, -+ 'patch_icpp(2)%vel(3)' : 0.0E+00, -+ 'patch_icpp(2)%pres' : p02, -+ 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, -+ 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, -+ 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, -+ 'patch_icpp(2)%alpha(1)' : awl2, -+ 'patch_icpp(2)%alpha(2)' : awv2, -+ 'patch_icpp(2)%alpha(3)' : aa2, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ # ========================================================== -+ # Fluids Physical Parameters =============================== -+ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), -+ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), -+ 'fluid_pp(1)%cv' : cvwl, -+ 'fluid_pp(1)%qv' : qvwl, -+ 'fluid_pp(1)%qvp' : qvpwl, -+ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), -+ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), -+ 'fluid_pp(2)%cv' : cvwv, -+ 'fluid_pp(2)%qv' : qvwv, -+ 'fluid_pp(2)%qvp' : qvpwv, -+ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), -+ 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), -+ 'fluid_pp(3)%cv' : cva, -+ 'fluid_pp(3)%qv' : qva, -+ 'fluid_pp(3)%qvp' : qvpa, -+ # ========================================================== -+})) -diff --git a/examples/3D_CAV/3D_CAV_sph_col.py b/examples/3D_CAV/3D_CAV_sph_col.py -new file mode 100644 -index 00000000..a54df0a5 ---- /dev/null -+++ b/examples/3D_CAV/3D_CAV_sph_col.py -@@ -0,0 +1,205 @@ -+import math -+import json -+ -+ -+## Deine characteristic values for the sim -+Ri = 50E-6 -+T = 407.9 -+rhog = 0.027 -+Pb = 3550 -+Pl = 101325 -+#mulc = 9E-04 -+#mubc = 1.0E-05 -+domain_length = 3*Ri -+ -+ -+## fluid properties -+Pi_inf_l = 1.0E+09 -+Pi_inf_b = 0.0E+00 -+nl = 2.35 -+nb = 1.47 -+alpha1 = 1.0E+00 -+Cv_l = 1816 -+rhol = (Pl+Pi_inf_l)/((nl-1)*Cv_l*T) -+alpha2 = alpha1 -+cl = (nl*(Pl+Pi_inf_l)/rhol)**(0.5) -+ -+## Defining Characteristic Values -+Rc = Ri -+rhoc = rhol -+uc = (Pl/rhol)**(0.5E+00) -+tc = Ri/uc -+Pc = rhoc*uc**(2.0E+00) -+ -+## Non-Dimensionalizing values using characteristic values -+Rin = Ri/Rc -+rholn = rhol/rhoc -+rhogn = rhog/rhoc -+Pln = Pl/Pc -+Pbn = Pb/Pc -+tcn = tc/tc -+Pi_inf_ln = Pi_inf_l/Pc -+leng = domain_length/Rc -+clc = cl/uc -+ -+ -+## Non-Dimensional Numbers -+#Rel = rhol*uc*2*Rin/mulc -+#Reb = rhog*uc*2*Rin/mubc -+Ma = uc/cl -+ -+## Grid Specifications -+CFL = 0.1 -+PpBr = 192 -+Nx = PpBr*leng -+Ny = Nx -+Nz = Nx -+x_beg = 0.0E+00 -+x_end = leng -+y_beg = 0.0E+00 -+y_end = leng -+z_beg = 0.0E+00 -+z_end = leng -+delta_x = leng/Nx -+delta_t = CFL*delta_x/clc -+Nt = int(1.1*tcn/delta_t) -+x_centroidl = (x_end+x_beg)/(2.0E+00) -+y_centroidl = (y_end+y_beg)/(2.0E+00) -+z_centroidl = (z_end+z_beg)/(2.0E+00) -+x_centroidb = 0.0E+00 -+y_centroidb = 0.0E+00 -+z_centroidb = 0.0E+00 -+ -+ -+# Configuring case dictionary -+print(json.dumps({ -+ # Logistics ================================================ -+ 'run_time_info' : 'T', -+ 'sim_data' : 'T', -+ # ========================================================== -+ -+ # Computational Domain Parameters ========================== -+ 'x_domain%beg' : x_beg, -+ 'x_domain%end' : x_end, -+ 'y_domain%beg' : y_beg, -+ 'y_domain%end' : y_end, -+ 'z_domain%beg' : z_beg, -+ 'z_domain%end' : z_end, -+ 'm' : int(Nx), -+ 'n' : int(Ny), -+ 'p' : int(Nz), -+ 'cyl_coord' : 'F', -+ 'dt' : delta_t, -+ 't_step_start' : 0, -+ 't_step_stop' : Nt, -+ 't_step_save' : int(Nt/360), -+# ========================================================== -+ -+ # Simulation Algorithm Parameters ========================== -+ 'num_patches' : 2, -+ 'model_eqns' : 2, -+ 'alt_soundspeed' : 'F', -+ 'num_fluids' : 2, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'T', -+ 'mixture_err' : 'T', -+ 'time_stepper' : 3, -+ 'weno_order' : 5, -+ 'weno_eps' : 1.E-100, -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'F', -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'riemann_solver' : 2, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -2, -+ 'bc_x%end' : -6, -+ 'bc_y%beg' : -2, -+ 'bc_y%end' : -6, -+ 'bc_z%beg' : -2, -+ 'bc_z%end' : -6, -+ 'stretch_x' : 'T', -+ 'stretch_y' : 'T', -+ 'stretch_z' : 'T', -+ 'a_x' : 4.0E+00, -+ 'x_a' : -1.5E+00, -+ 'x_b' : 1.5E+00, -+ 'a_y' : 4.0E+00, -+ 'y_a' : -1.5E+00, -+ 'y_b' : 1.5E+00, -+ 'a_z' : 4.0E+00, -+ 'z_a' : -1.5E+00, -+ 'z_b' : 1.5E+00, -+ # ========================================================== -+ -+ # Formatted Database Files Structure Parameters ============ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt' :'T', -+ 'parallel_io' :'T', -+ 'fd_order' :'1', -+ 'probe_wrt' :'T', -+ 'num_probes' : 1, -+ 'probe(1)%x' : 0., -+ 'probe(1)%y' : 0., -+ 'probe(1)%z' : 0., -+ # ========================================================== -+ -+ # Patch 1: Background ============================ -+ 'patch_icpp(1)%geometry' : 9, -+ 'patch_icpp(1)%x_centroid' : 40*x_centroidl, -+ 'patch_icpp(1)%y_centroid' : 40*y_centroidl, -+ 'patch_icpp(1)%z_centroid' : 40*z_centroidl, -+ 'patch_icpp(1)%length_x' : 40*leng, -+ 'patch_icpp(1)%length_y' : 40*leng, -+ 'patch_icpp(1)%length_z' : 40*leng, -+ 'patch_icpp(1)%vel(1)' : 0.E+00, -+ 'patch_icpp(1)%vel(2)' : 0.E+00, -+ 'patch_icpp(1)%vel(3)' : 0.E+00, -+ 'patch_icpp(1)%pres' : Pln, -+ 'patch_icpp(1)%alpha_rho(1)' : alpha1*rholn, -+ 'patch_icpp(1)%alpha_rho(2)' : 0.0E+00, -+ 'patch_icpp(1)%alpha(1)' : alpha1, -+ 'patch_icpp(1)%alpha(2)' : 0.0E+00, -+ # ========================================================== -+ # Patch 2: Bubble ====================================== -+ 'patch_icpp(2)%geometry' : 14, -+ 'patch_icpp(2)%x_centroid' : x_centroidb, -+ 'patch_icpp(2)%y_centroid' : y_centroidb, -+ 'patch_icpp(2)%z_centroid' : z_centroidb, -+ 'patch_icpp(2)%radius' : Rin, -+ 'patch_icpp(2)%smoothen' : 'T', -+ 'patch_icpp(2)%smooth_patch_id': 1, -+ 'patch_icpp(2)%smooth_coeff' : 1.5E+00, -+ 'patch_icpp(2)%non_axis_sym' : 'F', -+ 'patch_icpp(2)%a2' : 0.0E+00, -+ 'patch_icpp(2)%a3' : 0.0E+00, -+ 'patch_icpp(2)%a4' : 0.0E+00, -+ 'patch_icpp(2)%a5' : 0.0E+00, -+ 'patch_icpp(2)%a6' : 0.0E+00, -+ 'patch_icpp(2)%a7' : 0.0E+00, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ 'patch_icpp(2)%vel(1)' : 0.E+00, -+ 'patch_icpp(2)%vel(2)' : 0.E+00, -+ 'patch_icpp(2)%vel(3)' : 0.E+00, -+ 'patch_icpp(2)%pres' : Pbn, -+ 'patch_icpp(2)%alpha_rho(1)' : 0.0E+00, -+ 'patch_icpp(2)%alpha_rho(2)' : alpha2*rhogn, -+ 'patch_icpp(2)%alpha(1)' : 0.0E+00, -+ 'patch_icpp(2)%alpha(2)' : alpha2, -+ # ========================================================== -+ -+ # Fluids Physical Parameters =============================== -+ 'fluid_pp(1)%gamma' : 1/(nl-1), -+ 'fluid_pp(1)%pi_inf' : nl*Pi_inf_ln/(nl-1), -+ 'fluid_pp(2)%gamma' : 1/(nb-1), -+ 'fluid_pp(2)%pi_inf' : 0.0E+00, -+# 'fluid_pp(1)%Re(1)' : Rel, -+# 'fluid_pp(2)%Re(1)' : Reb, -+ # ========================================================== -+})) -+ -+# ============================================================================== -+ -diff --git a/examples/3D_ctr_test/case.py b/examples/3D_ctr_test/case.py -new file mode 100644 -index 00000000..aac9ec36 ---- /dev/null -+++ b/examples/3D_ctr_test/case.py -@@ -0,0 +1,399 @@ -+#!/usr/bin/env python3 -+import math, json -+ -+## 1 FOR BACKGROUND, 2 FOR BUBBLE, 3 FOR GEL -+# Pressure [Pa] -+p01 = 5E6 -+p02 = 3550 -+p03 = p01 -+ -+# Temperature [K] -+T01 = 298.15 -+T02 = 298.15 -+T03 = T01 -+ -+#### FLUID PROPERTIES #### -+ -+### liquid water ### -+# pi infty -+piwl = 1.0E+09 -+# qv -+qvwl = -1167000 -+# qv' -+qvpwl = 0.0E0 -+# cv -+cvwl = 1816 -+# cp -+cpwl = 4267 -+# gamma -+gamwl = cpwl / cvwl -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) -+rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) -+rho0wl3 = (p03 + piwl)/((gamwl-1)*cvwl*T03) -+ -+# speed of sound FOR -+c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) -+c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) -+c_wl3 = math.sqrt( gamwl * ( p03 + piwl ) / rho0wl3 ) -+ -+# part for Gases - relations from IMR -+Ru = 8.3144598 # Universal gas constant (J/mol-K) -+ -+### Vapor water ### -+Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) -+# gamma -+gamwv = 1.4 -+# cp -+cpwv = Rv * gamwv/(gamwv-1) -+# cv -+cvwv = cpwv/gamwv -+# pi infinity -+piwv = 0.0E0 -+# qv -+qvwv = 2030000 -+# qv' -+qvpwv = -23400 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) -+rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) -+rho0wv3 = (p03 + piwv)/((gamwv-1)*cvwv*T03) -+ -+# speed of sound -+c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) -+c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) -+c_wv3 = math.sqrt( gamwv * ( p03 + piwv ) / rho0wv3 ) -+ -+### Air ### -+ -+Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) -+gamwa = 1.4 -+# cp -+cpa = Ra * gamwa/(gamwa-1) -+# cv -+cva = cpa/gamwa -+# pi infinity -+pia = 0.0E0 -+# qv -+qvwa = 0.0E0 -+# qv' -+qvpwa = 0.0E0 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wa1 = (p01 + pia)/((gamwa-1)*cva*T01) -+rho0wa2 = (p02 + pia)/((gamwa-1)*cva*T02) -+ -+# Speed of sound -+c_a1 = math.sqrt( gamwa * ( p01 + pia ) / rho0wa1 ) -+c_a2 = math.sqrt( gamwa * ( p02 + pia ) / rho0wa2 ) -+ -+### 3% polyacrylamide gel ### -+# gamma -+gamwg = 2.35 -+# pi infty -+pig = 1.0E+09 -+# qv -+qvwg = -1167000 -+# qv' -+qvpwg = 0.0E0 -+# cv -+cvg = 1816 -+# cp -+cpg = gamwg*cvg -+ -+## FOR PATCHES 1 & 2 & 3 ## -+ -+# density -+rho0wg1 = (p01 + pig)/((gamwg-1)*cvg*T01) -+rho0wg2 = (p02 + pig)/((gamwg-1)*cvg*T02) -+rho0wg3 = (p03 + pig)/((gamwg-1)*cvg*T03) -+ -+# Speed of sound -+c_g1 = math.sqrt( gamwg * ( p01 + pig ) / rho0wg1 ) -+c_g2 = math.sqrt( gamwg * ( p02 + pig ) / rho0wg2 ) -+c_g3 = math.sqrt( gamwg * ( p03 + pig ) / rho0wg3 ) -+ -+## SHOCK RELATIONS -+p02Op01 = p02 / p01 -+ -+# Mach number of the shocked region - this should agree with Min, if everything is correct -+Ms = math.sqrt( ( gamwa + 1. ) / ( 2. * gamwa ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) -+ -+# shock speed -+ss = Ms * c_a1 -+ -+### volume fractions for each of the patches ### -+C0 = 0.5 # vapor concentration for IMR -+ -+# patch 1: liquid water -+liq_wv = 1.00E-15 -+liq_wg = 0. -+liq_wa = 1.00E-15 -+liq_wl = 1.00E00 - liq_wv - liq_wa - liq_wg -+# water vapor -+vap_wl = 1.00E-15 -+vap_wv = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0wa2 + 1 ) -+vap_wg = 0. -+vap_wa = 1.00E-15 -+vap_tot = vap_wl + vap_wv + vap_wa + vap_wg -+# bub -+bub_wl = 1.00E-15 -+bub_wv = vap_tot -+bub_wg = 0. -+bub_wa = 1.00E00 - bub_wl - bub_wv - bub_wg -+# gel -+gel_wv = 0. -+gel_wl = 0. -+gel_wa = 0. -+gel_wg = 1.00E00 - gel_wl - gel_wv - gel_wa -+ -+## SIMULATION PARAMETERS -+ -+# CFL -+cfl = 0.50 -+ -+# Bubble Initial Radius -+R0 = 230.4E-06 -+ -+# number of elements -+Nx0 = 400 -+Nx = 399 -+Ny = 199 -+Nz = 199 -+ -+lref = 921.6E-6 -+# domain boundaries -+xb = -lref -+xe = lref -+ -+yb = 0.00 -+ye = lref -+ -+zb = 0.00 -+ze = lref -+ -+lenx = ( xe - xb ) -+leny = ( ye - yb ) -+lenz = ( ze - zb ) -+ -+xcenl = (xb + xe)/2.0 -+ycenl = (yb + ye)/2.0 -+zcenl = (zb + ze)/2.0 -+ -+#xdist = 6.51E-10 #2.17E-5 -+#sod = xdist/R0 -+sod = -2.17 -+xcenb = sod*R0 -+ycenb = 0.00 -+zcenb = 0.00 -+ -+xbg = 0 -+xeg = xe -+ -+lenxg = (xeg - xbg) -+lenyg = leny -+lenzg = lenz -+xceng = (xbg + xeg)/2.0 -+yceng = ycenl -+zceng = zcenl -+ -+# typical cell size -+dx = ( xe - xb ) / Nx -+dy = ( ye - yb ) / Ny -+dz = ( ze - zb ) / Nz -+#print(dx) -+# time step -+ -+# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) -+SF = 60 -+ -+# Critical time-step -+tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) -+ -+# making Nt divisible by SF -+# tendA = 1.5 * tc -+tend = 1.2 * tc -+ -+# 1 - ensure NtA is sufficient to go a little beyond tendA -+# NtA = int( tendA // dt + 1 ) -+ -+# Array of saves. it is the same as Nt/Sf = t_step_save -+# AS = int( NtA // SF + 1 ) -+ -+# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) -+# Nt = AS * SF -+Nt = int(10E3 * tend // tc * Nx / Nx0 + 1) -+#print(Nt) -+dt = tend / Nt -+ -+AS = int( Nt//SF ) -+ -+# Total physical time -+# tend = Nt * dt -+ -+# Configuring case dictionary ================================================== -+print(json.dumps({ -+ # Logistics ================================================ -+ 'run_time_info': 'T', -+ # ========================================================== -+ # Computational Domain Parameters ========================== -+ 'x_domain%beg' : xb, -+ 'x_domain%end' : xe, -+ 'y_domain%beg' : yb, -+ 'y_domain%end' : ye, -+ 'z_domain%beg' : zb, -+ 'z_domain%end' : ze, -+ 'stretch_x' : 'F', -+ 'loops_x' : 1, -+ 'a_x' : 4.0E0, -+ 'x_a' : -2.0*R0, -+ 'x_b' : 2.0*R0, -+ 'stretch_y' : 'F', -+ 'loops_y' : 1, -+ 'a_y' : 4.0E0, -+ 'y_a' : -2.0*R0, -+ 'y_b' : 2.0*R0, -+ 'stretch_z' : 'F', -+ 'loops_z' : 1, -+ 'a_z' : 4.0E0, -+ 'z_a' : -2.0*R0, -+ 'z_b' : 2.0*R0, -+ 'cyl_coord' : 'F', -+ 'm' : Nx, -+ 'n' : Ny, -+ 'p' : Nz, -+ 'dt' : dt, -+ 't_step_start' : 0, -+ 't_step_stop' : Nt, -+ 't_step_save' : AS, -+ # ========================================================== -+ # Simulation Algorithm Parameters ========================== -+ 'num_patches' : 3, -+ 'model_eqns' : 3, -+ 'num_fluids' : 4, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'T', -+ 'mixture_err' : 'T', -+ 'relax' : 'T', -+ 'relax_model' : 6, -+ 'palpha_eps' : 1.0E-6, -+ 'ptgalpha_eps' : 1.0E-2, -+ 'time_stepper' : 3, -+ 'weno_order' : 3, -+ 'weno_eps' : 1.0E-16, -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'F', -+ 'riemann_solver' : 2, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -6, #-2, -+ 'bc_x%end' : -6, -+ 'bc_y%beg' : -2, -+ 'bc_y%end' : -6, -+ 'bc_z%beg' : -2, -+ 'bc_z%end' : -6, -+ # ========================================================== -+ # Formatted Database Files Structure Parameters ============ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt':'T', -+ 'parallel_io' :'T', -+ # ========================================================== -+ # Patch 1: High pressured water ============================ -+ # Specify the cubic water background grid geometry -+ 'patch_icpp(1)%geometry' : 9, -+ 'patch_icpp(1)%x_centroid' : xcenl, -+ 'patch_icpp(1)%y_centroid' : ycenl, -+ 'patch_icpp(1)%z_centroid' : zcenl, -+ 'patch_icpp(1)%length_x' : lenx, -+ 'patch_icpp(1)%length_y' : leny, -+ 'patch_icpp(1)%length_z' : lenz, -+ 'patch_icpp(1)%vel(1)' : 0.0E+00, -+ 'patch_icpp(1)%vel(2)' : 0.0E+00, -+ 'patch_icpp(1)%vel(3)' : 0.0E+00, -+ 'patch_icpp(1)%pres' : p01, -+ 'patch_icpp(1)%alpha_rho(1)' : liq_wl * rho0wl1, -+ 'patch_icpp(1)%alpha_rho(2)' : liq_wv * rho0wv1, -+ 'patch_icpp(1)%alpha_rho(3)' : liq_wa * rho0wa1, -+ 'patch_icpp(1)%alpha_rho(4)' : liq_wg * rho0wg1, -+ 'patch_icpp(1)%alpha(1)' : liq_wl, -+ 'patch_icpp(1)%alpha(2)' : liq_wv, -+ 'patch_icpp(1)%alpha(3)' : liq_wa, -+ 'patch_icpp(1)%alpha(4)' : liq_wg, -+ # ========================================================== -+ # Patch 2: (Vapor) Bubble ================================== -+ 'patch_icpp(2)%geometry' : 8, -+ 'patch_icpp(2)%x_centroid' : xcenb, -+ 'patch_icpp(2)%y_centroid' : ycenb, -+ 'patch_icpp(2)%z_centroid' : zcenb, -+ 'patch_icpp(2)%radius' : R0, -+ 'patch_icpp(2)%vel(1)' : 0.0E+00, -+ 'patch_icpp(2)%vel(2)' : 0.0E+00, -+ 'patch_icpp(2)%vel(3)' : 0.0E+00, -+ 'patch_icpp(2)%pres' : p02, -+ 'patch_icpp(2)%alpha_rho(1)' : bub_wl * rho0wl2, -+ 'patch_icpp(2)%alpha_rho(2)' : bub_wv * rho0wv2, -+ 'patch_icpp(2)%alpha_rho(3)' : bub_wa * rho0wa2, -+ 'patch_icpp(2)%alpha_rho(4)' : bub_wg * rho0wg2, -+ 'patch_icpp(2)%alpha(1)' : bub_wl, -+ 'patch_icpp(2)%alpha(2)' : bub_wv, -+ 'patch_icpp(2)%alpha(3)' : bub_wa, -+ 'patch_icpp(2)%alpha(4)' : bub_wg, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ # ========================================================== -+ # Patch 3: Gel Object ====================================== -+ 'patch_icpp(3)%geometry' : 9, -+ 'patch_icpp(3)%x_centroid' : xceng, -+ 'patch_icpp(3)%y_centroid' : yceng, -+ 'patch_icpp(3)%z_centroid' : zceng, -+ 'patch_icpp(3)%length_x' : lenxg, -+ 'patch_icpp(3)%length_y' : lenyg, -+ 'patch_icpp(3)%length_z' : lenzg, -+ 'patch_icpp(3)%vel(1)' : 0.0E+00, -+ 'patch_icpp(3)%vel(2)' : 0.0E+00, -+ 'patch_icpp(3)%vel(3)' : 0.0E+00, -+ 'patch_icpp(3)%pres' : p03, -+ 'patch_icpp(3)%alpha_rho(1)' : gel_wl * rho0wl2, -+ 'patch_icpp(3)%alpha_rho(2)' : gel_wv * rho0wv2, -+ 'patch_icpp(3)%alpha_rho(3)' : gel_wa * rho0wa2, -+ 'patch_icpp(3)%alpha_rho(4)' : gel_wg * rho0wg2, -+ 'patch_icpp(3)%alpha(1)' : gel_wl, -+ 'patch_icpp(3)%alpha(2)' : gel_wv, -+ 'patch_icpp(3)%alpha(3)' : gel_wa, -+ 'patch_icpp(3)%alpha(4)' : gel_wg, -+ 'patch_icpp(3)%alter_patch(1)' : 'T', -+ # ========================================================== -+ # Fluids Physical Parameters =============================== -+ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), -+ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), -+ 'fluid_pp(1)%cv' : cvwl, -+ 'fluid_pp(1)%qv' : qvwl, -+ 'fluid_pp(1)%qvp' : qvpwl, -+ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), -+ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), -+ 'fluid_pp(2)%cv' : cvwv, -+ 'fluid_pp(2)%qv' : qvwv, -+ 'fluid_pp(2)%qvp' : qvpwv, -+ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gamwa - 1 ), -+ 'fluid_pp(3)%pi_inf' : gamwa * pia / ( gamwa - 1 ), -+ 'fluid_pp(3)%cv' : cva, -+ 'fluid_pp(3)%qv' : qvwa, -+ 'fluid_pp(3)%qvp' : qvpwa, -+ 'fluid_pp(4)%gamma' : 1.0E+00 / ( gamwg - 1), -+ 'fluid_pp(4)%pi_inf' : gamwg * pig / ( gamwg - 1), -+ 'fluid_pp(4)%cv' : cvg, -+ 'fluid_pp(4)%qv' : qvwg, -+ 'fluid_pp(4)%qvp' : qvpwg, -+ # ========================================================== -+})) -diff --git a/examples/3D_ctr_test/old_case.py b/examples/3D_ctr_test/old_case.py -new file mode 100644 -index 00000000..092c0213 ---- /dev/null -+++ b/examples/3D_ctr_test/old_case.py -@@ -0,0 +1,399 @@ -+#!/usr/bin/env python3 -+import math, json -+ -+## 1 FOR BACKGROUND, 2 FOR BUBBLE, 3 FOR GEL -+# Pressure [Pa] -+p01 = 5E6 -+p02 = 3550 -+p03 = p01 -+ -+# Temperature [K] -+T01 = 298.15 -+T02 = 298.15 -+T03 = T01 -+ -+#### FLUID PROPERTIES #### -+ -+### liquid water ### -+# pi infty -+piwl = 1.0E+09 -+# qv -+qvwl = -1167000 -+# qv' -+qvpwl = 0.0E0 -+# cv -+cvwl = 1816 -+# cp -+cpwl = 4267 -+# gamma -+gamwl = cpwl / cvwl -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) -+rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) -+rho0wl3 = (p03 + piwl)/((gamwl-1)*cvwl*T03) -+ -+# speed of sound FOR -+c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) -+c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) -+c_wl3 = math.sqrt( gamwl * ( p03 + piwl ) / rho0wl3 ) -+ -+# part for Gases - relations from IMR -+Ru = 8.3144598 # Universal gas constant (J/mol-K) -+ -+### Vapor water ### -+Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) -+# gamma -+gamwv = 1.4 -+# cp -+cpwv = Rv * gamwv/(gamwv-1) -+# cv -+cvwv = cpwv/gamwv -+# pi infinity -+piwv = 0.0E0 -+# qv -+qvwv = 2030000 -+# qv' -+qvpwv = -23400 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) -+rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) -+rho0wv3 = (p03 + piwv)/((gamwv-1)*cvwv*T03) -+ -+# speed of sound -+c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) -+c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) -+c_wv3 = math.sqrt( gamwv * ( p03 + piwv ) / rho0wv3 ) -+ -+### Air ### -+ -+Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) -+gamwa = 1.4 -+# cp -+cpa = Ra * gamwa/(gamwa-1) -+# cv -+cva = cpa/gamwa -+# pi infinity -+pia = 0.0E0 -+# qv -+qvwa = 0.0E0 -+# qv' -+qvpwa = 0.0E0 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wa1 = (p01 + pia)/((gamwa-1)*cva*T01) -+rho0wa2 = (p02 + pia)/((gamwa-1)*cva*T02) -+ -+# Speed of sound -+c_a1 = math.sqrt( gamwa * ( p01 + pia ) / rho0wa1 ) -+c_a2 = math.sqrt( gamwa * ( p02 + pia ) / rho0wa2 ) -+ -+### 3% polyacrylamide gel ### -+# gamma -+gamwg = 2.35 -+# pi infty -+pig = 1.0E+09 -+# qv -+qvwg = -1167000 -+# qv' -+qvpwg = 0.0E0 -+# cv -+cvg = 1816 -+# cp -+cpg = gamwg*cvg -+ -+## FOR PATCHES 1 & 2 & 3 ## -+ -+# density -+rho0wg1 = (p01 + pig)/((gamwg-1)*cvg*T01) -+rho0wg2 = (p02 + pig)/((gamwg-1)*cvg*T02) -+rho0wg3 = (p03 + pig)/((gamwg-1)*cvg*T03) -+ -+# Speed of sound -+c_g1 = math.sqrt( gamwg * ( p01 + pig ) / rho0wg1 ) -+c_g2 = math.sqrt( gamwg * ( p02 + pig ) / rho0wg2 ) -+c_g3 = math.sqrt( gamwg * ( p03 + pig ) / rho0wg3 ) -+ -+## SHOCK RELATIONS -+p02Op01 = p02 / p01 -+ -+# Mach number of the shocked region - this should agree with Min, if everything is correct -+Ms = math.sqrt( ( gamwa + 1. ) / ( 2. * gamwa ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) -+ -+# shock speed -+ss = Ms * c_a1 -+ -+### volume fractions for each of the patches ### -+C0 = 0.1 # vapor concentration for IMR -+ -+# patch 1: liquid water -+liq_wv = 1.00E-15 -+liq_wg = 1.00E-15 -+liq_wa = 1.00E-15 -+liq_wl = 1.00E00 - liq_wv - liq_wa - liq_wg -+# water vapor -+vap_wl = 1.00E-15 -+vap_wv = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0wa2 + 1 ) -+vap_wg = 1.00E-15 -+vap_wa = 1.00E-15 -+vap_tot = vap_wl + vap_wv + vap_wa + vap_wg -+# bub -+bub_wl = 1.00E-15 -+bub_wv = vap_tot -+bub_wg = 1.00E-15 -+bub_wa = 1.00E00 - bub_wl - bub_wv - bub_wg -+# gel -+gel_wv = 1.00E-15 -+gel_wl = 1.00E-15 -+gel_wa = 1.00E-15 -+gel_wg = 1.00E00 - gel_wl - gel_wv - gel_wa -+ -+## SIMULATION PARAMETERS -+ -+# CFL -+cfl = 0.50 -+ -+# Bubble Initial Radius -+R0 = 230.4E-06 -+ -+# number of elements -+Nx0 = 400 -+Nx = 199*2 -+Ny = 199 -+Nz = 199 -+ -+lref = 921.6E-6 -+# domain boundaries -+xb = -lref -+xe = lref -+ -+yb = 0.00 -+ye = lref -+ -+zb = 0.00 -+ze = lref -+ -+lenx = ( xe - xb ) -+leny = ( ye - yb ) -+lenz = ( ze - zb ) -+ -+xcenl = (xb + xe)/2.0 -+ycenl = (yb + ye)/2.0 -+zcenl = (zb + ze)/2.0 -+ -+#xdist = 6.51E-10 #2.17E-5 -+#sod = xdist/R0 -+sod = -2.17 -+xcenb = sod*R0 -+ycenb = 0.00 -+zcenb = 0.00 -+ -+xbg = 0 -+xeg = xe -+ -+lenxg = (xeg - xbg) -+lenyg = leny -+lenzg = lenz -+xceng = (xbg + xeg)/2.0 -+yceng = ycenl -+zceng = zcenl -+ -+# typical cell size -+dx = ( xe - xb ) / Nx -+dy = ( ye - yb ) / Ny -+dz = ( ze - zb ) / Nz -+#print(dx) -+# time step -+ -+# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) -+SF = 60 -+ -+# Critical time-step -+tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) -+ -+# making Nt divisible by SF -+# tendA = 1.5 * tc -+tend = 1.2 * tc -+ -+# 1 - ensure NtA is sufficient to go a little beyond tendA -+# NtA = int( tendA // dt + 1 ) -+ -+# Array of saves. it is the same as Nt/Sf = t_step_save -+# AS = int( NtA // SF + 1 ) -+ -+# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) -+# Nt = AS * SF -+Nt = int(10E3 * tend // tc * Nx / Nx0 + 1) -+#print(Nt) -+dt = tend / Nt -+ -+AS = int( Nt//SF ) -+ -+# Total physical time -+# tend = Nt * dt -+ -+# Configuring case dictionary ================================================== -+print(json.dumps({ -+ # Logistics ================================================ -+ 'run_time_info': 'T', -+ # ========================================================== -+ # Computational Domain Parameters ========================== -+ 'x_domain%beg' : xb, -+ 'x_domain%end' : xe, -+ 'y_domain%beg' : yb, -+ 'y_domain%end' : ye, -+ 'z_domain%beg' : zb, -+ 'z_domain%end' : ze, -+ 'stretch_x' : 'F', -+ 'loops_x' : 1, -+ 'a_x' : 4.0E0, -+ 'x_a' : -2.0*R0, -+ 'x_b' : 2.0*R0, -+ 'stretch_y' : 'F', -+ 'loops_y' : 1, -+ 'a_y' : 4.0E0, -+ 'y_a' : -2.0*R0, -+ 'y_b' : 2.0*R0, -+ 'stretch_z' : 'F', -+ 'loops_z' : 1, -+ 'a_z' : 4.0E0, -+ 'z_a' : -2.0*R0, -+ 'z_b' : 2.0*R0, -+ 'cyl_coord' : 'F', -+ 'm' : Nx, -+ 'n' : Ny, -+ 'p' : Nz, -+ 'dt' : dt, -+ 't_step_start' : 0, -+ 't_step_stop' : Nt, -+ 't_step_save' : AS, -+ # ========================================================== -+ # Simulation Algorithm Parameters ========================== -+ 'num_patches' : 3, -+ 'model_eqns' : 3, -+ 'num_fluids' : 4, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'T', -+ 'mixture_err' : 'T', -+ 'relax' : 'T', -+ 'relax_model' : 6, -+ 'palpha_eps' : 1.0E-6, -+ 'ptgalpha_eps' : 1.0E-2, -+ 'time_stepper' : 3, -+ 'weno_order' : 3, -+ 'weno_eps' : 1.0E-16, -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'F', -+ 'riemann_solver' : 2, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -6, #-2, -+ 'bc_x%end' : -6, -+ 'bc_y%beg' : -2, -+ 'bc_y%end' : -6, -+ 'bc_z%beg' : -2, -+ 'bc_z%end' : -6, -+ # ========================================================== -+ # Formatted Database Files Structure Parameters ============ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt':'T', -+ 'parallel_io' :'T', -+ # ========================================================== -+ # Patch 1: High pressured water ============================ -+ # Specify the cubic water background grid geometry -+ 'patch_icpp(1)%geometry' : 9, -+ 'patch_icpp(1)%x_centroid' : xcenl, -+ 'patch_icpp(1)%y_centroid' : ycenl, -+ 'patch_icpp(1)%z_centroid' : zcenl, -+ 'patch_icpp(1)%length_x' : lenx, -+ 'patch_icpp(1)%length_y' : leny, -+ 'patch_icpp(1)%length_z' : lenz, -+ 'patch_icpp(1)%vel(1)' : 0.0E+00, -+ 'patch_icpp(1)%vel(2)' : 0.0E+00, -+ 'patch_icpp(1)%vel(3)' : 0.0E+00, -+ 'patch_icpp(1)%pres' : p01, -+ 'patch_icpp(1)%alpha_rho(1)' : liq_wl * rho0wl1, -+ 'patch_icpp(1)%alpha_rho(2)' : liq_wv * rho0wv1, -+ 'patch_icpp(1)%alpha_rho(3)' : liq_wa * rho0wa1, -+ 'patch_icpp(1)%alpha_rho(4)' : liq_wg * rho0wg1, -+ 'patch_icpp(1)%alpha(1)' : liq_wl, -+ 'patch_icpp(1)%alpha(2)' : liq_wv, -+ 'patch_icpp(1)%alpha(3)' : liq_wa, -+ 'patch_icpp(1)%alpha(4)' : liq_wg, -+ # ========================================================== -+ # Patch 2: (Vapor) Bubble ================================== -+ 'patch_icpp(2)%geometry' : 8, -+ 'patch_icpp(2)%x_centroid' : xcenb, -+ 'patch_icpp(2)%y_centroid' : ycenb, -+ 'patch_icpp(2)%z_centroid' : zcenb, -+ 'patch_icpp(2)%radius' : R0, -+ 'patch_icpp(2)%vel(1)' : 0.0E+00, -+ 'patch_icpp(2)%vel(2)' : 0.0E+00, -+ 'patch_icpp(2)%vel(3)' : 0.0E+00, -+ 'patch_icpp(2)%pres' : p02, -+ 'patch_icpp(2)%alpha_rho(1)' : bub_wl * rho0wl2, -+ 'patch_icpp(2)%alpha_rho(2)' : bub_wv * rho0wv2, -+ 'patch_icpp(2)%alpha_rho(3)' : bub_wa * rho0wa2, -+ 'patch_icpp(2)%alpha_rho(4)' : bub_wg * rho0wg2, -+ 'patch_icpp(2)%alpha(1)' : bub_wl, -+ 'patch_icpp(2)%alpha(2)' : bub_wv, -+ 'patch_icpp(2)%alpha(3)' : bub_wa, -+ 'patch_icpp(2)%alpha(4)' : bub_wg, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ # ========================================================== -+ # Patch 3: Gel Object ====================================== -+ 'patch_icpp(3)%geometry' : 9, -+ 'patch_icpp(3)%x_centroid' : xceng, -+ 'patch_icpp(3)%y_centroid' : yceng, -+ 'patch_icpp(3)%z_centroid' : zceng, -+ 'patch_icpp(3)%length_x' : lenxg, -+ 'patch_icpp(3)%length_y' : lenyg, -+ 'patch_icpp(3)%length_z' : lenzg, -+ 'patch_icpp(3)%vel(1)' : 0.0E+00, -+ 'patch_icpp(3)%vel(2)' : 0.0E+00, -+ 'patch_icpp(3)%vel(3)' : 0.0E+00, -+ 'patch_icpp(3)%pres' : p03, -+ 'patch_icpp(3)%alpha_rho(1)' : gel_wl * rho0wl2, -+ 'patch_icpp(3)%alpha_rho(2)' : gel_wv * rho0wv2, -+ 'patch_icpp(3)%alpha_rho(3)' : gel_wa * rho0wa2, -+ 'patch_icpp(3)%alpha_rho(4)' : gel_wg * rho0wg2, -+ 'patch_icpp(3)%alpha(1)' : gel_wl, -+ 'patch_icpp(3)%alpha(2)' : gel_wv, -+ 'patch_icpp(3)%alpha(3)' : gel_wa, -+ 'patch_icpp(3)%alpha(4)' : gel_wg, -+ 'patch_icpp(3)%alter_patch(1)' : 'T', -+ # ========================================================== -+ # Fluids Physical Parameters =============================== -+ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), -+ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), -+ 'fluid_pp(1)%cv' : cvwl, -+ 'fluid_pp(1)%qv' : qvwl, -+ 'fluid_pp(1)%qvp' : qvpwl, -+ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), -+ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), -+ 'fluid_pp(2)%cv' : cvwv, -+ 'fluid_pp(2)%qv' : qvwv, -+ 'fluid_pp(2)%qvp' : qvpwv, -+ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gamwa - 1 ), -+ 'fluid_pp(3)%pi_inf' : gamwa * pia / ( gamwa - 1 ), -+ 'fluid_pp(3)%cv' : cva, -+ 'fluid_pp(3)%qv' : qvwa, -+ 'fluid_pp(3)%qvp' : qvpwa, -+ 'fluid_pp(4)%gamma' : 1.0E+00 / ( gamwg - 1), -+ 'fluid_pp(4)%pi_inf' : gamwg * pig / ( gamwg - 1), -+ 'fluid_pp(4)%cv' : cvg, -+ 'fluid_pp(4)%qv' : qvwg, -+ 'fluid_pp(4)%qvp' : qvpwg, -+ # ========================================================== -+})) -diff --git a/examples/3D_hyperelasticity/hyper_gel.py b/examples/3D_hyperelasticity/hyper_gel.py -new file mode 100644 -index 00000000..09782de4 ---- /dev/null -+++ b/examples/3D_hyperelasticity/hyper_gel.py -@@ -0,0 +1,312 @@ -+import math -+import json -+#need quadrant and collapse near hypoelastic wall -+ -+## Define characteristic values for the sim -+Ri = 230.4E-6 -+# temperature -+T = (10*101325+1.0E+09)/(1000*(2.35-1)*1816) -+# print("T :: ",T) -+rhog = 1 -+Pb = 3550 #Pb = 101325 -+Pl = 101325 #Pl = 20*101325 -+Po = Pl -+Pi_inf_l = 1.0E+09 -+Pi_inf_b = 0.0E+00 -+Pi_inf_o = 1.1754E+09 -+ -+## fluid properties -+# liquid -+nl = 2.35E+00 -+cv_l = 1816 -+rhol = (Pl+Pi_inf_l)/((nl-1)*cv_l*T) -+# object -+obj_rhol = rhol -+cv_o = cv_l -+rhoo = 1060 -+no = 2.35 -+#no = 1.19E+00 -+muo = 0.060E+00 -+# gas -+ng = 1.47E+00 -+ -+# alpha seeding fractions -+bub_wl = 1.0E-12 -+bub_wo = 1.0E-12 -+bub_wg = 1 - bub_wl - bub_wo -+liq_wo = 1.0E-12 -+liq_wg = 1.0E-12 -+liq_wl = 1 - liq_wo - liq_wg -+obj_wl = 1.0E-12 -+obj_wg = 1.0E-12 -+obj_wo = 1 - obj_wl - obj_wg -+ -+Gl = 0. -+Gg = 0. -+Go = 0.57E+03 #1.0933E+04 -+ -+## mixture values in the liquid -+#rhoml = (alpha1-alph_eps)*rhol+alph_eps*rhog -+#pi_inf_m = (alpha1-alph_eps)*Pi_inf_l -+#nml = (alpha1-alph_eps)*nl+alph_eps*ng -+cl = (nl*(Pl+Pi_inf_l)/rhol)**(0.5) -+rhoml = liq_wl*rhol + liq_wg*rhog + liq_wo*rhoo -+ -+## Defining Characteristic Values -+Rc = Ri -+rhoc = rhol -+uc = (Pl/rhol)**(0.5E+00) -+ucc = (Pl/rhoml)**(0.5E+00) -+# characteristic collapse time, change later to prevent horrific confusion -+tc = Ri/uc -+Pc = rhoc*uc**(2.0E+00) -+ -+## Non-Dimensionalizing values using characteristic values -+Rin = Ri/Rc -+rholn = rhol/rhoc -+rhogn = rhog/rhoc -+rhoon = rhoo/rhoc -+Pln = Pl/Pc -+Pbn = Pb/Pc -+Pon = Po/Pc -+tcn = tc/tc -+Pi_inf_ln = Pi_inf_l/Pc -+clc = cl/uc -+sod_nd = 2.17 -+#clmc = clm/ucc -+Pi_inf_on = Pi_inf_o/Pc -+ -+# Un comment if dimensional -+#Rin = Ri -+#rholn = rhol -+#rhogn = rhog -+#rhoon = rhoo -+#Pln = Pl -+#Pbn = Pb/rhoo -+#Pon = Po -+#tcn = tc -+#Pi_inf_ln = Pi_inf_l -+#leng = domain_length -+#clc = cl -+#sod_nd = sod -+ -+## Non-Dimensional Numbers -+#Rel = rhol*uc*2*Rin/mulc -+#Reb = rhog*uc*2*Rin/mubc -+Rel = 0 -+Reb = 0 -+Reo = rhoo*uc*2/muo -+Ma = uc/cl -+Co = Pl/Go -+iCo = 1/Co -+ -+## GEOMETRY:: Grid Specifications -+lengx = 8.0E+00 -+lengy = 3.0E+00 -+lengz = 3.0E+00 -+CFL = 0.3 -+PPBR = 16 #92 -+x_beg = -5.0E+00 -+x_end = 3.0E+00 -+y_beg = 0.0E+00 -+y_end = lengy -+z_beg = 0.0E+00 -+z_end = lengz -+Nx = PPBR*lengx -+Ny = PPBR*lengy -+Nz = PPBR*lengz -+delta_x = lengx/Nx -+delta_t = CFL*delta_x/clc -+ -+#print("NX :: ",Nx,", NY :: ",Ny,", NZ :: ",Nz) -+ -+#delta_t_c = 0.185*delta_x/clmc -+#print(delta_t_c) -+ -+Nt = int(1.7*tcn/delta_t) -+# liquid centroid, patch 1 -+x_centroidl = x_beg/(2.0E+00) -+y_centroidl = (y_end+y_beg)/(2.0E+00) -+z_centroidl = (z_end+z_beg)/(2.0E+00) -+# bubble centroid, patch 2 -+x_centroidb = -sod_nd -+y_centroidb = 0.0 -+z_centroidb = 0.0 -+# objective centroid, patch 3 -+x_centroido = x_end/2 -+y_centroido = (y_end+y_beg)/(2.0E+00) -+z_centroido = (z_end+z_beg)/(2.0E+00) -+ -+# Configuring case dictionary -+print(json.dumps({ -+ # Logistics ================================================ -+ 'run_time_info' : 'T', -+ 'sim_data' : 'T', -+ # ========================================================== -+ -+ # Computational Domain Parameters ========================== -+ 'x_domain%beg' : x_beg, -+ 'x_domain%end' : x_end, -+ 'y_domain%beg' : y_beg, -+ 'y_domain%end' : y_end, -+ 'z_domain%beg' : z_beg, -+ 'z_domain%end' : z_end, -+ 'm' : int(Nx), -+ 'n' : int(Ny), -+ 'p' : int(Nz), -+ 'cyl_coord' : 'F', -+ 'dt' : delta_t, -+ 't_step_start' : 0, -+ 't_step_stop' : Nt, -+ 't_step_save' : int(5),#int(Nt/150), -+# ========================================================== -+ -+ # Simulation Algorithm Parameters ========================== -+ 'num_patches' : 3, -+ 'model_eqns' : 2, -+ 'hypoelasticity' : 'F', -+ 'hyperelasticity' : 'T', -+ 'pre_stress' : 'F', -+ 'alt_soundspeed' : 'F', -+ 'num_fluids' : 3, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'F', -+ 'mixture_err' : 'T', -+ 'time_stepper' : 3, -+ 'weno_order' : 5, -+ 'weno_eps' : 1.E-16, -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'T', -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'riemann_solver' : 1, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -6, #-16,#-2 -+ 'bc_x%end' : -6, -+ 'bc_y%beg' : -2, -+ 'bc_y%end' : -6, -+ 'bc_z%beg' : -2, -+ 'bc_z%end' : -6, -+ 'stretch_x' : 'F', -+ 'stretch_y' : 'F', -+ 'stretch_z' : 'F', -+ 'a_x' : 4.0E+00, -+ 'x_a' : -1.5E+00-sod_nd, -+ 'x_b' : 2.5E+00, -+ #'loops_x' : 0, -+ 'a_y' : 4.0E+00, -+ 'y_a' : -1.5E+00, -+ 'y_b' : 1.5E+00, -+ #'loops_y' : 0, -+ 'a_z' : 4.0E+00, -+ 'z_a' : -1.5E+00, -+ 'z_b' : 1.5E+00, -+ #'loops_z' : 0, -+ # ========================================================== -+ -+ # Formatted Database Files Structure Parameters ============ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt' :'T', -+ 'parallel_io' :'T', -+ 'probe_wrt' :'T', -+ 'fd_order' : 1, -+ 'num_probes' : 1, -+ 'probe(1)%x' : 0., -+ 'probe(1)%y' : 0., -+ 'probe(1)%z' : 0., -+ # ========================================================== -+ -+ # Patch 1: Background ============================ -+ 'patch_icpp(1)%geometry' : 9,# for 3D -+ 'patch_icpp(1)%x_centroid' : x_centroidl, #100*x_centroidl, -+ 'patch_icpp(1)%y_centroid' : y_centroidl, #100*y_centroidl, -+ 'patch_icpp(1)%z_centroid' : z_centroidl, #100*z_centroidl, -+ 'patch_icpp(1)%length_x' : lengx, #200*lengx, -+ 'patch_icpp(1)%length_y' : lengy, #200*lengy, -+ 'patch_icpp(1)%length_z' : lengz, #200*lengz, -+ 'patch_icpp(1)%vel(1)' : 0.E+00, -+ 'patch_icpp(1)%vel(2)' : 0.E+00, -+ 'patch_icpp(1)%vel(3)' : 0.E+00, -+ 'patch_icpp(1)%pres' : Pln, -+ 'patch_icpp(1)%alpha_rho(1)' : liq_wl*rholn, -+ 'patch_icpp(1)%alpha_rho(2)' : liq_wg*rhogn, -+ 'patch_icpp(1)%alpha_rho(3)' : liq_wo*rhoon, -+ 'patch_icpp(1)%alpha(1)' : liq_wl, -+ 'patch_icpp(1)%alpha(2)' : liq_wg, -+ 'patch_icpp(1)%alpha(3)' : liq_wo, -+ # ========================================================== -+ # Patch 2: Bubble ====================================== -+ # Specify the spherical gas bubble grid geometry -+ 'patch_icpp(2)%geometry' : 8,# for 3D -+ 'patch_icpp(2)%smoothen' : 'T', -+ 'patch_icpp(2)%smooth_patch_id' : 1, -+ 'patch_icpp(2)%smooth_coeff' : 4.0E+00, -+ 'patch_icpp(2)%x_centroid' : x_centroidb, -+ 'patch_icpp(2)%y_centroid' : y_centroidb, -+ 'patch_icpp(2)%z_centroid' : z_centroidb, -+ 'patch_icpp(2)%radius' : Rin, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ # Specify the patch primitive variables -+ 'patch_icpp(2)%vel(1)' : 0.E+00, -+ 'patch_icpp(2)%vel(2)' : 0.E+00, -+ 'patch_icpp(2)%vel(3)' : 0.E+00, -+ 'patch_icpp(2)%pres' : Pbn, -+ 'patch_icpp(2)%alpha_rho(1)' : bub_wl*rholn, -+ 'patch_icpp(2)%alpha_rho(2)' : bub_wg*rhogn, -+ 'patch_icpp(2)%alpha_rho(3)' : bub_wo*rhoon, -+ 'patch_icpp(2)%alpha(1)' : bub_wl, -+ 'patch_icpp(2)%alpha(2)' : bub_wg, -+ 'patch_icpp(2)%alpha(3)' : bub_wo, -+ # ========================================================== -+ # Patch 3: Gel =========================================== -+ # Specify the gel grid geometry -+ 'patch_icpp(3)%geometry' : 9,# for 3D -+ 'patch_icpp(3)%x_centroid' : x_centroido, #100*x_centroido, -+ 'patch_icpp(3)%y_centroid' : y_centroido, #100*y_centroido, -+ 'patch_icpp(3)%z_centroid' : z_centroido, #100*z_centroido, -+ 'patch_icpp(3)%length_x' : 3.0E+00, #100*lengx, -+ 'patch_icpp(3)%length_y' : lengy, #200*lengy, -+ 'patch_icpp(3)%length_z' : lengz, #200*lengz, -+ 'patch_icpp(3)%alter_patch(1)' : 'T', -+ # Specify the patch primitive variables -+ 'patch_icpp(3)%vel(1)' : 0.E+00, -+ 'patch_icpp(3)%vel(2)' : 0.E+00, -+ 'patch_icpp(3)%vel(3)' : 0.E+00, -+ 'patch_icpp(3)%pres' : Pon, -+ 'patch_icpp(3)%alpha_rho(1)' : obj_wl*rholn, -+ 'patch_icpp(3)%alpha_rho(2)' : obj_wg*rhogn, -+ 'patch_icpp(3)%alpha_rho(3)' : obj_wo*rhoon, -+ 'patch_icpp(3)%alpha(1)' : obj_wl, -+ 'patch_icpp(3)%alpha(2)' : obj_wg, -+ 'patch_icpp(3)%alpha(3)' : obj_wo, -+ # ========================================================== -+ -+ -+ # Fluids Physical Parameters =============================== -+ 'fluid_pp(1)%gamma' : 1./(nl-1.), -+ 'fluid_pp(1)%pi_inf' : nl*Pi_inf_ln/(nl-1.), -+ 'fluid_pp(1)%G' : Gl, -+ 'fluid_pp(2)%gamma' : 1./(ng-1.), -+ 'fluid_pp(2)%pi_inf' : 0.0E+00, -+ 'fluid_pp(2)%G' : Gg, -+ 'fluid_pp(3)%gamma' : 1./(no-1.), -+ 'fluid_pp(3)%pi_inf' : no*Pi_inf_on/(no-1.), -+ 'fluid_pp(3)%G' : iCo, -+ 'fluid_pp(1)%qv' : 0.0E+00, -+ 'fluid_pp(1)%qvp' : 0.0E+00, -+ 'fluid_pp(2)%qv' : 0.0E+00, -+ 'fluid_pp(2)%qvp' : 0.0E+00, -+ 'fluid_pp(3)%qv' : 0.0E+00, -+ 'fluid_pp(3)%qvp' : 0.0E+00, -+# 'fluid_pp(1)%Re(1)' : Rel, -+# 'fluid_pp(2)%Re(1)' : Reb, -+# 'fluid_pp(3)%Re(1)' : Reo, -+ # ===========++============================================= -+})) -+ -+# ============================================================================== -+ -+ -diff --git a/examples/3D_phasechange_bubble/case.py b/examples/3D_phasechange_bubble/case.py -new file mode 100644 -index 00000000..047c8655 ---- /dev/null -+++ b/examples/3D_phasechange_bubble/case.py -@@ -0,0 +1,300 @@ -+#!/usr/bin/env python3 -+import math, json -+ -+## 1 FOR BACKGROUND, 2 FOR BUBBLE -+# Pressure [Pa] -+p01 = 5E6 -+p02 = 3550 -+ -+# Temperature [K] -+T01 = 298.15 -+T02 = 298.15 -+#T02 = 7.914 -+ -+#### FLUID PROPERTIES #### -+ -+### liquid water ### -+# pi infty -+piwl = 1.0E+09 -+# qv -+qvwl = -1167000 -+# qv' -+qvpwl = 0.0E0 -+# cv -+cvwl = 1816 -+# cp -+cpwl = 4267 -+# gamma -+gamwl = cpwl / cvwl -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) -+rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) -+ -+# speed of sound FOR -+c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) -+c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) -+ -+# part for Gases - relations from IMR -+Ru = 8.3144598 # Universal gas constant (J/mol-K) -+ -+### Vapor water ### -+Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) -+# gamma -+gamwv = 1.4 -+# cp -+cpwv = Rv * gamwv/(gamwv-1) -+# cv -+cvwv = cpwv/gamwv -+# pi infinity -+piwv = 0.0E0 -+# qv -+qvwv = 2030000 -+# qv' -+qvpwv = -23400 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) -+rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) -+ -+# speed of sound -+c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) -+c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) -+ -+### Air ### -+ -+Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) -+# gamma -+gama = 1.4 -+# cp -+cpa = Ra * gama/(gama-1) -+# cv -+cva = cpa/gama -+# pi infinity -+pia = 0.0E0 -+# qv -+qva = 0.0E0 -+# qv' -+qvpa = 0.0E0 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0a1 = (p01 + pia)/((gama-1)*cva*T01) -+rho0a2 = (p02 + pia)/((gama-1)*cva*T02) -+ -+# Speed of sound -+c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) -+c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) -+ -+## SHOCK RELATIONS -+p02Op01 = p02 / p01 -+ -+# Mach number of the shocked region - this should agree with Min, if everything is correct -+Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) -+ -+# shock speed -+ss = Ms * c_a1 -+ -+### volume fractions for each of the patches ### -+C0 = 0.25 # vapor concentration for IMR -+ -+# water liquid -+awl1 = 1.00E00-2.00E-12 -+awl2 = 1.00E-12 -+# water vapor -+awv1 = 1.00E-12 -+awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) -+# air -+aa1 = 1.0 - awl1 - awv1 -+aa2 = 1.0 - awl2 - awv2 -+ -+## SIMULATION PARAMETERS -+ -+# CFL -+cfl = 0.50 -+ -+# Bubble Initial Radius -+R0 = 30E-06 -+ -+# number of elements -+Nx0 = 400 -+Nx = 199 -+Ny = 199 -+Nz = 199 -+ -+# domain boundaries -+xb = 0.00 -+xe = 120E-6 -+ -+yb = 0.00 -+ye = 120E-6 -+ -+zb = 0.00 -+ze = 120E-6 -+ -+# typical cell size -+dx = ( xe - xb ) / Nx -+dy = ( ye - yb ) / Ny -+dz = ( ze - zb ) / Nz -+ -+# time step -+ -+# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) -+SF = 200 -+ -+# Critical time-step -+tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) -+ -+# making Nt divisible by SF -+# tendA = 1.5 * tc -+tend = 1.2 * tc -+ -+# 1 - ensure NtA is sufficient to go a little beyond tendA -+# NtA = int( tendA // dt + 1 ) -+ -+# Array of saves. it is the same as Nt/Sf = t_step_save -+# AS = int( NtA // SF + 1 ) -+ -+# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) -+# Nt = AS * SF -+Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) -+ -+dt = tend / Nt -+ -+AS = int( Nt//SF ) -+ -+# Total physical time -+# tend = Nt * dt -+ -+# Configuring case dictionary ================================================== -+print(json.dumps({ -+ # Logistics ================================================ -+ 'run_time_info': 'T', -+ # ========================================================== -+ # Computational Domain Parameters ========================== -+ 'x_domain%beg' : xb, -+ 'x_domain%end' : xe, -+ 'y_domain%beg' : yb, -+ 'y_domain%end' : ye, -+ 'z_domain%beg' : zb, -+ 'z_domain%end' : ze, -+ 'stretch_x' : 'T', -+ 'loops_x' : 3, -+ 'a_x' : 4.0E0, -+ 'x_a' : -2.0*R0, -+ 'x_b' : 2.0*R0, -+ 'stretch_y' : 'T', -+ 'loops_y' : 3, -+ 'a_y' : 4.0E0, -+ 'y_a' : -2.0*R0, -+ 'y_b' : 2.0*R0, -+ 'stretch_z' : 'T', -+ 'loops_z' : 3, -+ 'a_z' : 4.0E0, -+ 'z_a' : -2.0*R0, -+ 'z_b' : 2.0*R0, -+ 'cyl_coord' : 'F', -+ 'm' : Nx, -+ 'n' : Ny, -+ 'p' : Nz, -+ 'dt' : dt, -+ 't_step_start' : 0, -+ 't_step_stop' : Nt, -+ 't_step_save' : AS, -+ # ========================================================== -+ # Simulation Algorithm Parameters ========================== -+ 'num_patches' : 2, -+ 'model_eqns' : 3, -+ 'num_fluids' : 3, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'T', -+ 'mixture_err' : 'T', -+ 'relax' : 'T', -+ 'relax_model' : 6, -+ 'palpha_eps' : 1.0E-6, -+ 'ptgalpha_eps' : 1.0E-2, -+ 'time_stepper' : 3, -+ 'weno_order' : 3, -+ 'weno_eps' : 1.0E-32, -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'F', -+ 'riemann_solver' : 2, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -2, -+ 'bc_x%end' : -6, -+ 'bc_y%beg' : -2, -+ 'bc_y%end' : -6, -+ 'bc_z%beg' : -2, -+ 'bc_z%end' : -6, -+ # ========================================================== -+ # Formatted Database Files Structure Parameters ============ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt':'T', -+ 'parallel_io' :'T', -+ # ========================================================== -+ # Patch 1: High pressured water ============================ -+ # Specify the cubic water background grid geometry -+ 'patch_icpp(1)%geometry' : 9, -+ 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, -+ 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, -+ 'patch_icpp(1)%z_centroid' : ( ze + zb ) * 500000 / 100, -+ 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, -+ 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, -+ 'patch_icpp(1)%length_z' : ( ze - zb ) * 1000000 / 100, -+ 'patch_icpp(1)%vel(1)' : 0.0E+00, -+ 'patch_icpp(1)%vel(2)' : 0.0E+00, -+ 'patch_icpp(1)%vel(3)' : 0.0E+00, -+ 'patch_icpp(1)%pres' : p01, -+ 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, -+ 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, -+ 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, -+ 'patch_icpp(1)%alpha(1)' : awl1, -+ 'patch_icpp(1)%alpha(2)' : awv1, -+ 'patch_icpp(1)%alpha(3)' : aa1, -+ # ========================================================== -+ # Patch 2: (Vapor) Bubble ================================== -+ 'patch_icpp(2)%geometry' : 8, -+ 'patch_icpp(2)%x_centroid' : xb, -+ 'patch_icpp(2)%y_centroid' : yb, -+ 'patch_icpp(2)%z_centroid' : zb, -+ 'patch_icpp(2)%radius' : R0, -+ 'patch_icpp(2)%vel(1)' : 0.0E+00, -+ 'patch_icpp(2)%vel(2)' : 0.0E+00, -+ 'patch_icpp(2)%vel(3)' : 0.0E+00, -+ 'patch_icpp(2)%pres' : p02, -+ 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, -+ 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, -+ 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, -+ 'patch_icpp(2)%alpha(1)' : awl2, -+ 'patch_icpp(2)%alpha(2)' : awv2, -+ 'patch_icpp(2)%alpha(3)' : aa2, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ # ========================================================== -+ # Fluids Physical Parameters =============================== -+ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), -+ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), -+ 'fluid_pp(1)%cv' : cvwl, -+ 'fluid_pp(1)%qv' : qvwl, -+ 'fluid_pp(1)%qvp' : qvpwl, -+ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), -+ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), -+ 'fluid_pp(2)%cv' : cvwv, -+ 'fluid_pp(2)%qv' : qvwv, -+ 'fluid_pp(2)%qvp' : qvpwv, -+ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), -+ 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), -+ 'fluid_pp(3)%cv' : cva, -+ 'fluid_pp(3)%qv' : qva, -+ 'fluid_pp(3)%qvp' : qvpa, -+ # ========================================================== -+})) -diff --git a/run_mfc.sh b/run_mfc.sh -new file mode 100755 -index 00000000..fc734bea ---- /dev/null -+++ b/run_mfc.sh -@@ -0,0 +1,14 @@ -+#!/bin/bash -+ -+./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar -+ -+./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar -+ -+./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar -+ -diff --git a/src/common/include/inline_conversions.fpp b/src/common/include/inline_conversions.fpp -index a63af61e..c2f0263e 100644 ---- a/src/common/include/inline_conversions.fpp -+++ b/src/common/include/inline_conversions.fpp -@@ -1,17 +1,17 @@ - #:def s_compute_speed_of_sound() -- subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c) -+ subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c, G) - #ifdef CRAY_ACC_WAR - !DIR$ INLINEALWAYS s_compute_speed_of_sound - #else - !$acc routine seq - #endif -- real(kind(0d0)), intent(in) :: pres -- real(kind(0d0)), intent(in) :: rho, gamma, pi_inf -- real(kind(0d0)), intent(in) :: H -- real(kind(0d0)), dimension(num_fluids), intent(in) :: adv -- real(kind(0d0)), intent(in) :: vel_sum -- real(kind(0d0)), intent(out) :: c -- -+ real(kind(0d0)), intent(IN) :: pres -+ real(kind(0d0)), intent(IN) :: rho, gamma, pi_inf -+ real(kind(0d0)), intent(IN) :: H -+ real(kind(0d0)), dimension(num_fluids), intent(IN) :: adv -+ real(kind(0d0)), intent(IN) :: vel_sum -+ real(kind(0d0)), optional, dimension(num_fluids), intent(IN) :: G -+ real(kind(0d0)), intent(OUT) :: c - real(kind(0d0)) :: blkmod1, blkmod2 - - integer :: q -@@ -22,6 +22,7 @@ - blkmod2 = ((gammas(2) + 1d0)*pres + & - pi_infs(2))/gammas(2) - c = (1d0/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2))) -+ - elseif (model_eqns == 3) then - c = 0d0 - !$acc loop seq -@@ -43,6 +44,7 @@ - (pres + pi_inf/(gamma + 1d0))/ & - (rho*(1d0 - adv(num_fluids))) - end if -+ - else - c = ((H - 5d-1*vel_sum)/gamma) - end if -diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp -index 2a15083c..386a844c 100644 ---- a/src/common/m_checker_common.fpp -+++ b/src/common/m_checker_common.fpp -@@ -38,6 +38,7 @@ contains - call s_check_inputs_qbmm_and_polydisperse - if (adv_n) call s_check_inputs_adv_n - if (hypoelasticity) call s_check_inputs_hypoelasticity -+ if (hyperelasticity) call s_check_inputs_hyperelasticity - call s_check_inputs_phase_change - call s_check_inputs_ibm - #endif -@@ -173,12 +174,27 @@ contains - !> Checks constraints on the hypoelasticity parameters. - !! Called by s_check_inputs_common for pre-processing and simulation - subroutine s_check_inputs_hypoelasticity -- if (model_eqns /= 2) then -- call s_mpi_abort('hypoelasticity requires 5-equation model'// & -- '(model_eqns = 2). Exiting ...') -+ !if ((model_eqns /= 2) .or. (model_eqns /= 3)) then -+ if ((model_eqns == 1) .or. (model_eqns == 4)) then -+ call s_mpi_abort('hypoelasticity requires either '// & -+ '5-equation (model_eqns = 2) or '// & -+ '6-equation model (model_eqns = 3). Exiting ...') -+ end if -+ if (hyperelasticity) then -+ call s_mpi_abort('hyperelasticity cannot be true with hypoelasticity. '// & -+ 'Exiting ...') - end if - end subroutine s_check_inputs_hypoelasticity - -+ !> Checks constraints on the hyperelasticity parameters. -+ !! Called by s_check_inputs_common for pre-processing and simulation -+ subroutine s_check_inputs_hyperelasticity -+ if (model_eqns /= 3) then -+ call s_mpi_abort('hyperelasticity requires '// & -+ '6-equation model (model_eqns = 3). Exiting ...') -+ end if -+ end subroutine s_check_inputs_hyperelasticity -+ - !> Checks constraints on the phase change parameters. - !! Called by s_check_inputs_common for pre-processing and simulation - subroutine s_check_inputs_phase_change -diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp -index a506acb9..6f9ab2ff 100644 ---- a/src/common/m_constants.fpp -+++ b/src/common/m_constants.fpp -@@ -7,18 +7,18 @@ module m_constants - character, parameter :: dflt_char = ' ' !< Default string value - - real(kind(0d0)), parameter :: dflt_real = -1d6 !< Default real value -- real(kind(0d0)), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance -- real(kind(0d0)), parameter :: small_alf = 1d-11 !< Small alf tolerance -- real(kind(0d0)), parameter :: pi = 3.141592653589793d0 !< Pi -+ real(kind(0d0)), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance -+ real(kind(0d0)), parameter :: small_alf = 1d-11 !< Small alf tolerance -+ real(kind(0d0)), parameter :: pi = 3.141592653589793d0 !< Pi - real(kind(0d0)), parameter :: verysmall = 1.d-12 !< Very small number - -- integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils -- integer, parameter :: path_len = 400 !< Maximum path length -- integer, parameter :: name_len = 50 !< Maximum name length -- integer, parameter :: dflt_int = -100 !< Default integer value -- integer, parameter :: fourier_rings = 5 !< Fourier filter ring limit -- integer, parameter :: num_fluids_max = 10 !< Maximum number of fluids in the simulation -- integer, parameter :: num_probes_max = 10 !< Maximum number of flow probes in the simulation -+ integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils -+ integer, parameter :: path_len = 400 !< Maximum path length -+ integer, parameter :: name_len = 50 !< Maximum name length -+ integer, parameter :: dflt_int = -100 !< Default integer value -+ integer, parameter :: fourier_rings = 5 !< Fourier filter ring limit -+ integer, parameter :: num_fluids_max = 10 !< Maximum number of fluids in the simulation -+ integer, parameter :: num_probes_max = 10 !< Maximum number of flow probes in the simulation - integer, parameter :: num_patches_max = 10 - integer, parameter :: pathlen_max = 400 - integer, parameter :: nnode = 4 !< Number of QBMM nodes -diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp -index 9ad172cc..cea5f90d 100644 ---- a/src/common/m_derived_types.fpp -+++ b/src/common/m_derived_types.fpp -@@ -142,7 +142,13 @@ module m_derived_types - type(ic_model_parameters) :: model !< Model parameters - - real(kind(0d0)) :: epsilon, beta !< -- !! The spherical harmonics eccentricity parameters. -+ !! The isentropic vortex parameters administrating, respectively, both -+ !! the amplitude of the disturbance as well as its domain of influence. -+ -+ real(kind(0d0)) :: a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 !< -+ !! The parameters needed for the spherical harmonic patch -+ -+ logical :: non_axis_sym - - real(kind(0d0)), dimension(3) :: normal !< - !! Normal vector indicating the orientation of the patch. It is specified -diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp -index b6d48729..a2b77082 100644 ---- a/src/common/m_helper.fpp -+++ b/src/common/m_helper.fpp -@@ -73,8 +73,8 @@ contains - lE = q - end if - -- if (allocated(fd_coeff_s)) deallocate (fd_coeff_s) -- allocate (fd_coeff_s(-fd_number_in:fd_number_in, lb:lE)) -+ if (allocated(fd_coeff_s)) deallocate(fd_coeff_s) -+ allocate(fd_coeff_s(-fd_number_in:fd_number_in, lb:lE)) - - ! Computing the 1st order finite-difference coefficients - if (fd_order_in == 1) then -@@ -83,7 +83,6 @@ contains - fd_coeff_s(0, i) = -1d0/(s_cc(i + 1) - s_cc(i)) - fd_coeff_s(1, i) = -fd_coeff_s(0, i) - end do -- - ! Computing the 2nd order finite-difference coefficients - elseif (fd_order_in == 2) then - do i = lB, lE -@@ -91,7 +90,6 @@ contains - fd_coeff_s(0, i) = 0d0 - fd_coeff_s(1, i) = -fd_coeff_s(-1, i) - end do -- - ! Computing the 4th order finite-difference coefficients - else - do i = lB, lE -@@ -101,7 +99,6 @@ contains - fd_coeff_s(1, i) = -fd_coeff_s(-1, i) - fd_coeff_s(2, i) = -fd_coeff_s(-2, i) - end do -- - end if - - end subroutine s_compute_finite_difference_coefficients -diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp -index f6372322..c13fa233 100644 ---- a/src/common/m_phase_change.fpp -+++ b/src/common/m_phase_change.fpp -@@ -1,11 +1,3 @@ --!> --!! @file m_phase_change.fpp --!! @brief Contains module m_phasechange -- --#:include 'macros.fpp' -- --!> @brief This module is used to relax the model equations (6-eqn model) --!> towards pressure and temperature (6-eqn to 4-eqn), and (if wanted) Gibbs free - !> energies (6-eqn to 4-eqn) equilibrium through an infinitely fast (algebraic) - !> procedure. - module m_phase_change -@@ -356,8 +348,9 @@ contains - - ! Newton Solver for the pT-equilibrium - ns = 0 -- ! change this relative error metric. 1E4 is just arbitrary -- do while ((DABS(pS - pO) > palpha_eps) .and. (DABS((pS - pO)/pO) > palpha_eps/1e4) .or. (ns == 0)) -+ ! change this relative error metric. 1E4 is arbitrary -+ do while ((DABS(pS - pO) > palpha_eps) .and. & -+ (DABS((pS - pO)/pO) > palpha_eps/1d4) .or. (ns == 0)) - - ! increasing counter - ns = ns + 1 -diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp -index 46436cb8..5652470a 100644 ---- a/src/common/m_variables_conversion.fpp -+++ b/src/common/m_variables_conversion.fpp -@@ -22,6 +22,7 @@ module m_variables_conversion - use m_helper_basic !< Functions to compare floating point numbers - - use m_helper -+ - ! ========================================================================== - - implicit none -@@ -145,8 +146,8 @@ contains - else - pres = (pref + pi_inf)* & - (energy/ & -- (rhoref*(1 - alf)) & -- )**(1/gamma + 1) - pi_inf -+ (rhoref*(1.d0 - alf)) & -+ )**(1.d0/gamma + 1.d0) - pi_inf - end if - - if (hypoelasticity .and. present(G)) then -@@ -164,11 +165,7 @@ contains - end if - end do - -- pres = ( & -- energy - & -- 0.5d0*(mom**2.d0)/rho - & -- pi_inf - qv - E_e & -- )/gamma -+ pres = (energy - 0.5d0*(mom**2.d0)/rho - pi_inf - qv - E_e)/gamma - - end if - -@@ -409,7 +406,6 @@ contains - pi_inf = pi_inf + alpha_K(i)*pi_infs(i) - qv = qv + alpha_rho_K(i)*qvs(i) - end do -- - #ifdef MFC_SIMULATION - ! Computing the shear and bulk Reynolds numbers from species analogs - do i = 1, 2 -@@ -427,6 +423,7 @@ contains - #endif - - if (present(G_K)) then -+ !TODO Check our mixture rule? Replace with Cauchy numbers, make code nondimensional - G_K = 0d0 - do i = 1, num_fluids - G_K = G_K + alpha_K(i)*G(i) -@@ -502,6 +499,7 @@ contains - G_K = 0d0 - do i = 1, num_fluids - !TODO: change to use Gs directly here? -+ !TODO: Make this changes as well for GPUs - G_K = G_K + alpha_K(i)*G(i) - end do - G_K = max(0d0, G_K) -@@ -679,7 +677,6 @@ contains - do i = 1, nb - bubrs(i) = bub_idx%rs(i) - end do -- - !$acc update device(bubrs) - end if - -@@ -862,7 +859,7 @@ contains - - integer :: i, j, k, l, q !< Generic loop iterators - -- real(kind(0.d0)) :: ntmp -+ real(kind(0d0)) :: ntmp - - #:if MFC_CASE_OPTIMIZATION - #ifndef MFC_SIMULATION -@@ -880,7 +877,7 @@ contains - end if - #:endif - -- !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp) -+ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe -@@ -900,7 +897,7 @@ contains - if (model_eqns /= 4) then - #ifdef MFC_SIMULATION - ! If in simulation, use acc mixture subroutines -- if (hypoelasticity) then -+ if (elasticity) then - call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & - alpha_rho_K, Re_K, j, k, l, G_K, Gs) - else if (bubbles) then -@@ -912,7 +909,7 @@ contains - end if - #else - ! If pre-processing, use non acc mixture subroutines -- if (hypoelasticity) then -+ if (elasticity) then - call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & - rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) - else -@@ -988,7 +985,7 @@ contains - qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & - /rho_K - ! subtracting elastic contribution for pressure calculation -- if (G_K > 1000) then !TODO: check if stable for >0 -+ if (G_K .gt. verysmall) then !TODO: check if stable for >0 - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K - ! extra terms in 2 and 3D -@@ -1002,6 +999,17 @@ contains - end do - end if - -+ if (hyperelasticity) then -+ !$acc loop seq -+ do i = strxb, strxe -+ qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K -+ end do -+ !$acc loop seq -+ do i = xibeg, xiend -+ qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K -+ end do -+ end if -+ - !$acc loop seq - do i = advxb, advxe - qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) -@@ -1016,7 +1024,9 @@ contains - end do - !$acc end parallel loop - -- end subroutine s_convert_conservative_to_primitive_variables -+ !print *, 'I got here AA' -+ -+ end subroutine s_convert_conservative_to_primitive_variables ! --------- - - !> The following procedure handles the conversion between - !! the primitive variables and the conservative variables. -@@ -1029,13 +1039,8 @@ contains - subroutine s_convert_primitive_to_conservative_variables(q_prim_vf, & - q_cons_vf) - -- type(scalar_field), & -- dimension(sys_size), & -- intent(in) :: q_prim_vf -- -- type(scalar_field), & -- dimension(sys_size), & -- intent(inout) :: q_cons_vf -+ type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf -+ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf - - ! Density, specific heat ratio function, liquid stiffness function - ! and dynamic pressure, as defined in the incompressible flow sense, -@@ -1144,10 +1149,10 @@ contains - end if - - if (hypoelasticity) then -- do i = stress_idx%beg, stress_idx%end -+ do i = strxb, strxe - q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) - ! adding elastic contribution -- if (G > 1000) then -+ if (G .gt. verysmall) then - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) - ! extra terms in 2 and 3D -@@ -1161,6 +1166,19 @@ contains - end do - end if - -+ ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 -+ if (hyperelasticity) then -+ ! adding the elastic contribution -+ ! Multiply \tau to \rho \tau -+ do i = strxb, strxe -+ q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) -+ end do -+ ! Multiply \xi to \rho \xi -+ do i = xibeg, xiend -+ q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) -+ end do -+ end if -+ - if (.not. f_is_default(sigma)) then - q_cons_vf(c_idx)%sf(j, k, l) = q_prim_vf(c_idx)%sf(j, k, l) - end if -@@ -1168,7 +1186,6 @@ contains - end do - end do - end do -- - #else - if (proc_rank == 0) then - call s_mpi_abort('Conversion from primitive to '// & -@@ -1176,7 +1193,6 @@ contains - 'implemented. Exiting ...') - end if - #endif -- - end subroutine s_convert_primitive_to_conservative_variables - - !> The following subroutine handles the conversion between -@@ -1252,7 +1268,7 @@ contains - end do - - pres_K = qK_prim_vf(j, k, l, E_idx) -- if (hypoelasticity) then -+ if (elasticity) then - call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, & - alpha_K, alpha_rho_K, Re_K, & - j, k, l, G_K, Gs) -@@ -1310,10 +1326,11 @@ contains - end do - end do - #endif -- - end subroutine s_convert_primitive_to_flux_variables - -- subroutine s_finalize_variables_conversion_module -+ subroutine s_finalize_variables_conversion_module() ! ------------------ -+ -+ integer :: i !< Generic loop iterators - - ! Deallocating the density, the specific heat ratio function and the - ! liquid stiffness function -diff --git a/src/post_process/m_data_input.f90 b/src/post_process/m_data_input.f90 -index 567816f7..bbd063df 100644 ---- a/src/post_process/m_data_input.f90 -+++ b/src/post_process/m_data_input.f90 -@@ -370,7 +370,7 @@ contains - NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) - - ! Read the data for each variable -- if (bubbles .or. hypoelasticity) then -+ if (bubbles .or. elasticity) then - do i = 1, sys_size - var_MOK = int(i, MPI_OFFSET_KIND) - -@@ -444,7 +444,7 @@ contains - NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) - - ! Read the data for each variable -- if (bubbles .or. hypoelasticity) then -+ if (bubbles .or. elasticity) then - do i = 1, sys_size - var_MOK = int(i, MPI_OFFSET_KIND) - -diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp -index 7aa7e873..e68c021b 100644 ---- a/src/post_process/m_data_output.fpp -+++ b/src/post_process/m_data_output.fpp -@@ -16,6 +16,8 @@ module m_data_output - - use m_global_parameters ! Global parameters for the code - -+ use m_derived_variables !< Procedures used to compute quantities derived -+ - use m_mpi_proxy ! Message passing interface (MPI) module proxy - - use m_compile_specific -@@ -27,9 +29,15 @@ module m_data_output - - private; public :: s_initialize_data_output_module, & - s_open_formatted_database_file, & -+ s_open_intf_data_file, & -+ s_open_energy_data_file, & - s_write_grid_to_formatted_database_file, & - s_write_variable_to_formatted_database_file, & -+ s_write_intf_data_file, & -+ s_write_energy_data_file, & - s_close_formatted_database_file, & -+ s_close_intf_data_file, & -+ s_close_energy_data_file, & - s_finalize_data_output_module - - ! Including the Silo Fortran interface library that features the subroutines -@@ -531,7 +539,40 @@ contains - - end subroutine s_open_formatted_database_file - -- subroutine s_write_grid_to_formatted_database_file(t_step) -+ subroutine s_open_intf_data_file() ! ------------------------ -+ -+ character(LEN=path_len + 3*name_len) :: file_path !< -+ !! Relative path to a file in the case directory -+ -+ write (file_path, '(A)') '/intf_data.dat' -+ file_path = trim(case_dir)//trim(file_path) -+ -+ ! Opening the simulation data file -+ open (211, FILE=trim(file_path), & -+ FORM='formatted', & -+ POSITION='append', & -+ STATUS='unknown') -+ -+ end subroutine s_open_intf_data_file ! --------------------------------------- -+ -+ subroutine s_open_energy_data_file() ! ------------------------ -+ -+ character(LEN=path_len + 3*name_len) :: file_path !< -+ !! Relative path to a file in the case directory -+ -+ write (file_path, '(A)') '/eng_data.dat' -+ file_path = trim(case_dir)//trim(file_path) -+ -+ ! Opening the simulation data file -+ open (251, FILE=trim(file_path), & -+ FORM='formatted', & -+ POSITION='append', & -+ STATUS='unknown') -+ -+ end subroutine s_open_energy_data_file ! ---------------------------------------- -+ -+ subroutine s_write_grid_to_formatted_database_file(t_step) ! ----------- -+ - ! Description: The general objective of this subroutine is to write the - ! necessary grid data to the formatted database file, for - ! the current time-step, t_step. The local processor will -@@ -939,7 +980,196 @@ contains - - end subroutine s_write_variable_to_formatted_database_file - -- subroutine s_close_formatted_database_file -+ subroutine s_write_intf_data_file(q_prim_vf) -+ -+ type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf -+ integer :: i, j, k, l, w, cent !< Generic loop iterators -+ integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations -+ real(kind(0d0)), dimension(num_fluids) :: alpha, vol_fluid, xcom, ycom, zcom -+ real(kind=8), parameter :: pi = 4.d0*datan(1.d0) -+ real(kind(0d0)), allocatable :: x_td(:), y_td(:), x_d1(:), y_d1(:), y_d(:), x_d(:) -+ real(kind(0d0)) :: axp, axm, ayp, aym, azm, azp, tgp, euc_d, thres, maxalph_loc, maxalph_glb -+ -+ allocate (x_d1(m*n)) -+ allocate (y_d1(m*n)) -+ counter = 0 -+ maxalph_loc = 0d0 -+ do k = 0, p -+ do j = 0, n -+ do i = 0, m -+ if (q_prim_vf(E_idx + 2)%sf(i, j, k) > maxalph_loc) then -+ maxalph_loc = q_prim_vf(E_idx + 2)%sf(i, j, k) -+ end if -+ end do -+ end do -+ end do -+ -+ call s_mpi_allreduce_max(maxalph_loc, maxalph_glb) -+ if (p > 0) then -+ do l = 0, p -+ if (z_cc(l) < dz(l) .and. z_cc(l) > 0) then -+ cent = l -+ end if -+ end do -+ else -+ cent = 0 -+ end if -+ -+ thres = 0.9d0*maxalph_glb -+ do k = 0, n -+ OLoop: do j = 0, m -+ axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) -+ axm = q_prim_vf(E_idx + 2)%sf(j, k, cent) -+ ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, cent) -+ aym = q_prim_vf(E_idx + 2)%sf(j, k, cent) -+ if ((axp > thres .and. axm < thres) .or. (axp < thres .and. axm > thres) & -+ .or. (ayp > thres .and. aym < thres) .or. (ayp < thres .and. aym > thres)) then -+ if (counter == 0) then -+ counter = counter + 1 -+ x_d1(counter) = x_cc(j) -+ y_d1(counter) = y_cc(k) -+ euc_d = sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2) -+ tgp = sqrt(dx(j)**2 + dy(k)**2) -+ else -+ euc_d = dsqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2) -+ tgp = dsqrt(dx(j)**2 + dy(k)**2) -+ do i = 1, counter -+ if (euc_d < tgp) then -+ cycle OLoop -+ elseif (euc_d > tgp .and. i == counter) then -+ counter = counter + 1 -+ x_d1(counter) = x_cc(j) -+ y_d1(counter) = y_cc(k) -+ -+ end if -+ end do -+ end if -+ end if -+ end do OLoop -+ end do -+ -+ allocate (y_d(counter)) -+ allocate (x_d(counter)) -+ do i = 1, counter -+ y_d(i) = y_d1(i) -+ x_d(i) = x_d1(i) -+ end do -+ root = 0 -+ -+ call s_mpi_gather_data(x_d, counter, x_td, root) -+ call s_mpi_gather_data(y_d, counter, y_td, root) -+ if (proc_rank == 0) then -+ do i = 1, size(x_td) -+ if (i == size(x_td)) then -+ write (211, '(F12.9,1X,F12.9,1X,I4)') & -+ x_td(i), y_td(i), size(x_td) -+ else -+ write (211, '(F12.9,1X,F12.9,1X,F3.1)') & -+ x_td(i), y_td(i), 0d0 -+ end if -+ end do -+ end if -+ -+ end subroutine s_write_intf_data_file ! ----------------------------------- -+ -+ subroutine s_write_energy_data_file(q_prim_vf, q_cons_vf) -+ type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf, q_cons_vf -+ real(kind(0d0)) :: Elk, Egk, Elp, Egint, Vb, Vl, pres_av, Et -+ real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, MaxMa, MaxMa_glb, maxvel, c, Ma, H -+ real(kind(0d0)), dimension(num_dims) :: vel -+ real(kind(0d0)), dimension(num_fluids) :: gammas, pi_infs, adv -+ integer :: i, j, k, l, s !looping indicies -+ integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations -+ -+ Egk = 0d0 -+ Elp = 0d0 -+ Egint = 0d0 -+ Vb = 0d0 -+ maxvel = 0d0 -+ MaxMa = 0d0 -+ Vl = 0d0 -+ Elk = 0d0 -+ Et = 0d0 -+ Vb = 0d0 -+ dV = 0d0 -+ pres_av = 0d0 -+ pres = 0d0 -+ do k = 0, p -+ do j = 0, n -+ do i = 0, m -+ pres = 0d0 -+ dV = dx(i)*dy(j)*dz(k) -+ rho = 0d0 -+ gamma = 0d0 -+ pi_inf = 0d0 -+ pres = q_prim_vf(E_idx)%sf(i, j, k) -+ Egint = Egint + q_prim_vf(E_idx + 2)%sf(i, j, k)*(fluid_pp(2)%gamma*pres)*dV -+ do s = 1, num_dims -+ vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) -+ Egk = Egk + 0.5d0*q_prim_vf(E_idx + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV -+ Elk = Elk + 0.5d0*q_prim_vf(E_idx + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV -+ if (dabs(vel(s)) > maxvel) then -+ maxvel = dabs(vel(s)) -+ end if -+ end do -+ do l = 1, adv_idx%end - E_idx -+ adv(l) = q_prim_vf(E_idx + l)%sf(i, j, k) -+ gamma = gamma + adv(l)*fluid_pp(l)%gamma -+ pi_inf = pi_inf + adv(l)*fluid_pp(l)%pi_inf -+ rho = rho + adv(l)*q_prim_vf(l)%sf(i, j, k) -+ end do -+ -+ H = ((gamma + 1d0)*pres + pi_inf)/rho -+ -+ call s_compute_speed_of_sound(pres, rho, & -+ gamma, pi_inf, & -+ H, adv, 0d0, c) -+ -+ Ma = maxvel/c -+ if (Ma > MaxMa .and. adv(1) > 1.0d0 - 1.0d-10) then -+ MaxMa = Ma -+ end if -+ Vl = Vl + adv(1)*dV -+ Vb = Vb + adv(2)*dV -+ pres_av = pres_av + adv(1)*pres*dV -+ Et = Et + q_cons_vf(E_idx)%sf(i, j, k)*dV -+ end do -+ end do -+ end do -+ -+ tmp = pres_av -+ call s_mpi_allreduce_sum(tmp, pres_av) -+ tmp = Vl -+ call s_mpi_allreduce_sum(tmp, Vl) -+ -+ call s_mpi_allreduce_max(MaxMa, MaxMa_glb) -+ tmp = Elk -+ call s_mpi_allreduce_sum(tmp, Elk) -+ tmp = Egint -+ call s_mpi_allreduce_sum(tmp, Egint) -+ tmp = Egk -+ call s_mpi_allreduce_sum(tmp, Egk) -+ tmp = Vb -+ call s_mpi_allreduce_sum(tmp, Vb) -+ tmp = Et -+ call s_mpi_allreduce_sum(tmp, Et) -+ -+ Elp = pres_av/Vl*Vb -+ if (proc_rank == 0) then -+ write (251, '(10X, 8F24.8)') & -+ Elp, & -+ Egint, & -+ Elk, & -+ Egk, & -+ Et, & -+ Vb, & -+ Vl, & -+ MaxMa_glb -+ end if -+ -+ end subroutine s_write_energy_data_file -+ -+ subroutine s_close_formatted_database_file() ! ------------------------- - ! Description: The purpose of this subroutine is to close any formatted - ! database file(s) that may be opened at the time-step that - ! is currently being post-processed. The root process must -@@ -966,7 +1196,19 @@ contains - - end subroutine s_close_formatted_database_file - -- subroutine s_finalize_data_output_module -+ subroutine s_close_intf_data_file() ! ----------------------- -+ -+ close (211) -+ -+ end subroutine s_close_intf_data_file !--------------------- -+ -+ subroutine s_close_energy_data_file() ! ----------------------- -+ -+ close (251) -+ -+ end subroutine s_close_energy_data_file !--------------------- -+ -+ subroutine s_finalize_data_output_module() ! ------------------------- - ! Description: Deallocation procedures for the module - - ! Deallocating the generic storage employed for the flow variable(s) -diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp -index 0e5401f1..fa6941cb 100644 ---- a/src/post_process/m_global_parameters.fpp -+++ b/src/post_process/m_global_parameters.fpp -@@ -94,6 +94,10 @@ module m_global_parameters - logical :: mixture_err !< Mixture error limiter - logical :: alt_soundspeed !< Alternate sound speed - logical :: hypoelasticity !< Turn hypoelasticity on -+ logical :: hyperelasticity !< Turn hyperelasticity on -+ logical :: elasticity !< elasticity modeling, true for hyper or hypo -+ integer :: b_size !< Number of components in the b tensor -+ integer :: tensor_size !< Number of components in the nonsymmetric tensor - !> @} - - !> @name Annotations of the structure, i.e. the organization, of the state vectors -@@ -109,6 +113,7 @@ module m_global_parameters - integer :: alf_idx !< Index of specific heat ratio func. eqn. - integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. - type(int_bounds_info) :: stress_idx !< Indices of elastic stresses -+ type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. - integer :: c_idx !< Index of color function - !> @} - -@@ -118,6 +123,7 @@ module m_global_parameters - !> @} - - logical :: parallel_io !< Format of the data files -+ logical :: sim_data - logical :: file_per_process !< output format - - integer, allocatable, dimension(:) :: proc_coords !< -@@ -255,6 +261,7 @@ module m_global_parameters - integer :: intxb, intxe - integer :: bubxb, bubxe - integer :: strxb, strxe -+ integer :: xibeg, xiend - !> @} - - contains -@@ -286,7 +293,10 @@ contains - alt_soundspeed = .false. - relax = .false. - relax_model = dflt_int -+ - hypoelasticity = .false. -+ hyperelasticity = .false. -+ elasticity = .false. - - bc_x%beg = dflt_int; bc_x%end = dflt_int - bc_y%beg = dflt_int; bc_y%end = dflt_int -@@ -335,6 +345,7 @@ contains - omega_wrt = .false. - qm_wrt = .false. - schlieren_wrt = .false. -+ sim_data = .false. - cf_wrt = .false. - ib = .false. - -@@ -486,12 +497,24 @@ contains - - end if - -- if (hypoelasticity) then -+ if (hypoelasticity .or. hyperelasticity) then -+ elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 -+ ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D - sys_size = stress_idx%end - end if - -+ if (hyperelasticity) then -+ xi_idx%beg = sys_size + 1 -+ xi_idx%end = sys_size + num_dims -+ ! adding three more equations for the \xi field and the elastic energy -+ sys_size = xi_idx%end + 1 -+ ! number of entries in the symmetric btensor plus the jacobian -+ b_size = (num_dims*(num_dims + 1))/2 + 1 -+ tensor_size = num_dims**2 + 1 -+ end if -+ - if (.not. f_is_default(sigma)) then - c_idx = sys_size + 1 - sys_size = c_idx -@@ -517,6 +540,24 @@ contains - sys_size = internalEnergies_idx%end - alf_idx = 1 ! dummy, cannot actually have a void fraction - -+ if (hypoelasticity .or. hyperelasticity) then -+ elasticity = .true. -+ stress_idx%beg = sys_size + 1 -+ stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 -+ ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D -+ sys_size = stress_idx%end -+ end if -+ -+ if (hyperelasticity) then -+ xi_idx%beg = sys_size + 1 -+ xi_idx%end = sys_size + num_dims -+ ! adding three more equations for the \xi field and the elastic energy -+ sys_size = xi_idx%end + 1 -+ ! number of entries in the symmetric btensor plus the jacobian -+ b_size = (num_dims*(num_dims + 1))/2 + 1 -+ tensor_size = num_dims**2 + 1 -+ end if -+ - if (.not. f_is_default(sigma)) then - c_idx = sys_size + 1 - sys_size = c_idx -@@ -590,6 +631,8 @@ contains - strxe = stress_idx%end - intxb = internalEnergies_idx%beg - intxe = internalEnergies_idx%end -+ xibeg = xi_idx%beg -+ xiend = xi_idx%end - ! ================================================================== - - #ifdef MFC_MPI -diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp -index a5dffdb4..5da4c74e 100644 ---- a/src/post_process/m_mpi_proxy.fpp -+++ b/src/post_process/m_mpi_proxy.fpp -@@ -141,6 +141,38 @@ contains - - end subroutine s_initialize_mpi_proxy_module - -+ subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root) -+ -+#ifdef MFC_MPI -+ -+ implicit none -+ integer, intent(in) :: counts ! Array of vector lengths for each process -+ real(kind(0d0)), intent(in), dimension(counts) :: my_vector ! Input vector on each process -+ integer, intent(in) :: root ! Rank of the root process -+ real(kind(0d0)), allocatable, intent(out) :: gathered_vector(:) ! Gathered vector on the root process -+ -+ integer :: i, offset, ierr -+ integer, allocatable :: recounts(:), displs(:) -+ -+ allocate (recounts(num_procs)) -+ -+ call MPI_GATHER(counts, 1, MPI_INTEGER, recounts, 1, MPI_INTEGER, root, & -+ MPI_COMM_WORLD, ierr) -+ -+ allocate (displs(size(recounts))) -+ -+ displs(1) = 0 -+ -+ do i = 2, size(recounts) -+ displs(i) = displs(i - 1) + recounts(i - 1) -+ end do -+ -+ allocate (gathered_vector(sum(recounts))) -+ call MPI_GATHERV(my_vector, counts, MPI_DOUBLE_PRECISION, gathered_vector, recounts, displs, MPI_DOUBLE_PRECISION, & -+ root, MPI_COMM_WORLD, ierr) -+#endif -+ end subroutine s_mpi_gather_data -+ - !> Since only processor with rank 0 is in charge of reading - !! and checking the consistency of the user provided inputs, - !! these are not available to the remaining processors. This -@@ -164,11 +196,11 @@ contains - - #:for VAR in [ 'cyl_coord', 'mpp_lim', 'mixture_err', & - & 'alt_soundspeed', 'hypoelasticity', 'parallel_io', 'rho_wrt', & -- & 'E_wrt', 'pres_wrt', 'gamma_wrt', & -+ & 'E_wrt', 'pres_wrt', 'gamma_wrt', 'sim_data', & - & 'heat_ratio_wrt', 'pi_inf_wrt', 'pres_inf_wrt', 'cons_vars_wrt', & - & 'prim_vars_wrt', 'c_wrt', 'qm_wrt','schlieren_wrt', 'bubbles', 'qbmm', & - & 'polytropic', 'polydisperse', 'file_per_process', 'relax', 'cf_wrt', & -- & 'adv_n', 'ib' ] -+ & 'adv_n', 'ib', 'hyperelasticity' ] - call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) - #:endfor - -diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 -index ed1003ff..60d3d094 100644 ---- a/src/post_process/m_start_up.f90 -+++ b/src/post_process/m_start_up.f90 -@@ -74,7 +74,8 @@ contains - parallel_io, rhoref, pref, bubbles, qbmm, sigR, & - R0ref, nb, polytropic, thermal, Ca, Web, Re_inv, & - polydisperse, poly_sigma, file_per_process, relax, & -- relax_model, cf_wrt, sigma, adv_n, ib -+ relax_model, cf_wrt, sigma, adv_n, ib, sim_data, & -+ hyperelasticity - - ! Inquiring the status of the post_process.inp file - file_loc = 'post_process.inp' -@@ -148,9 +149,9 @@ contains - (t_step_stop - t_step_start)/t_step_save + 1, & - t_step - end if -- - ! Populating the grid and conservative variables - call s_read_data_files(t_step) -+ - ! Populating the buffer regions of the grid variables - if (buff_size > 0) then - call s_populate_grid_variables_buffer_regions() -@@ -163,6 +164,7 @@ contains - - ! Converting the conservative variables to the primitive ones - call s_convert_conservative_to_primitive_variables(q_cons_vf, q_prim_vf) -+ - end subroutine s_perform_time_step - - subroutine s_save_data(t_step, varname, pres, c, H) -@@ -176,6 +178,16 @@ contains - ! Opening a new formatted database file - call s_open_formatted_database_file(t_step) - -+ if (sim_data .and. proc_rank == 0) then -+ call s_open_intf_data_file() -+ call s_open_energy_data_file() -+ end if -+ -+ if (sim_data) then -+ call s_write_intf_data_file(q_prim_vf) -+ call s_write_energy_data_file(q_prim_vf, q_cons_vf) -+ end if -+ - ! Adding the grid to the formatted database file - call s_write_grid_to_formatted_database_file(t_step) - -@@ -304,22 +316,34 @@ contains - - end if - ! ---------------------------------------------------------------------- -- - ! Adding the elastic shear stresses to the formatted database file ----- -- if (hypoelasticity) then -+ if (elasticity) then - do i = 1, stress_idx%end - stress_idx%beg + 1 - if (prim_vars_wrt) then - q_sf = q_prim_vf(i - 1 + stress_idx%beg)%sf( & - -offset_x%beg:m + offset_x%end, & - -offset_y%beg:n + offset_y%end, & - -offset_z%beg:p + offset_z%end) -- - write (varname, '(A,I0)') 'tau', i - call s_write_variable_to_formatted_database_file(varname, t_step) - end if - varname(:) = ' ' - end do - end if -+ if (hyperelasticity) then -+ do i = 1, xiend - xibeg + 1 -+ if (prim_vars_wrt) then -+ q_sf = q_prim_vf(i - 1 + xibeg)%sf( & -+ -offset_x%beg:m + offset_x%end, & -+ -offset_y%beg:n + offset_y%end, & -+ -offset_z%beg:p + offset_z%end) -+ write (varname, '(A,I0)') 'xi', i -+ call s_write_variable_to_formatted_database_file(varname, t_step) -+ end if -+ varname(:) = ' ' -+ end do -+ end if -+ - ! ---------------------------------------------------------------------- - - ! Adding the pressure to the formatted database file ------------------- -@@ -625,8 +649,19 @@ contains - end if - end if - -+! if (proc_rank == 0 .and. sim_data) then -+! close (211) -+! close (251) -+! end if -+ -+ if (sim_data .and. proc_rank == 0) then -+ call s_close_intf_data_file() -+ call s_close_energy_data_file() -+ end if -+ - ! Closing the formatted database file - call s_close_formatted_database_file() -+ - end subroutine s_save_data - - subroutine s_initialize_modules -@@ -682,6 +717,11 @@ contains - ! Disassociate pointers for serial and parallel I/O - s_read_data_files => null() - -+! if (sim_data .and. proc_rank == 0) then -+! call s_close_intf_data_file() -+! call s_close_energy_data_file() -+! end if -+ - ! Deallocation procedures for the modules - call s_finalize_data_output_module() - call s_finalize_derived_variables_module() -diff --git a/src/post_process/p_main.fpp b/src/post_process/p_main.fpp -index c780ce9a..ede32ed7 100644 ---- a/src/post_process/p_main.fpp -+++ b/src/post_process/p_main.fpp -@@ -39,6 +39,7 @@ program p_main - - ! Time-Marching Loop ======================================================= - do -+ - call s_perform_time_step(t_step) - - call s_save_data(t_step, varname, pres, c, H) -diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp -index 7d6ee960..394f560b 100644 ---- a/src/pre_process/include/2dHardcodedIC.fpp -+++ b/src/pre_process/include/2dHardcodedIC.fpp -@@ -2,8 +2,7 @@ - - real(kind(0d0)) :: eps - real(kind(0d0)) :: r, rmax, gam, umax, p0 -- -- real(kind(0d0)) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph -+ real(kind(0d0)) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph - - eps = 1e-9 - -@@ -12,6 +11,7 @@ - #:def Hardcoded2D() - - select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case -+ - case (200) - if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1d0/3d0)) then - ! Volume Fractions -@@ -68,7 +68,7 @@ - - q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(E_idx)%sf(i, j, 0)**(1d0/gam) - -- case (204) ! Rayleigh-Taylor instability -+ case (204) ! Rayleigh-taylor problem - rhoH = 3 - rhoL = 1 - pRef = 1e5 -@@ -100,11 +100,42 @@ - q_prim_vf(E_idx)%sf(i, j, 0) = pInt + rhoL*9.81*(intH - y_cc(j)) - end if - -+ case (205) ! 2D lung wave interaction problem -+ h = 0.0 !non dim origin y -+ lam = 1.0 !non dim lambda -+ amp = patch_icpp(patch_id)%a2 !to be changed later! !non dim amplitude -+ -+ intH = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h -+ -+ if (y_cc(j) > intH) then -+ q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) -+ q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) -+ q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres -+ q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) -+ q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) -+ end if -+ -+ case (206) ! 2D lung wave interaction problem - horizontal domain -+ h = 0.0 !non dim origin y -+ lam = 1.0 !non dim lambda -+ amp = patch_icpp(patch_id)%a2 -+ -+ intL = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h -+ -+ if (x_cc(i) > intL) then !this is the liquid -+ q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) -+ q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) -+ q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres -+ q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) -+ q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) -+ end if -+ - case default - if (proc_rank == 0) then - call s_int_to_str(patch_id, iStr) - call s_mpi_abort("Invalid hcid specified for patch "//trim(iStr)) - end if -+ - end select - - #:enddef -diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp -index 3d9a4e2f..4088fcc2 100644 ---- a/src/pre_process/include/3dHardcodedIC.fpp -+++ b/src/pre_process/include/3dHardcodedIC.fpp -@@ -42,7 +42,20 @@ - pInt = pref + rhoH*9.81*(1.2 - intH) - q_prim_vf(E_idx)%sf(i, j, k) = pInt + rhoL*9.81*(intH - y_cc(j)) - end if -- -+ -+ case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|) -+ h = 0.0 -+ lam = 1.0 -+ amp = patch_icpp(patch_id)%a2 -+ intH = amp*ABS((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h) -+ if (x_cc(i) > intH) then -+ q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1) -+ q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2) -+ q_prim_vf(E_idx)%sf(i, j, k) = patch_icpp(1)%pres -+ q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1) -+ q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2) -+ end if -+ - ! Put your variable assignments here - case default - call s_int_to_str(patch_id, iStr) -diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 -index 9ff468a3..4a49c46a 100644 ---- a/src/pre_process/m_assign_variables.f90 -+++ b/src/pre_process/m_assign_variables.f90 -@@ -276,6 +276,8 @@ contains - real(kind(0d0)) :: orig_qv - real(kind(0d0)) :: muR, muV - real(kind(0d0)) :: R3bar -+ real(kind(0d0)) :: rcoord, theta, phi, xi_sph -+ real(kind(0d0)), dimension(3) :: xi_cart - - real(kind(0d0)), dimension(int(E_idx - mom_idx%beg)) :: vel !< velocity - real(kind(0d0)) :: pres !< pressure -@@ -448,7 +450,7 @@ contains - end do - - ! Elastic Shear Stress -- if (hypoelasticity) then -+ if (elasticity) then - do i = 1, (stress_idx%end - stress_idx%beg) + 1 - q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = & - (eta*patch_icpp(patch_id)%tau_e(i) & -@@ -456,6 +458,32 @@ contains - end do - end if - -+ ! Elastic Shear Stress -+ if (hyperelasticity) then -+ -+ if (pre_stress) then ! pre stressed initial condition in spatial domain -+ rcoord = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2)) -+ theta = atan2(y_cc(k), x_cc(j)) -+ phi = atan2(sqrt(x_cc(j)**2 + y_cc(k)**2), z_cc(l)) -+ !spherical coord, assuming Rmax=1 -+ xi_sph = (rcoord**3 - R0ref**3 + 1d0)**(1d0/3d0) -+ xi_cart(1) = xi_sph*sin(phi)*cos(theta) -+ xi_cart(2) = xi_sph*sin(phi)*sin(theta) -+ xi_cart(3) = xi_sph*cos(phi) -+ else -+ xi_cart(1) = x_cc(j) -+ xi_cart(2) = y_cc(k) -+ xi_cart(3) = z_cc(l) -+ end if -+ -+ ! assigning the reference map to the q_prim vector field -+ do i = 1, num_dims -+ q_prim_vf(i + xibeg - 1)%sf(j, k, l) = eta*xi_cart(i) + & -+ (1d0 - eta)*orig_prim_vf(i + xibeg - 1) -+ end do -+ -+ end if -+ - if (mpp_lim .and. bubbles) then - !adjust volume fractions, according to modeled gas void fraction - alf_sum%sf = 0d0 -diff --git a/src/pre_process/m_check_patches.fpp b/src/pre_process/m_check_patches.fpp -index 4579f5bd..bda4418e 100644 ---- a/src/pre_process/m_check_patches.fpp -+++ b/src/pre_process/m_check_patches.fpp -@@ -119,7 +119,8 @@ contains - patch_icpp(i)%geometry == 9 .or. & - patch_icpp(i)%geometry == 10 .or. & - patch_icpp(i)%geometry == 11 .or. & -- patch_icpp(i)%geometry == 12)) then -+ patch_icpp(i)%geometry == 12 .or. & -+ patch_icpp(i)%geometry == 14)) then - call s_check_supported_patch_smoothing(i) - else - call s_check_unsupported_patch_smoothing(i) -diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp -index 94d5d8fb..c0049095 100644 ---- a/src/pre_process/m_data_output.fpp -+++ b/src/pre_process/m_data_output.fpp -@@ -638,6 +638,7 @@ contains - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) - end do -+ - end if - - call MPI_FILE_CLOSE(ifile, ierr) -diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp -index 57dcda37..78e8c293 100644 ---- a/src/pre_process/m_global_parameters.fpp -+++ b/src/pre_process/m_global_parameters.fpp -@@ -20,11 +20,11 @@ module m_global_parameters - implicit none - - ! Logistics ================================================================ -- integer :: num_procs !< Number of processors -- character(LEN=path_len) :: case_dir !< Case folder location -- logical :: old_grid !< Use existing grid data -- logical :: old_ic !< Use existing IC data -- integer :: t_step_old, t_step_start !< Existing IC/grid folder -+ integer :: num_procs !< Number of processors -+ character(LEN=path_len) :: case_dir !< Case folder location -+ logical :: old_grid !< Use existing grid data -+ logical :: old_ic, non_axis_sym !< Use existing IC data -+ integer :: t_step_old, t_step_start !< Existing IC/grid folder - ! ========================================================================== - - ! Computational Domain Parameters ========================================== -@@ -72,16 +72,21 @@ module m_global_parameters - ! ========================================================================== - - ! Simulation Algorithm Parameters ========================================== -- integer :: model_eqns !< Multicomponent flow model -- logical :: relax !< activate phase change -- integer :: relax_model !< Relax Model -- real(kind(0d0)) :: palpha_eps !< trigger parameter for the p relaxation procedure, phase change model -- real(kind(0d0)) :: ptgalpha_eps !< trigger parameter for the pTg relaxation procedure, phase change model -- integer :: num_fluids !< Number of different fluids present in the flow -- logical :: mpp_lim !< Alpha limiter -- integer :: sys_size !< Number of unknowns in the system of equations -- integer :: weno_order !< Order of accuracy for the WENO reconstruction -- logical :: hypoelasticity !< activate hypoelasticity -+ integer :: model_eqns !< Multicomponent flow model -+ logical :: relax !< activate phase change -+ integer :: relax_model !< Relax Model -+ real(kind(0d0)) :: palpha_eps !< trigger parameter for the p relaxation procedure, phase change model -+ real(kind(0d0)) :: ptgalpha_eps !< trigger parameter for the pTg relaxation procedure, phase change model -+ integer :: num_fluids !< Number of different fluids present in the flow -+ logical :: mpp_lim !< Alpha limiter -+ integer :: sys_size !< Number of unknowns in the system of equations -+ integer :: weno_order !< Order of accuracy for the WENO reconstruction -+ logical :: hypoelasticity !< activate hypoelasticity -+ logical :: hyperelasticity !< activate hyperelasticity -+ logical :: elasticity !< elasticity modeling, true for hyper or hypo -+ integer :: b_size !< Number of components in the b tensor -+ integer :: tensor_size !< Number of components in the nonsymmetric tensor -+ logical :: pre_stress !< activate pre_stressed domain - - ! Annotations of the structure, i.e. the organization, of the state vectors - type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. -@@ -95,6 +100,7 @@ module m_global_parameters - integer :: gamma_idx !< Index of specific heat ratio func. eqn. - integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. - type(int_bounds_info) :: stress_idx !< Indexes of elastic shear stress eqns. -+ type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. - integer :: c_idx !< Index of the color function - - type(int_bounds_info) :: bc_x, bc_y, bc_z !< -@@ -216,6 +222,7 @@ module m_global_parameters - integer :: intxb, intxe - integer :: bubxb, bubxe - integer :: strxb, strxe -+ integer :: xibeg, xiend - !> @} - - integer, allocatable, dimension(:, :, :) :: logic_grid -@@ -278,6 +285,9 @@ contains - weno_order = dflt_int - - hypoelasticity = .false. -+ hyperelasticity = .false. -+ elasticity = .false. -+ pre_stress = .false. - - bc_x%beg = dflt_int; bc_x%end = dflt_int - bc_y%beg = dflt_int; bc_y%end = dflt_int -@@ -339,6 +349,18 @@ contains - patch_icpp(i)%qv = 0d0 - patch_icpp(i)%qvp = 0d0 - patch_icpp(i)%tau_e = 0d0 -+ patch_icpp(i)%a2 = dflt_real -+ patch_icpp(i)%a3 = dflt_real -+ patch_icpp(i)%a4 = dflt_real -+ patch_icpp(i)%a5 = dflt_real -+ patch_icpp(i)%a6 = dflt_real -+ patch_icpp(i)%a8 = dflt_real -+ patch_icpp(i)%a9 = dflt_real -+ patch_icpp(i)%a10 = dflt_real -+ patch_icpp(i)%a11 = dflt_real -+ patch_icpp(i)%a12 = dflt_real -+ patch_icpp(i)%non_axis_sym = .false. -+ - !should get all of r0's and v0's - patch_icpp(i)%r0 = dflt_real - patch_icpp(i)%v0 = dflt_real -@@ -574,13 +596,24 @@ contains - end if - end if - -- if (hypoelasticity) then -+ if (hypoelasticity .or. hyperelasticity) then -+ elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D - sys_size = stress_idx%end - end if - -+ if (hyperelasticity) then -+ ! number of entries in the symmetric btensor plus the jacobian -+ b_size = (num_dims*(num_dims + 1))/2 + 1 -+ tensor_size = num_dims**2 + 1 -+ xi_idx%beg = sys_size + 1 -+ xi_idx%end = sys_size + num_dims -+ ! adding three more equations for the \xi field and the elastic energy -+ sys_size = xi_idx%end + 1 -+ end if -+ - if (.not. f_is_default(sigma)) then - c_idx = sys_size + 1 - sys_size = c_idx -@@ -605,6 +638,24 @@ contains - internalEnergies_idx%end = adv_idx%end + num_fluids - sys_size = internalEnergies_idx%end - -+ if (hypoelasticity .or. hyperelasticity) then -+ elasticity = .true. -+ stress_idx%beg = sys_size + 1 -+ stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 -+ ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D -+ sys_size = stress_idx%end -+ end if -+ -+ if (hyperelasticity) then -+ ! number of entries in the symmetric btensor plus the jacobian -+ b_size = (num_dims*(num_dims + 1))/2 + 1 -+ tensor_size = num_dims**2 + 1 -+ xi_idx%beg = sys_size + 1 -+ xi_idx%end = sys_size + num_dims -+ ! adding three more equations for the \xi field and the elastic energy -+ sys_size = xi_idx%end + 1 -+ end if -+ - if (.not. f_is_default(sigma)) then - c_idx = sys_size + 1 - sys_size = c_idx -@@ -681,6 +732,8 @@ contains - strxe = stress_idx%end - intxb = internalEnergies_idx%beg - intxe = internalEnergies_idx%end -+ xibeg = xi_idx%beg -+ xiend = xi_idx%end - - ! ================================================================== - -diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp -index 5d58d46e..869194b5 100644 ---- a/src/pre_process/m_initial_condition.fpp -+++ b/src/pre_process/m_initial_condition.fpp -@@ -238,6 +238,10 @@ contains - elseif (patch_icpp(i)%geometry == 7) then - call s_2D_analytical(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) -+ - ! Spiral patch - elseif (patch_icpp(i)%geometry == 17) then - call s_spiral(i, patch_id_fp, q_prim_vf) -@@ -311,8 +315,7 @@ contains - if (instability_wave) call s_superposition_instability_wave() - - ! Converting the primitive variables to the conservative ones -- call s_convert_primitive_to_conservative_variables(q_prim_vf, & -- q_cons_vf) -+ call s_convert_primitive_to_conservative_variables(q_prim_vf, q_cons_vf) - - if (qbmm .and. .not. polytropic) then - !Initialize pb and mv -diff --git a/src/pre_process/m_mpi_proxy.fpp b/src/pre_process/m_mpi_proxy.fpp -index 257f7fb3..6b04bf0f 100644 ---- a/src/pre_process/m_mpi_proxy.fpp -+++ b/src/pre_process/m_mpi_proxy.fpp -@@ -55,7 +55,7 @@ contains - & 'cyl_coord','mpp_lim','hypoelasticity', 'relax', & - & 'parallel_io', 'perturb_flow', 'vel_profile', 'instability_wave',& - & 'perturb_sph', 'bubbles', 'polytropic', 'polydisperse', 'qbmm', & -- & 'file_per_process', 'adv_n', 'ib' ] -+ & 'file_per_process', 'adv_n', 'ib', 'hyperelasticity','pre_stress'] - call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) - #:endfor - call MPI_BCAST(fluid_rho(1), num_fluids_max, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) -@@ -76,6 +76,7 @@ contains - #:endfor - - call MPI_BCAST(patch_icpp(i)%smoothen, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) -+ call MPI_BCAST(patch_icpp(i)%non_axis_sym, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) - call MPI_BCAST(patch_icpp(i)%alter_patch(0), num_patches_max, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) - - #:for VAR in [ 'x_centroid', 'y_centroid', 'z_centroid', & -@@ -86,6 +87,10 @@ contains - call MPI_BCAST(patch_icpp(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - #:endfor - -+ #:for VAR in [ 'a2', 'a3', 'a4', 'a5', 'a6', 'a7', 'a8', 'a9', 'a10', 'a11', 'a12'] -+ call MPI_BCAST(patch_icpp(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) -+ #:endfor -+ - call MPI_BCAST(patch_icpp(i)%model%filepath, len(patch_icpp(i)%model%filepath), MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr) - - #:for VAR in [ 'model%translate', 'model%scale', 'model%rotate', & -diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp -index 708ada19..d14d2273 100644 ---- a/src/pre_process/m_patches.fpp -+++ b/src/pre_process/m_patches.fpp -@@ -70,7 +70,8 @@ module m_patches - !! 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(kind(0d0)) :: cart_y, cart_z -+ real(kind(0d0)) :: r_cyl, theta_cyl, x_cart, y_cart, z_cart -+ real(kind(0d0)) :: cart_x, cart_y, cart_z - real(kind(0d0)) :: sph_phi !< - !! Variables to be used to hold cell locations in Cartesian coordinates if - !! 3D simulation is using cylindrical coordinates -@@ -794,7 +795,7 @@ contains - ((y_cc(j) - y_centroid)/b)**2) & - - 1d0))*(-0.5d0) + 0.5d0 - end if -- -+ print *, "a :", a, "b :", b - if ((((x_cc(i) - x_centroid)/a)**2 + & - ((y_cc(j) - y_centroid)/b)**2 <= 1d0 & - .and. & -@@ -1421,128 +1422,240 @@ contains - !! @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, 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, intent(IN) :: patch_id -+ integer, intent(INOUT), dimension(0:m, 0:n, 0:p) :: patch_id_fp -+ type(scalar_field), dimension(1:sys_size) :: q_prim_vf -+ -+ real(kind(0d0)) :: r, x_p, P2, P3, P4, P5, P6, P7, P8, P9, P10, P11, P12, eps, phi -+ real(kind(0d0)) :: a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 -+ real(kind(0d0)) :: radius, x_centroid, y_centroid, z_centroid, eta, smooth_coeff -+ logical :: non_axis_sym - - integer :: i, j, k !< generic loop iterators -- real(kind(0d0)) :: radius, epsilon, beta -- complex(kind(0d0)) :: cmplx_i = (0d0, 1d0) -- complex(kind(0d0)) :: H - - ! Transferring the patch's centroid and radius 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 -+ smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id -+ smooth_coeff = patch_icpp(patch_id)%smooth_coeff - radius = patch_icpp(patch_id)%radius -- epsilon = patch_icpp(patch_id)%epsilon -- beta = patch_icpp(patch_id)%beta -+ a2 = patch_icpp(patch_id)%a2 -+ a3 = patch_icpp(patch_id)%a3 -+ a4 = patch_icpp(patch_id)%a4 -+ a5 = patch_icpp(patch_id)%a5 -+ a6 = patch_icpp(patch_id)%a6 -+ a7 = patch_icpp(patch_id)%a7 -+ a8 = patch_icpp(patch_id)%a8 -+ a9 = patch_icpp(patch_id)%a9 -+ a10 = patch_icpp(patch_id)%a10 -+ a11 = patch_icpp(patch_id)%a11 -+ a12 = patch_icpp(patch_id)%a12 -+ non_axis_sym = 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 = 1d0 -+ eps = 1.d-32 - - ! 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. -- do k = 0, p -+ if (p > 0 .and. .not. non_axis_sym) 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 = dsqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) + eps -+ if (x_cc(i) - x_centroid <= 0) then -+ x_p = -dabs(x_cc(i) - x_centroid + eps)/r -+ else -+ x_p = dabs(x_cc(i) - x_centroid + eps)/r -+ end if -+ -+ P2 = unassociated_legendre(x_p, 2) -+ P3 = unassociated_legendre(x_p, 3) -+ P4 = unassociated_legendre(x_p, 4) -+ P5 = unassociated_legendre(x_p, 5) -+ P6 = unassociated_legendre(x_p, 6) -+ P7 = unassociated_legendre(x_p, 7) -+ if ((x_cc(i) - x_centroid >= 0 & -+ .and. & -+ r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7 <= 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 = tanh(smooth_coeff/min(dx, dy, dz)* & -+ ((r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7) & -+ - radius))*(-0.5d0) + 0.5d0 -+ end if -+ -+ call s_assign_patch_primitive_variables(patch_id, i, j, k, & -+ eta, 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 (grid_geometry == 3) then -- call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) -+ if (non_axis_sym) then -+ phi = atan(((y_cc(j) - y_centroid) + eps)/((x_cc(i) - x_centroid) + eps)) -+ r = dsqrt((x_cc(i) - x_centroid)**2d0 + (y_cc(j) - y_centroid)**2d0) + eps -+ x_p = (eps)/r -+ P2 = spherical_harmonic_func(x_p, phi, 2, 2) -+ P3 = spherical_harmonic_func(x_p, phi, 3, 3) -+ P4 = spherical_harmonic_func(x_p, phi, 4, 4) -+ P5 = spherical_harmonic_func(x_p, phi, 5, 5) -+ P6 = spherical_harmonic_func(x_p, phi, 6, 6) -+ P7 = spherical_harmonic_func(x_p, phi, 7, 7) -+ P8 = spherical_harmonic_func(x_p, phi, 8, 8) -+ P9 = spherical_harmonic_func(x_p, phi, 9, 9) -+ ! P10 = spherical_harmonic_func(x_p, phi, 10, 10) -+ ! P11 = spherical_harmonic_func(x_p, phi, 11, 11) -+ ! P12 = spherical_harmonic_func(x_p, phi, 12, 12) - else -- cart_y = y_cc(j) -- cart_z = z_cc(k) -+ r = dsqrt((x_cc(i) - x_centroid)**2d0 + (y_cc(j) - y_centroid)**2d0) + eps -+ x_p = dabs(x_cc(i) - x_centroid + eps)/r -+ P2 = unassociated_legendre(x_p, 2) -+ P3 = unassociated_legendre(x_p, 3) -+ P4 = unassociated_legendre(x_p, 4) -+ P5 = unassociated_legendre(x_p, 5) -+ P6 = unassociated_legendre(x_p, 6) -+ P7 = unassociated_legendre(x_p, 7) -+ P8 = unassociated_legendre(x_p, 8) -+ P9 = unassociated_legendre(x_p, 9) - end if - -- 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)))) & -+ if (x_cc(i) - x_centroid >= 0 & -+ .and. & -+ r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7 - a8*P8 - a9*P9 <= 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, q_prim_vf, patch_id_fp) - -- call s_convert_cylindrical_to_spherical_coord(x_cc(i), y_cc(j)) -- -- if (epsilon == 1d0) then -- if (beta == 0d0) then -- H = 5d-1*sqrt(3d0/pi)*cos(sph_phi) -- elseif (beta == 1d0) then -- H = -5d-1*sqrt(3d0/(2d0*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi) -- end if -- elseif (epsilon == 2d0) then -- if (beta == 0d0) then -- H = 25d-2*sqrt(5d0/pi)*(3d0*cos(sph_phi)**2 - 1d0) -- elseif (beta == 1d0) then -- H = -5d-1*sqrt(15d0/(2d0*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)*cos(sph_phi) -- elseif (beta == 2d0) then -- H = 25d-2*sqrt(15d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))*sin(sph_phi)**2 -- end if -- elseif (epsilon == 3d0) then -- if (beta == 0d0) then -- H = 25d-2*sqrt(7d0/pi)*(5d0*cos(sph_phi)**3d0 - 3d0*cos(sph_phi)) -- elseif (beta == 1d0) then -- H = -125d-3*sqrt(21d0/pi)*exp(cmplx_i*z_cc(k))*sin(sph_phi)* & -- (5d0*cos(sph_phi)**2 - 1d0) -- elseif (beta == 2d0) then -- H = 25d-2*sqrt(105d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & -- sin(sph_phi)**2*cos(sph_phi) -- elseif (beta == 3d0) then -- H = -125d-3*sqrt(35d0/pi)*exp(3d0*cmplx_i*z_cc(k))*sin(sph_phi)**3d0 -- end if -- elseif (epsilon == 4d0) then -- if (beta == 0d0) then -- H = 3d0/16d0*sqrt(1d0/pi)*(35d0*cos(sph_phi)**4d0 - & -- 3d1*cos(sph_phi)**2 + 3d0) -- elseif (beta == 1d0) then -- H = -3d0/8d0*sqrt(5d0/pi)*exp(cmplx_i*z_cc(k))* & -- sin(sph_phi)*(7d0*cos(sph_phi)**3d0 - 3d0*cos(sph_phi)) -- elseif (beta == 2d0) then -- H = 3d0/8d0*sqrt(5d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & -- sin(sph_phi)**2*(7d0*cos(sph_phi)**2 - 1d0) -- elseif (beta == 3d0) then -- H = -3d0/8d0*sqrt(35d0/pi)*exp(3d0*cmplx_i*z_cc(k))* & -- sin(sph_phi)**3d0*cos(sph_phi) -- elseif (beta == 4d0) then -- H = 3d0/16d0*sqrt(35d0/(2d0*pi))*exp(4d0*cmplx_i*z_cc(k))* & -- sin(sph_phi)**4d0 -- end if -- elseif (epsilon == 5d0) then -- if (beta == 0d0) then -- H = 1d0/16d0*sqrt(11d0/pi)*(63d0*cos(sph_phi)**5d0 - & -- 7d1*cos(sph_phi)**3d0 + 15d0*cos(sph_phi)) -- elseif (beta == 1d0) then -- H = -1d0/16d0*sqrt(165d0/(2d0*pi))*exp(cmplx_i*z_cc(k))* & -- sin(sph_phi)*(21d0*cos(sph_phi)**4d0 - 14d0*cos(sph_phi)**2 + 1d0) -- elseif (beta == 2d0) then -- H = 125d-3*sqrt(1155d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & -- sin(sph_phi)**2*(3d0*cos(sph_phi)**3d0 - cos(sph_phi)) -- elseif (beta == 3d0) then -- H = -1d0/32d0*sqrt(385d0/pi)*exp(3d0*cmplx_i*z_cc(k))* & -- sin(sph_phi)**3d0*(9d0*cos(sph_phi)**2 - 1d0) -- elseif (beta == 4d0) then -- H = 3d0/16d0*sqrt(385d0/(2d0*pi))*exp(4d0*cmplx_i*z_cc(k))* & -- sin(sph_phi)**4d0*cos(sph_phi) -- elseif (beta == 5d0) then -- H = -3d0/32d0*sqrt(77d0/pi)*exp(5d0*cmplx_i*z_cc(k))* & -- sin(sph_phi)**5d0 -- end if -- end if -- -- q_prim_vf(adv_idx%beg)%sf(i, j, k) = 1d0 - abs(real(H, kind(0d0))) -+ elseif (x_cc(i) - x_centroid < 0 & -+ .and. & -+ r - a2*P2 + a3*P3 - a4*P4 + a5*P5 - a6*P6 + a7*P7 - a8*P8 + a9*P9 <= 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, q_prim_vf, patch_id_fp) - - end if -- - end do - end do -- end do -+ end if - - end subroutine s_spherical_harmonic - -+ !! This function generates the unassociated legendre poynomials with input -+ ! mode number and evaluates them at input x -+ -+ recursive function unassociated_legendre(x, l) result(P) -+ integer, intent(in) :: l -+ real(kind(0d0)), intent(in) :: x -+ real(kind(0d0)) :: P -+ -+ if (l == 0) then -+ P = 1d0 -+ else if (l == 1) then -+ P = x -+ else -+ P = ((2*l - 1)*x*unassociated_legendre(x, l - 1) - (l - 1)*unassociated_legendre(x, l - 2))/l -+ end if -+ -+ end function unassociated_legendre -+ -+ !! This function generated the spherical harmonic function valu, Y, -+ !based on inputs of x, phi, l and m -+ -+ recursive function spherical_harmonic_func(x, phi, l, m) result(Y) -+ integer, intent(in) :: l, m -+ real(kind(0d0)), intent(in) :: x, phi -+ real(kind(0d0)) :: Y, prefactor, pi -+ -+ pi = acos(-1d0) -+ prefactor = sqrt((2*l + 1)/(4*pi)*factorial(l - m)/factorial(l + m)); -+ if (m == 0) then -+ Y = prefactor*associated_legendre(x, l, m); -+ elseif (m > 0) then -+ Y = (-1d0)**m*sqrt(2d0)*prefactor*associated_legendre(x, l, m)*cos(m*phi); -+ end if -+ end function spherical_harmonic_func -+ -+ !! This function generates the associated legendre polynomials evaluated -+ !at x with inputs l and m -+ -+ recursive function associated_legendre(x, l, m) result(P) -+ integer, intent(in) :: l, m -+ real(kind(0d0)), intent(in) :: x -+ real(kind(0d0)) :: P -+ -+ if (m <= 0 .and. l <= 0) then -+ P = 1; -+ elseif (l == 1 .and. m <= 0) then -+ P = x; -+ elseif (l == 1 .and. m == 1) then -+ P = -(1 - x**2)**(1/2); -+ elseif (m == l) then -+ P = (-1)**l*double_factorial(2*l - 1)*(1 - x**2)**(l/2); -+ elseif (m == l - 1) then -+ P = x*(2*l - 1)*associated_legendre(x, l - 1, l - 1); -+ else -+ P = ((2*l - 1)*x*associated_legendre(x, l - 1, m) - (l + m - 1)*associated_legendre(x, l - 2, m))/(l - m); -+ end if -+ -+ end function associated_legendre -+ -+ !! This function calculates the double factorial value of an integer -+ -+ recursive function double_factorial(n) result(R) -+ integer, intent(in) :: n -+ integer, parameter :: int64_kind = selected_int_kind(18) ! 18 bytes for 64-bit integer -+ integer(kind=int64_kind) :: R -+ -+ if (n <= 0) then -+ R = 1 -+ else if (n == 1) then -+ R = 1 -+ else -+ R = n*double_factorial(n - 2) -+ end if -+ -+ end function double_factorial -+ -+ !! The following function calculates the factorial value of an integer -+ -+ recursive function factorial(n) result(R) -+ integer, intent(in) :: n -+ integer, parameter :: int64_kind = selected_int_kind(18) ! 18 bytes for 64-bit integer -+ integer(kind=int64_kind) :: R -+ -+ if (n == 0) then -+ R = 1 -+ else -+ R = n*factorial(n - 1) -+ end if -+ -+ end function factorial -+ - !> 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 -@@ -2110,7 +2223,7 @@ contains - - end subroutine s_convert_cylindrical_to_spherical_coord - -- !> Archimedes spiral function -+ !> Archimedes spiral funcreal(kind(0d0)) :: theta_cc, r, x_p, P2, P3, P4, P5, P6, P7tion - !! @param myth Angle - !! @param offset Thickness - !! @param a Starting position -diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp -index 546de9c5..6db827ca 100644 ---- a/src/pre_process/m_start_up.fpp -+++ b/src/pre_process/m_start_up.fpp -@@ -140,7 +140,7 @@ contains - sigR, sigV, dist_type, rhoRV, R0_type, & - file_per_process, relax, relax_model, & - palpha_eps, ptgalpha_eps, ib, num_ibs, patch_ib, & -- sigma, adv_n -+ sigma, adv_n, hyperelasticity, pre_stress - - ! Inquiring the status of the pre_process.inp file - file_loc = 'pre_process.inp' -diff --git a/src/simulation/m_boundary_conditions.fpp b/src/simulation/m_boundary_conditions.fpp -index ca77632d..2b9eee16 100644 ---- a/src/simulation/m_boundary_conditions.fpp -+++ b/src/simulation/m_boundary_conditions.fpp -@@ -357,6 +357,12 @@ contains - q_prim_vf(i)%sf(-j, k, l) = & - q_prim_vf(i)%sf(j - 1, k, l) - end do -+ -+ if(hyperelasticity) then -+ q_prim_vf(xibeg)%sf(-j, k, l) = & -+ -q_prim_vf(xibeg)%sf(j - 1, k, l) -+ end if -+ - end do - end do - end do -@@ -401,6 +407,11 @@ contains - q_prim_vf(i)%sf(m - (j - 1), k, l) - end do - -+ if(hyperelasticity) then -+ q_prim_vf(xibeg)%sf(m + j, k, l) = & -+ -q_prim_vf(xibeg)%sf(m - (j - 1), k, l) -+ end if -+ - end do - end do - end do -@@ -448,6 +459,11 @@ contains - q_prim_vf(i)%sf(l, -j, k) = & - q_prim_vf(i)%sf(l, j - 1, k) - end do -+ -+ if(hyperelasticity) then -+ q_prim_vf(xibeg + 1)%sf(l, -j, k) = & -+ -q_prim_vf(xibeg + 1)%sf(l, j - 1, k) -+ end if - end do - end do - end do -@@ -490,6 +506,11 @@ contains - q_prim_vf(i)%sf(l, n + j, k) = & - q_prim_vf(i)%sf(l, n - (j - 1), k) - end do -+ -+ if(hyperelasticity) then -+ q_prim_vf(xibeg + 1)%sf(l, n + j, k) = & -+ -q_prim_vf(xibeg + 1)%sf(l, n - (j - 1), k) -+ end if - end do - end do - end do -@@ -537,6 +558,11 @@ contains - q_prim_vf(i)%sf(k, l, -j) = & - q_prim_vf(i)%sf(k, l, j - 1) - end do -+ -+ if(hyperelasticity) then -+ q_prim_vf(xiend)%sf(k, l, -j) = & -+ -q_prim_vf(xiend)%sf(k, l, j - 1) -+ end if - end do - end do - end do -@@ -579,6 +605,11 @@ contains - q_prim_vf(i)%sf(k, l, p + j) = & - q_prim_vf(i)%sf(k, l, p - (j - 1)) - end do -+ -+ if(hyperelasticity) then -+ q_prim_vf(xiend)%sf(k, l, p + j) = & -+ -q_prim_vf(xiend)%sf(k, l, p - (j - 1)) -+ end if - end do - end do - end do -diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp -index d9513675..c3523ec9 100644 ---- a/src/simulation/m_checker.fpp -+++ b/src/simulation/m_checker.fpp -@@ -31,6 +31,7 @@ contains - call s_check_inputs_model_eqns - if (acoustic_source) call s_check_inputs_acoustic_src - if (hypoelasticity) call s_check_inputs_hypoelasticity -+ if (hyperelasticity) call s_check_inputs_hyperelasticity - if (bubbles) call s_check_inputs_bubbles - if (adap_dt) call s_check_inputs_adapt_dt - if (alt_soundspeed) call s_check_inputs_alt_soundspeed -@@ -369,10 +370,20 @@ contains - !> Checks constraints on hypoelasticity parameters - subroutine s_check_inputs_hypoelasticity - if (riemann_solver /= 1) then -- call s_mpi_abort('hypoelasticity requires HLL Riemann solver '// & -- '(riemann_solver = 1). Exiting ...') -+ call s_mpi_abort('hypoelasticity requires HLL '// & -+ '(riemann_solver = 1) Riemann solver. '// & -+ 'Exiting ...') -+ end if -+ end subroutine s_check_inputs_hypoelasticity -+ -+ !> Checks constraints on hyperelasticity parameters -+ subroutine s_check_inputs_hyperelasticity -+ if (riemann_solver /= 2) then -+ call s_mpi_abort('hyperelasticity requires HLLC '// & -+ '(riemann_solver = 2) Riemann solver. '// & -+ 'Exiting ...') - end if -- end subroutine -+ end subroutine s_check_inputs_hyperelasticity - - !> Checks constraints on bubble parameters - subroutine s_check_inputs_bubbles -diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp -index 875f0a90..53973bd1 100644 ---- a/src/simulation/m_data_output.fpp -+++ b/src/simulation/m_data_output.fpp -@@ -1,4 +1,4 @@ --!> -+ - !! @file m_data_output.f90 - !! @brief Contains module m_data_output - -@@ -37,13 +37,16 @@ module m_data_output - private; - public :: s_initialize_data_output_module, & - s_open_run_time_information_file, & -+ s_open_com_files, & - s_open_probe_files, & - s_write_run_time_information, & - s_write_data_files, & - s_write_serial_data_files, & - s_write_parallel_data_files, & -+ s_write_com_files, & - s_write_probe_files, & - s_close_run_time_information_file, & -+ s_close_com_files, & - s_close_probe_files, & - s_finalize_data_output_module - -@@ -63,11 +66,12 @@ module m_data_output - - type(scalar_field), & - dimension(sys_size), & -- intent(inout) :: q_prim_vf -+ intent(inOUT) :: q_prim_vf - - integer, intent(in) :: t_step - -- end subroutine s_write_abstract_data_files -+ end subroutine s_write_abstract_data_files ! ------------------- -+ - end interface ! ======================================================== - #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), icfl_sf) -@@ -80,6 +84,8 @@ module m_data_output - real(kind(0d0)), allocatable, dimension(:, :, :) :: vcfl_sf !< VCFL stability criterion - real(kind(0d0)), allocatable, dimension(:, :, :) :: ccfl_sf !< CCFL stability criterion - real(kind(0d0)), allocatable, dimension(:, :, :) :: Rc_sf !< Rc stability criterion -+ real(kind(0d0)), public, allocatable, dimension(:, :) :: c_mass -+ - !$acc declare create(icfl_sf, vcfl_sf, ccfl_sf, Rc_sf) - #endif - -@@ -169,6 +175,44 @@ contains - - end subroutine s_open_run_time_information_file - -+ !> This opens a formatted data file where the root processor -+ !! can write out the CoM information -+ subroutine s_open_com_files() ! ---------------------------------------- -+ character(len=path_len + 3*name_len) :: file_path !< -+ !! Relative path to the CoM file in the case directory -+ integer :: i !< Generic loop iterator -+ do i = 1, num_fluids -+ ! Generating the relative path to the CoM data file -+ write (file_path, '(A,I0,A)') '/fluid', i, '_com.dat' -+ file_path = trim(case_dir)//trim(file_path) -+ ! Creating the formatted data file and setting up its -+ ! structure -+ open (i + 120, file=trim(file_path), & -+ form='formatted', & -+ position='append', & -+ status='unknown') -+ if (n == 0) then -+ write (i + 120, '(A)') '=== Non-Dimensional Time '// & -+ '=== Total Mass '// & -+ '=== x-loc '// & -+ '=== Total Volume ===' -+ elseif (p == 0) then -+ write (i + 120, '(A)') '=== Non-Dimensional Time '// & -+ '=== Total Mass '// & -+ '=== x-loc '// & -+ '=== y-loc '// & -+ '=== Total Volume ===' -+ else -+ write (i + 120, '(A)') '=== Non-Dimensional Time '// & -+ '=== Total Mass '// & -+ '=== x-loc '// & -+ '=== y-loc '// & -+ '=== z-loc '// & -+ '=== Total Volume ===' -+ end if -+ end do -+ end subroutine s_open_com_files ! -------------------------------------- -+ - !> This opens a formatted data file where the root processor - !! can write out flow probe information - subroutine s_open_probe_files -@@ -189,12 +233,12 @@ contains - FORM='formatted', & - STATUS='unknown') - ! POSITION = 'append', & -- !WRITE(i+30,'(A,I0,A)') 'Probe ',i, ' located at:' -- !WRITE(i+30,'(A,F10.6)') 'x = ',probe(i)%x -- !WRITE(i+30,'(A,F10.6)') 'y = ',probe(i)%y -- !WRITE(i+30,'(A,F10.6)') 'z = ',probe(i)%z -- !WRITE(i+30, *) -- !WRITE(i+30,'(A)') '=== Non-Dimensional Time ' // & -+ !write(i+30,'(A,I0,A)') 'Probe ',i, ' located at:' -+ !write(i+30,'(A,F10.6)') 'x = ',probe(i)%x -+ !write(i+30,'(A,F10.6)') 'y = ',probe(i)%y -+ !write(i+30,'(A,F10.6)') 'z = ',probe(i)%z -+ !write(i+30, *) -+ !write(i+30,'(A)') '=== Non-Dimensional Time ' // & - ! '=== Density ' // & - ! '=== Velocity ' // & - ! '=== Pressure ' // & -@@ -227,8 +271,8 @@ contains - !! @param t_step Current time step - subroutine s_write_run_time_information(q_prim_vf, t_step) - -- type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf -- integer, intent(IN) :: t_step -+ type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf -+ integer, intent(in) :: t_step - - real(kind(0d0)), dimension(num_fluids) :: alpha_rho !< Cell-avg. partial density - real(kind(0d0)) :: rho !< Cell-avg. density -@@ -250,7 +294,6 @@ contains - - real(kind(0d0)) :: blkmod1, blkmod2 !< - !! Fluid bulk modulus for Woods mixture sound speed -- - integer :: i, j, k, l, q !< Generic loop iterators - - integer :: Nfq -@@ -262,7 +305,6 @@ contains - do l = 0, p - do k = 0, n - do j = 0, m -- - do i = 1, num_fluids - alpha_rho(i) = q_prim_vf(i)%sf(j, k, l) - alpha(i) = q_prim_vf(E_idx + i)%sf(j, k, l) -@@ -292,6 +334,14 @@ contains - ! Compute mixture sound speed - call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c) - -+ if (c /= c) then -+ print *, 'crashed at processor: ', proc_rank, ', at j :: ', j, ', k :: ', k, ' l :: ', l -+ print *, 'alpha1 ::', alpha(1), 'and alpha2 ::', alpha(2), ' alpha3 :: ', alpha(3) -+ print *, 'alpha_rho1 ::', alpha_rho(1), ', alpha_rho2 ::', alpha_rho(2), ' alpha_rho3 :: ', alpha_rho(3) -+ print *, 'E :: ', E, ', pres :: ', pres, ', rho :: ', rho -+ call s_mpi_abort('Exiting ...') -+ end if -+ - if (grid_geometry == 3) then - if (k == 0) then - fltr_dtheta = 2d0*pi*y_cb(0)/3d0 -@@ -369,7 +419,7 @@ contains - end do - end do - end do -- ! END: Computing Stability Criteria at Current Time-step =========== -+ ! end: Computing Stability Criteria at Current Time-step =========== - - ! Determining local stability criteria extrema at current time-step - -@@ -430,6 +480,7 @@ contains - t_step, t_step*dt, icfl_max_glb, & - vcfl_max_glb, & - Rc_min_glb -+ - else - write (1, '(13X,I8,14X,F10.6,13X,F9.6)') & - t_step, t_step*dt, icfl_max_glb -@@ -840,11 +891,11 @@ contains - - integer :: ifile, ierr, data_size - integer, dimension(MPI_STATUS_SIZE) :: status -- integer(KIND=MPI_OFFSET_KIND) :: disp -- integer(KIND=MPI_OFFSET_KIND) :: m_MOK, n_MOK, p_MOK -- integer(KIND=MPI_OFFSET_KIND) :: WP_MOK, var_MOK, str_MOK -- integer(KIND=MPI_OFFSET_KIND) :: NVARS_MOK -- integer(KIND=MPI_OFFSET_KIND) :: MOK -+ integer(kind=MPI_OFFSET_kind) :: disp -+ integer(kind=MPI_OFFSET_kind) :: m_MOK, n_MOK, p_MOK -+ integer(kind=MPI_OFFSET_kind) :: WP_MOK, var_MOK, str_MOK -+ integer(kind=MPI_OFFSET_kind) :: NVARS_MOK -+ integer(kind=MPI_OFFSET_kind) :: MOK - - character(LEN=path_len + 2*name_len) :: file_loc - logical :: file_exist, dir_check -@@ -876,7 +927,6 @@ contains - call DelayFileAccess(proc_rank) - - ! Initialize MPI data I/O -- - call s_initialize_mpi_data(q_cons_vf) - - ! Open the file to write all flow variables -@@ -969,7 +1019,7 @@ contains - - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & - 'native', mpi_info_int, ierr) -- call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & -+ call MPI_FILE_write_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) - end do - !Write pb and mv for non-polytropic qbmm -@@ -1009,6 +1059,57 @@ contains - - end subroutine s_write_parallel_data_files - -+ !> This writes a formatted data file where the root processor -+ !! can write out the CoM information -+ !! @param t_step Current time-step -+ !! @param q_com Center of mass information -+ !! @param moments Higher moment information -+ subroutine s_write_com_files(t_step, c_mass) ! ------------------- -+ -+ integer, intent(in) :: t_step -+ real(kind(0d0)), dimension(num_fluids, 5), intent(in) :: c_mass -+ integer :: i, j !< Generic loop iterator -+ real(kind(0d0)) :: nondim_time !< Non-dimensional time -+ -+ ! Non-dimensional time calculation -+ if (t_step_old /= dflt_int) then -+ nondim_time = real(t_step + t_step_old, kind(0d0))*dt -+ else -+ nondim_time = real(t_step, kind(0d0))*dt -+ end if -+ -+ if (proc_rank == 0) then -+ if (n == 0) then ! 1D simulation -+ do i = 1, num_fluids ! Loop through fluids -+ write (i + 120, '(6X,4F24.12)') & -+ nondim_time, & -+ c_mass(i, 1), & -+ c_mass(i, 2), & -+ c_mass(i, 5) -+ end do -+ elseif (p == 0) then ! 2D simulation -+ do i = 1, num_fluids ! Loop through fluids -+ write (i + 120, '(6X,5F24.12)') & -+ nondim_time, & -+ c_mass(i, 1), & -+ c_mass(i, 2), & -+ c_mass(i, 3), & -+ c_mass(i, 5) -+ end do -+ else ! 3D simulation -+ do i = 1, num_fluids ! Loop through fluids -+ write (i + 120, '(6X,6F24.12)') & -+ nondim_time, & -+ c_mass(i, 1), & -+ c_mass(i, 2), & -+ c_mass(i, 3), & -+ c_mass(i, 4), & -+ c_mass(i, 5) -+ end do -+ end if -+ end if -+ end subroutine s_write_com_files ! ------------------------------------- -+ - !> This writes a formatted data file for the flow probe information - !! @param t_step Current time-step - !! @param q_cons_vf Conservative variables -@@ -1057,7 +1158,7 @@ contains - real(kind(0d0)) :: nondim_time !< Non-dimensional time - - real(kind(0d0)) :: tmp !< -- !! Temporary variable to store quantity for mpi_allreduce -+ !! Temporary variable to store quantity for mpi_allreduce - - real(kind(0d0)) :: blkmod1, blkmod2 !< - !! Fluid bulk modulus for Woods mixture sound speed -@@ -1118,7 +1219,7 @@ contains - l = 0 - - ! Computing/Sharing necessary state variables -- if (hypoelasticity) then -+ if (elasticity) then - call s_convert_to_mixture_variables(q_cons_vf, j - 2, k, l, & - rho, gamma, pi_inf, qv, & - Re, G, fluid_pp(:)%G) -@@ -1132,7 +1233,8 @@ contains - - dyn_p = 0.5d0*rho*dot_product(vel, vel) - -- if (hypoelasticity) then -+ if (elasticity) then -+ - call s_compute_pressure( & - q_cons_vf(1)%sf(j - 2, k, l), & - q_cons_vf(alf_idx)%sf(j - 2, k, l), & -@@ -1148,7 +1250,7 @@ contains - - if (model_eqns == 4) then - lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 -- else if (hypoelasticity) then -+ else if (elasticity) then - tau_e(1) = q_cons_vf(stress_idx%end)%sf(j - 2, k, l)/rho - end if - -@@ -1232,7 +1334,7 @@ contains - - dyn_p = 0.5d0*rho*dot_product(vel, vel) - -- if (hypoelasticity) then -+ if (elasticity) then - call s_compute_pressure( & - q_cons_vf(1)%sf(j - 2, k - 2, l), & - q_cons_vf(alf_idx)%sf(j - 2, k - 2, l), & -@@ -1247,7 +1349,7 @@ contains - - if (model_eqns == 4) then - lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 -- else if (hypoelasticity) then -+ else if (elasticity) then - do s = 1, 3 - tau_e(s) = q_cons_vf(s)%sf(j - 2, k - 2, l)/rho - end do -@@ -1274,15 +1376,13 @@ contains - R(:) = nR(:)/nbub - Rdot(:) = nRdot(:)/nbub - end if -- - ! Compute mixture sound speed - call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & - ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) - -- accel = accel_mag(j - 2, k - 2, l) - end if - end if -- else ! 3D simulation -+ else ! 3D f (t_step == t_step_stop)simulation - if ((probe(i)%x >= x_cb(-1)) .and. (probe(i)%x <= x_cb(m))) then - if ((probe(i)%y >= y_cb(-1)) .and. (probe(i)%y <= y_cb(n))) then - if ((probe(i)%z >= z_cb(-1)) .and. (probe(i)%z <= z_cb(p))) then -@@ -1315,7 +1415,7 @@ contains - - dyn_p = 0.5d0*rho*dot_product(vel, vel) - -- if (hypoelasticity) then -+ if (elasticity) then - call s_compute_pressure( & - q_cons_vf(1)%sf(j - 2, k - 2, l - 2), & - q_cons_vf(alf_idx)%sf(j - 2, k - 2, l - 2), & -@@ -1337,7 +1437,6 @@ contains - end if - end if - end if -- - if (num_procs > 1) then - #:for VAR in ['rho','pres','gamma','pi_inf','qv','c','accel'] - tmp = ${VAR}$ -@@ -1363,14 +1462,13 @@ contains - end if - end if - -- if (hypoelasticity) then -+ if (elasticity) then - do s = 1, (num_dims*(num_dims + 1))/2 - tmp = tau_e(s) - call s_mpi_allreduce_sum(tmp, tau_e(s)) - end do - end if - end if -- - if (proc_rank == 0) then - if (n == 0) then - if (bubbles .and. (num_fluids <= 2)) then -@@ -1457,7 +1555,7 @@ contains - nRdot(1), & - R(1), & - Rdot(1) -- else if (hypoelasticity) then -+ else if (elasticity) then - write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,'// & - 'F24.8,F24.8,F24.8)') & - nondim_time, & -@@ -1474,6 +1572,7 @@ contains - rho, & - vel(1), & - pres -+ print *, 'time =', nondim_time, 'rho =', rho, 'pres =', pres - end if - else - write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,'// & -@@ -1659,6 +1758,16 @@ contains - - end subroutine s_close_run_time_information_file - -+ !> Closes communication files -+ subroutine s_close_com_files() ! --------------------------------------- -+ -+ integer :: i !< Generic loop iterator -+ do i = 1, num_fluids -+ close (i + 120) -+ end do -+ -+ end subroutine s_close_com_files ! ------------------------------------- -+ - !> Closes probe files - subroutine s_close_probe_files - -@@ -1679,6 +1788,8 @@ contains - - integer :: i !< Generic loop iterator - -+ allocate (c_mass(1:num_fluids, 1:5)) -+ - ! Allocating/initializing ICFL, VCFL, CCFL and Rc stability criteria - @:ALLOCATE_GLOBAL(icfl_sf(0:m, 0:n, 0:p)) - icfl_max = 0d0 -@@ -1718,6 +1829,8 @@ contains - - integer :: i !< Generic loop iterator - -+ deallocate (c_mass) -+ - ! Deallocating the ICFL, VCFL, CCFL, and Rc stability criteria - @:DEALLOCATE_GLOBAL(icfl_sf) - if (any(Re_size > 0)) then -diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 -index 4cbe11ab..8f01d478 100644 ---- a/src/simulation/m_derived_variables.f90 -+++ b/src/simulation/m_derived_variables.f90 -@@ -20,6 +20,8 @@ module m_derived_variables - - use m_time_steppers !< Time-stepping algorithms - -+ use m_compile_specific -+ - use m_helper - ! ========================================================================== - -@@ -90,8 +92,8 @@ contains - ! Opening and writing header of flow probe files - if (proc_rank == 0) then - call s_open_probe_files() -+ call s_open_com_files() - end if -- - ! Computing centered finite difference coefficients - call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & - fd_number, fd_order) -@@ -100,12 +102,10 @@ contains - call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & - fd_number, fd_order) - end if -- - if (p > 0) then - call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & - fd_number, fd_order) - end if -- - end if - - end subroutine s_initialize_derived_variables -@@ -115,7 +115,6 @@ contains - subroutine s_compute_derived_variables(t_step) - - integer, intent(in) :: t_step -- - integer :: i, j, k !< Generic loop iterators - - if (probe_wrt) then -@@ -124,7 +123,6 @@ contains - q_prim_ts(2)%vf, & - q_prim_ts(3)%vf, & - x_accel) -- - if (n > 0) then - call s_derive_acceleration_component(2, q_prim_ts(0)%vf, & - q_prim_ts(1)%vf, & -@@ -132,7 +130,6 @@ contains - q_prim_ts(3)%vf, & - y_accel) - end if -- - if (p > 0) then - call s_derive_acceleration_component(3, q_prim_ts(0)%vf, & - q_prim_ts(1)%vf, & -@@ -140,7 +137,6 @@ contains - q_prim_ts(3)%vf, & - z_accel) - end if -- - do k = 0, p - do j = 0, n - do i = 0, m -@@ -157,8 +153,10 @@ contains - end do - end do - end do -+ call s_derive_center_of_mass(q_prim_ts(3)%vf, c_mass) - - call s_write_probe_files(t_step, q_cons_ts(1)%vf, accel_mag) -+ call s_write_com_files(t_step, c_mass) - end if - - end subroutine s_compute_derived_variables -@@ -194,7 +192,6 @@ contains - do l = 0, p - do k = 0, n - do j = 0, m -- - q_sf(j, k, l) = (11d0*q_prim_vf0(mom_idx%beg)%sf(j, k, l) & - - 18d0*q_prim_vf1(mom_idx%beg)%sf(j, k, l) & - + 9d0*q_prim_vf2(mom_idx%beg)%sf(j, k, l) & -@@ -234,18 +231,15 @@ contains - end do - end do - end do -- - ! Computing the acceleration component in the y-coordinate direction - elseif (i == 2) then - do l = 0, p - do k = 0, n - do j = 0, m -- - q_sf(j, k, l) = (11d0*q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf1(mom_idx%beg + 1)%sf(j, k, l) & - + 9d0*q_prim_vf2(mom_idx%beg + 1)%sf(j, k, l) & - - 2d0*q_prim_vf3(mom_idx%beg + 1)%sf(j, k, l))/(6d0*dt) -- - do r = -fd_number, fd_number - if (p == 0) then ! 2D simulation - q_sf(j, k, l) = q_sf(j, k, l) & -@@ -316,11 +310,154 @@ contains - - end subroutine s_derive_acceleration_component - -+ !> This subroutine is used together with the volume fraction -+ !! model and when called upon, it computes the location of -+ !! of the center of mass for each fluid from the inputted -+ !! primitive variables, q_prim_vf. The computed location -+ !! is then written to a formatted data file by the root process. -+ !! @param q_prim_vf Primitive variables -+ !! @param c_m Mass,x-location,y-location,z-location -+ subroutine s_derive_center_of_mass(q_vf, c_m) -+ type(scalar_field), dimension(sys_size), intent(IN) :: q_vf -+ real(kind(0d0)), dimension(1:num_fluids, 1:5), intent(INOUT) :: c_m -+ integer :: i, j, k, l !< Generic loop iterators -+ real(kind(0d0)) :: tmp, tmp_out !< Temporary variable to store quantity for mpi_allreduce -+ real(kind(0d0)) :: dV !< Discrete cell volume -+ -+ do i = 1, num_fluids -+ do j = 1, 5 -+ c_m(i, j) = 0.0d0 -+ end do -+ end do -+ -+ if (n == 0) then !1D simulation -+ do i = 1, num_fluids !Loop over individual fluids -+ do l = 0, p !Loop over grid -+ do k = 0, n -+ do j = 0, m -+ dV = dx(j) -+ ! Mass -+ c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV -+ ! x-location weighted -+ c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) -+ ! Volume fraction -+ c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 1)%sf(j, k, l)*dV -+ end do -+ end do -+ end do -+ end do -+ elseif (p == 0) then !2D simulation -+ do i = 1, num_fluids !Loop over individual fluids -+ do l = 0, p !Loop over grid -+ do k = 0, n -+ do j = 0, m -+ dV = dx(j)*dy(k) -+ ! Mass -+ c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV -+ ! x-location weighted -+ c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) -+ ! y-location weighted -+ c_m(i, 3) = c_m(i, 3) + q_vf(i)%sf(j, k, l)*dV*y_cc(k) -+ ! Volume fraction -+ c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 1)%sf(j, k, l)*dV -+ end do -+ end do -+ end do -+ end do -+ else !3D simulation -+ do i = 1, num_fluids !Loop over individual fluids -+ do l = 0, p !Loop over grid -+ do k = 0, n -+ do j = 0, m -+ dV = dx(j)*dy(k)*dz(l) -+ ! Mass -+ c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV -+ ! x-location weighted -+ c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) -+ ! y-location weighted -+ c_m(i, 3) = c_m(i, 3) + q_vf(i)%sf(j, k, l)*dV*y_cc(k) -+ ! z-location weighted -+ c_m(i, 4) = c_m(i, 4) + q_vf(i)%sf(j, k, l)*dV*z_cc(l) -+ ! Volume fraction -+ c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 1)%sf(j, k, l)*dV -+ end do -+ end do -+ end do -+ end do -+ end if -+ if (n == 0) then !1D simulation -+ do i = 1, num_fluids !Loop over individual fluids -+ ! Sum all components across all processors using MPI_ALLREDUCE -+ if (num_procs > 1) then -+ tmp = c_m(i, 1) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 1) = tmp_out -+ tmp = c_m(i, 2) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 2) = tmp_out -+ tmp = c_m(i, 5) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 5) = tmp_out -+ end if -+ ! Compute quotients -+ c_m(i, 2) = c_m(i, 2)/c_m(i, 1) -+ end do -+ elseif (p == 0) then !2D simulation -+ do i = 1, num_fluids !Loop over individual fluids -+ ! Sum all components across all processors using MPI_ALLREDUCE -+ if (num_procs > 1) then -+ tmp = c_m(i, 1) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 1) = tmp_out -+ tmp = c_m(i, 2) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 2) = tmp_out -+ tmp = c_m(i, 3) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 3) = tmp_out -+ tmp = c_m(i, 5) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 5) = tmp_out -+ end if -+ ! Compute quotients -+ c_m(i, 2) = c_m(i, 2)/c_m(i, 1) -+ c_m(i, 3) = c_m(i, 3)/c_m(i, 1) -+ end do -+ else !3D simulation -+ do i = 1, num_fluids !Loop over individual fluids -+ ! Sum all components across all processors using MPI_ALLREDUCE -+ if (num_procs > 1) then -+ tmp = c_m(i, 1) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 1) = tmp_out -+ tmp = c_m(i, 2) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 2) = tmp_out -+ tmp = c_m(i, 3) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 3) = tmp_out -+ tmp = c_m(i, 4) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 4) = tmp_out -+ tmp = c_m(i, 5) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 5) = tmp_out -+ end if -+ ! Compute quotients -+ c_m(i, 2) = c_m(i, 2)/c_m(i, 1) -+ c_m(i, 3) = c_m(i, 3)/c_m(i, 1) -+ c_m(i, 4) = c_m(i, 4)/c_m(i, 1) -+ end do -+ end if -+ -+ end subroutine s_derive_center_of_mass ! ---------------------------------- -+ - !> Deallocation procedures for the module - subroutine s_finalize_derived_variables_module - - ! Closing CoM and flow probe files - if (proc_rank == 0) then -+ call s_close_com_files() - if (probe_wrt) then - call s_close_probe_files() - end if -diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp -index a703eb5c..539d3b56 100644 ---- a/src/simulation/m_global_parameters.fpp -+++ b/src/simulation/m_global_parameters.fpp -@@ -144,9 +144,12 @@ module m_global_parameters - integer :: wave_speeds !< Wave speeds estimation method - integer :: avg_state !< Average state evaluation method - logical :: alt_soundspeed !< Alternate mixture sound speed -- logical :: null_weights !< Null undesired WENO weights -- logical :: mixture_err !< Mixture properties correction -- logical :: hypoelasticity !< hypoelasticity modeling -+ logical :: null_weights !< Null undesired WENO weights -+ logical :: mixture_err !< Mixture properties correction -+ logical :: hypoelasticity !< hypoelasticity modeling -+ logical :: hyperelasticity !< hyperelasticity modeling -+ integer :: hyper_model !< hyperelasticity solver algorithm -+ logical :: elasticity !< elasticity modeling, true for hyper or hypo - logical :: cu_tensor - - logical :: bodyForces -@@ -166,7 +169,7 @@ module m_global_parameters - !$acc declare create(num_dims, weno_polyn, weno_order, num_fluids, wenojs, mapped_weno, wenoz, teno) - #:endif - -- !$acc declare create(mpp_lim, model_eqns, mixture_err, alt_soundspeed, avg_state, mp_weno, weno_eps, teno_CT, hypoelasticity, low_Mach) -+ !$acc declare create(mpp_lim, model_eqns, mixture_err, alt_soundspeed, avg_state, mp_weno, weno_eps, teno_CT, hypoelasticity, hyperelasticity, elasticity, low_Mach) - - logical :: relax !< activate phase change - integer :: relax_model !< Relaxation model -@@ -182,6 +185,8 @@ module m_global_parameters - type(int_bounds_info) :: bc_x, bc_y, bc_z - !> @} - type(bounds_info) :: x_domain, y_domain, z_domain -+ real(kind(0d0)) :: x_a, y_a, z_a -+ real(kind(0d0)) :: x_b, y_b, z_b - - logical :: parallel_io !< Format of the data files - logical :: file_per_process !< shared file or not when using parallel io -@@ -208,19 +213,22 @@ module m_global_parameters - !> @name Annotations of the structure of the state and flux vectors in terms of the - !! size and the configuration of the system of equations to which they belong - !> @{ -- integer :: sys_size !< Number of unknowns in system of eqns. -+ integer :: sys_size !< Number of unknowns in system of eqns. - type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. - type(int_bounds_info) :: mom_idx !< Indexes of first & last momentum eqns. -- integer :: E_idx !< Index of energy equation -- integer :: n_idx !< Index of number density -+ integer :: E_idx !< Index of energy equation -+ integer :: n_idx !< Index of number density - type(int_bounds_info) :: adv_idx !< Indexes of first & last advection eqns. - type(int_bounds_info) :: internalEnergies_idx !< Indexes of first & last internal energy eqns. -- type(bub_bounds_info) :: bub_idx !< Indexes of first & last bubble variable eqns. -- integer :: alf_idx !< Index of void fraction -- integer :: gamma_idx !< Index of specific heat ratio func. eqn. -- integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. -+ type(bub_bounds_info) :: bub_idx !< Indexes of first & last bubble variable eqns. -+ integer :: alf_idx !< Index of void fraction -+ integer :: gamma_idx !< Index of specific heat ratio func. eqn. -+ integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. - type(int_bounds_info) :: stress_idx !< Indexes of first and last shear stress eqns. -- integer :: c_idx ! Index of the color function -+ type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. -+ integer :: b_size !< Number of elements in the symmetric b tensor, plus one -+ integer :: tensor_size !< Number of elements in the full tensor plus one -+ integer :: c_idx !< Index of the color function - !> @} - - !$acc declare create(bub_idx) -@@ -273,7 +281,7 @@ module m_global_parameters - - integer :: startx, starty, startz - -- !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx) -+ !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx,b_size, tensor_size, xi_idx) - - ! END: Simulation Algorithm Parameters ===================================== - -@@ -299,6 +307,7 @@ module m_global_parameters - !! The finite-difference number is given by MAX(1, fd_order/2). Essentially, - !! it is a measure of the half-size of the finite-difference stencil for the - !! selected order of accuracy. -+ !$acc declare create(fd_order,fd_number) - - logical :: probe_wrt - logical :: integral_wrt -@@ -435,7 +444,9 @@ module m_global_parameters - integer :: intxb, intxe - integer :: bubxb, bubxe - integer :: strxb, strxe -+ integer :: xibeg, xiend - !$acc declare create(momxb, momxe, advxb, advxe, contxb, contxe, intxb, intxe, bubxb, bubxe, strxb, strxe) -+!$acc declare create(xibeg,xiend) - - #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps) -@@ -515,6 +526,9 @@ contains - palpha_eps = dflt_real - ptgalpha_eps = dflt_real - hypoelasticity = .false. -+ hyperelasticity = .false. -+ elasticity = .false. -+ hyper_model = dflt_int - weno_flat = .true. - riemann_flat = .true. - rdma_mpi = .false. -@@ -828,13 +842,26 @@ contains - end if - end if - -- if (hypoelasticity) then -+ if (hypoelasticity .or. hyperelasticity) then -+ elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D - sys_size = stress_idx%end - end if - -+ if (hyperelasticity) then -+ ! number of entries in the symmetric btensor plus the jacobian -+ b_size = (num_dims*(num_dims + 1))/2 + 1 -+ ! storing the jacobian in the last entry -+ tensor_size = num_dims**2 + 1 -+ xi_idx%beg = sys_size + 1 -+ xi_idx%end = sys_size + num_dims -+ ! adding three more equations for the \xi field and the elastic energy -+ sys_size = xi_idx%end + 1 -+ hyper_model = 1 -+ end if -+ - if (.not. f_is_default(sigma)) then - c_idx = sys_size + 1 - sys_size = c_idx -@@ -853,6 +880,25 @@ contains - internalEnergies_idx%end = adv_idx%end + num_fluids - sys_size = internalEnergies_idx%end - -+ if (hypoelasticity .or. hyperelasticity) then -+ elasticity = .true. -+ stress_idx%beg = sys_size + 1 -+ stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 -+ ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D -+ sys_size = stress_idx%end -+ end if -+ -+ if (hyperelasticity) then -+ ! number of entries in the symmetric btensor plus the jacobian -+ b_size = (num_dims*(num_dims + 1))/2 + 1 -+ ! storing the jacobian in the last entry -+ tensor_size = num_dims**2 + 1 -+ xi_idx%beg = sys_size + 1 -+ xi_idx%end = sys_size + num_dims -+ ! adding three more equations for the \xi field and the elastic energy -+ sys_size = xi_idx%end + 1 -+ end if -+ - if (.not. f_is_default(sigma)) then - c_idx = sys_size + 1 - sys_size = c_idx -@@ -989,12 +1035,18 @@ contains - ! the next one - if (any(Re_size > 0)) then - buff_size = 2*weno_polyn + 2 --! else if (hypoelasticity) then !TODO: check if necessary -+! else if (elasticity) then !TODO: check if necessary - ! buff_size = 2*weno_polyn + 2 - else - buff_size = weno_polyn + 2 - end if - -+ if (elasticity) then -+ fd_order = 4 -+ fd_number = max(1, fd_order/2) -+ !buff_size = buff_size + fd_number -+ end if -+ - ! Configuring Coordinate Direction Indexes ========================= - if (bubbles) then - ix%beg = -buff_size; iy%beg = 0; iz%beg = 0 -@@ -1024,7 +1076,8 @@ contains - if (p > 0) then - startz = -buff_size - end if -- -+ -+ !$acc update device(fd_order,fd_number) - !$acc update device(startx, starty, startz) - - if (cyl_coord .neqv. .true.) then ! Cartesian grid -@@ -1047,19 +1100,23 @@ contains - strxe = stress_idx%end - intxb = internalEnergies_idx%beg - intxe = internalEnergies_idx%end -+ xibeg = xi_idx%beg -+ xiend = xi_idx%end - -- !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe) -+ !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe, b_size, xibeg, xiend, tensor_size) - !$acc update device(m, n, p) - - !$acc update device(alt_soundspeed, acoustic_source, num_source) -- !$acc update device(dt, sys_size, buff_size, pref, rhoref, gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim, bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids, model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord, mp_weno, weno_eps, teno_CT, low_Mach) -+ !$acc update device(dt, sys_size, buff_size, pref, rhoref, gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim, bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids, model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord, mp_weno, weno_eps, teno_CT, hyperelasticity, elasticity, xi_idx, low_Mach) - - #:if not MFC_CASE_OPTIMIZATION - !$acc update device(wenojs, mapped_weno, wenoz, teno) - #:endif - - !$acc enter data copyin(nb, R0ref, Ca, Web, Re_inv, weight, R0, V0, bubbles, polytropic, polydisperse, qbmm, R0_type, ptil, bubble_model, thermal, poly_sigma) -- !$acc enter data copyin(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v, k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN , mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam) -+ -+ !$acc enter data copyin(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v, k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN, mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam) -+ - !$acc enter data copyin(dir_idx, dir_flg, dir_idx_tau) - - !$acc enter data copyin(relax, relax_model, palpha_eps,ptgalpha_eps) -diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp -new file mode 100644 -index 00000000..9d8b6a4f ---- /dev/null -+++ b/src/simulation/m_hyperelastic.fpp -@@ -0,0 +1,364 @@ -+!> -+!! @file m_hyperelastic.f90 -+!! @brief Contains module m_hyperelastic -+ -+#:include 'macros.fpp' -+ -+!> @brief This module consists of subroutines used in the calculation -+!! of the cauchy tensor -+ -+module m_hyperelastic -+ -+ ! Dependencies ============================================================= -+ -+ use m_derived_types !< Definitions of the derived types -+ -+ use m_global_parameters !< Definitions of the global parameters -+ -+ use m_variables_conversion !< State variables type conversion procedures -+ -+ use m_helper -+ -+ ! ========================================================================== -+ -+ implicit none -+ -+ private; public :: s_hyperelastic_rmt_stress_update, & -+ s_initialize_hyperelastic_module, & -+ s_finalize_hyperelastic_module -+ -+ !> @name Abstract interface for creating function pointers -+ !> @{ -+ abstract interface -+ -+ !> @name Abstract subroutine for the infinite relaxation solver -+ !> @{ -+ subroutine s_abstract_hyperelastic_solver(btensor, q_prim_vf, G, j, k, l) -+ !$acc routine seq -+ import :: scalar_field, sys_size, b_size -+ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf -+ type(scalar_field), dimension(b_size), intent(inout) :: btensor -+ real(kind(0d0)), intent(in) :: G -+ integer, intent(in) :: j, k, l -+ -+ end subroutine s_abstract_hyperelastic_solver -+ !> @} -+ -+ end interface -+ !> @} -+ -+ procedure(s_abstract_hyperelastic_solver), & -+ pointer :: s_compute_cauchy_solver => null() -+ -+ !! The btensor at the cell-interior Gaussian quadrature points. -+ !! These tensor is needed to be calculated once and make the code DRY. -+ type(vector_field) :: btensor !< -+ !$acc declare create(btensor) -+ -+#ifdef CRAY_ACC_WAR -+ @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), allocatable, dimension(:, :), fd_coeff_x, fd_coeff_y, fd_coeff_z) -+ !$acc declare link(fd_coeff_x,fd_coeff_y,fd_coeff_z) -+ -+#else -+ -+ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_x -+ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_y -+ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_z -+ !$acc declare create(fd_coeff_x,fd_coeff_y,fd_coeff_z) -+ real(kind(0d0)), allocatable, dimension(:) :: Gs -+ !$acc declare create(Gs) -+#endif -+ -+contains -+ -+ !> The following subroutine handles the calculation of the btensor. -+ !! The calculation of the btensor takes qprimvf. -+ !! @param q_prim_vf Primitive variables -+ !! @param btensor is the output -+ !! calculate the grad_xi, grad_xi is a nxn tensor -+ !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor -+ !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor -+ !! btensor is symmetric, save the data space -+ subroutine s_initialize_hyperelastic_module() -+ integer :: i !< generic iterator -+ -+ @:ALLOCATE(btensor%vf(1:b_size)) -+ do i = 1, b_size -+ @:ALLOCATE(btensor%vf(i)%sf(0:m, 0:n, 0:p)) -+ end do -+ @:ACC_SETUP_VFs(btensor) -+ -+ @:ALLOCATE(Gs(1:num_fluids)) -+ !$acc loop seq -+ do i = 1, num_fluids -+ Gs(i) = fluid_pp(i)%G -+ end do -+ !$acc update device(Gs) -+ -+ ! Associating procedural pointer to the subroutine that will be -+ ! utilized to calculate the solution of a given Riemann problem -+ if (hyper_model == 1) then -+ s_compute_cauchy_solver => s_neoHookean_cauchy_solver -+ elseif (riemann_solver == 2) then -+ s_compute_cauchy_solver => s_Mooney_Rivlin_cauchy_solver -+ end if -+ -+ @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) -+ if (n > 0) then -+ @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) -+ end if -+ if (p > 0) then -+ @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) -+ end if -+ -+ ! Computing centered finite difference coefficients -+ call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & -+ fd_number, fd_order) -+ !$acc update device(fd_coeff_x) -+ if (n > 0) then -+ call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & -+ fd_number, fd_order) -+ !$acc update device(fd_coeff_y) -+ end if -+ if (p > 0) then -+ call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & -+ fd_number, fd_order) -+ !$acc update device(fd_coeff_z) -+ end if -+ -+ end subroutine s_initialize_hyperelastic_module -+ -+ !> The following subroutine handles the calculation of the btensor. -+ !! The calculation of the btensor takes qprimvf. -+ !! @param q_prim_vf Primitive variables -+ !! @param btensor is the output -+ !! calculate the grad_xi, grad_xi is a nxn tensor -+ !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor -+ !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor -+ !! btensor is symmetric, save the data space -+ subroutine s_hyperelastic_rmt_stress_update(q_cons_vf,q_prim_vf) -+ -+ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf -+ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf -+ -+ real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb -+ real(kind(0d0)), dimension(num_fluids) :: alpha_K, alpha_rho_K -+ real(kind(0d0)), dimension(2) :: Re_K -+ real(kind(0d0)) :: rho_K, gamma_K, pi_inf_K, qv_K -+ real(kind(0d0)) :: G_K -+ integer :: j, k, l, i, r -+ -+ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,Re_K, tensora, tensorb) -+ do l = 0, p-2 -+ do k = 0, n-2 -+ do j = 2, m-2 -+ !$acc loop seq -+ do i = 1, num_fluids -+ alpha_rho_K(i) = q_cons_vf(i)%sf(j, k, l) -+ alpha_K(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) -+ end do -+ ! If in simulation, use acc mixture subroutines -+ call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & -+ alpha_rho_K, Re_K, j, k, l, G_K, Gs) -+ rho_K = max(rho_K, sgm_eps) -+ if ( G_K .le. verysmall ) G_K = 0d0 -+ -+ if ( G_K .gt. 20d0 ) then -+ !$acc loop seq -+ do i = 1, tensor_size -+ tensora(i) = 0d0 -+ end do -+ ! STEP 1: computing the grad_xi tensor using finite differences -+ ! grad_xi definition / organization -+ ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx -+ ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy -+ ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz -+ !$acc loop seq -+ do r = -fd_number, fd_number -+ ! derivatives in the x-direction -+ tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) -+ tensora(2) = tensora(2) + q_prim_vf(xibeg+1)%sf(j + r, k, l)*fd_coeff_x(r, j) -+ tensora(3) = tensora(3) + q_prim_vf(xiend)%sf(j + r, k, l)*fd_coeff_x(r, j) -+ ! derivatives in the y-direction -+ tensora(4) = tensora(4) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) -+ tensora(5) = tensora(5) + q_prim_vf(xibeg+1)%sf(j, k + r, l)*fd_coeff_y(r, k) -+ tensora(6) = tensora(6) + q_prim_vf(xiend)%sf(j, k + r, l)*fd_coeff_y(r, k) -+ ! derivatives in the z-direction -+ tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_z(r, l) -+ tensora(8) = tensora(8) + q_prim_vf(xibeg+1)%sf(j, k, l + r)*fd_coeff_z(r, l) -+ tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_z(r, l) -+ end do -+ ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse -+ tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) -+ tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) -+ tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) -+ tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) -+ tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) -+ tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) -+ tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) -+ tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) -+ tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) -+ -+ ! STEP 2b: computing the determinant of the grad_xi tensor -+ tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & -+ - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & -+ + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) -+ -+ if (tensorb(tensor_size) > 0d0) then -+ ! STEP 2c: computing the inverse of grad_xi tensor = F -+ ! tensorb is the adjoint, tensora becomes F -+ !$acc loop seq -+ do i = 1, tensor_size - 1 -+ tensora(i) = tensorb(i)/tensorb(tensor_size) -+ end do -+ -+ ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) -+ tensorb(tensor_size) = 1d0/tensorb(tensor_size) -+ -+ ! STEP 3: computing F tranpose F -+ tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 -+ tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 -+ tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 -+ tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) -+ tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) -+ tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) -+ ! STEP 4: update the btensor, this is consistent with Riemann solvers -+ ! \tau_xx -+ btensor%vf(1)%sf(j, k, l) = tensorb(1) -+ ! \tau_xy -+ btensor%vf(2)%sf(j, k, l) = tensorb(2) -+ ! \tau_yy -+ btensor%vf(3)%sf(j, k, l) = tensorb(5) -+ ! \tau_xz -+ btensor%vf(4)%sf(j, k, l) = tensorb(3) -+ ! \tau_yz -+ btensor%vf(5)%sf(j, k, l) = tensorb(6) -+ ! \tau_zz -+ btensor%vf(6)%sf(j, k, l) = tensorb(9) -+ ! store the determinant at the last entry of the btensor -+ btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) -+ ! STEP 5a: updating the Cauchy stress primitive scalar field -+ call s_compute_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) -+ ! STEP 5b: updating the pressure field -+ q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & -+ G_K*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma_K -+ ! STEP 5c: updating the Cauchy stress conservative scalar field -+ !$acc loop seq -+ do i = 1, b_size - 1 -+ q_cons_vf(strxb + i - 1)%sf(j, k, l) = & -+ rho_K*q_prim_vf(strxb + i - 1)%sf(j, k, l) -+ end do -+ end if -+ end if -+ end do -+ end do -+ end do -+ !$acc end parallel loop -+ end subroutine s_hyperelastic_rmt_stress_update -+ -+ !> The following subroutine handles the calculation of the btensor. -+ !! The calculation of the btensor takes qprimvf. -+ !! @param q_prim_vf Primitive variables -+ !! @param btensor is the output -+ !! calculate the grad_xi, grad_xi is a nxn tensor -+ !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor -+ !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor -+ !! btensor is symmetric, save the data space -+ subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) -+ !$acc routine seq -+ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf -+ type(scalar_field), dimension(b_size), intent(inout) :: btensor -+ real(kind(0d0)), intent(in) :: G -+ integer, intent(in) :: j, k, l -+ -+ real(kind(0d0)) :: trace -+ real(kind(0d0)) :: f13 = 1d0/3d0 -+ integer :: i !< Generic loop iterators -+ -+ !TODO Make this 1D and 2D capable -+ ! tensor is the symmetric tensor & calculate the trace of the tensor -+ trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) -+ -+ ! calculate the deviatoric of the tensor -+ btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace -+ btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace -+ btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace -+ -+ ! dividing by the jacobian for neo-Hookean model -+ ! setting the tensor to the stresses for riemann solver -+ !$acc loop seq -+ do i = 1, b_size - 1 -+ q_prim_vf(strxb + i - 1)%sf(j, k, l) = & -+ G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) -+ end do -+ ! compute the invariant without the elastic modulus -+ q_prim_vf(xiend + 1)%sf(j, k, l) = & -+ 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) -+ -+ end subroutine s_neoHookean_cauchy_solver -+ -+ !> The following subroutine handles the calculation of the btensor. -+ !! The calculation of the btensor takes qprimvf. -+ !! @param q_prim_vf Primitive variables -+ !! @param btensor is the output -+ !! calculate the grad_xi, grad_xi is a nxn tensor -+ !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor -+ !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor -+ !! btensor is symmetric, save the data space -+ subroutine s_Mooney_Rivlin_cauchy_solver(btensor, q_prim_vf, G, j, k, l) -+ !$acc routine seq -+ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf -+ type(scalar_field), dimension(b_size), intent(inout) :: btensor -+ real(kind(0d0)), intent(in) :: G -+ integer, intent(in) :: j, k, l -+ -+ real(kind(0d0)) :: trace -+ real(kind(0d0)) :: f13 = 1d0/3d0 -+ integer :: i !< Generic loop iterators -+ -+ !TODO Make this 1D and 2D capable -+ ! tensor is the symmetric tensor & calculate the trace of the tensor -+ trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) -+ -+ ! calculate the deviatoric of the tensor -+ btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace -+ btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace -+ btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace -+ -+ ! dividing by the jacobian for neo-Hookean model -+ ! setting the tensor to the stresses for riemann solver -+ !$acc loop seq -+ do i = 1, b_size - 1 -+ q_prim_vf(strxb + i - 1)%sf(j, k, l) = & -+ G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) -+ end do -+ ! compute the invariant without the elastic modulus -+ q_prim_vf(xiend + 1)%sf(j, k, l) = & -+ 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) -+ -+ end subroutine s_Mooney_Rivlin_cauchy_solver -+ -+ -+ subroutine s_finalize_hyperelastic_module() -+ -+ integer :: i !< iterator -+ -+ ! Disassociating procedural pointer to the subroutine which was -+ ! utilized to calculate the solution of a given Riemann problem -+ s_compute_cauchy_solver => null() -+ -+ ! Deallocating memory -+ do i = 1, b_size -+ @:DEALLOCATE_GLOBAL(btensor%vf(i)%sf) -+ end do -+ @:DEALLOCATE_GLOBAL(fd_coeff_x) -+ if (n > 0) then -+ @:DEALLOCATE_GLOBAL(fd_coeff_y) -+ if (p > 0) then -+ @:DEALLOCATE_GLOBAL(fd_coeff_z) -+ end if -+ end if -+ -+ end subroutine s_finalize_hyperelastic_module -+ -+end module m_hyperelastic -diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp -index e3bb7ec0..7f3d54c3 100644 ---- a/src/simulation/m_hypoelastic.fpp -+++ b/src/simulation/m_hypoelastic.fpp -@@ -13,13 +13,16 @@ module m_hypoelastic - - use m_global_parameters !< Definitions of the global parameters - -- use m_mpi_proxy !< Message passing interface (MPI) module proxy -+! use m_mpi_proxy !< Message passing interface (MPI) module proxy -+ -+ use m_helper - - ! ========================================================================== - - implicit none - - private; public :: s_initialize_hypoelastic_module, & -+ s_finalize_hypoelastic_module, & - s_compute_hypoelastic_rhs - - #ifdef CRAY_ACC_WAR -@@ -33,6 +36,10 @@ module m_hypoelastic - - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), rho_K_field, G_K_field) - !$acc declare link(rho_K_field, G_K_field) -+ -+ @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), allocatable, dimension(:, :), fd_coeff_x, fd_coeff_y, fd_coeff_z) -+ !$acc declare link(fd_coeff_x,fd_coeff_y,fd_coeff_z) -+ - #else - real(kind(0d0)), allocatable, dimension(:) :: Gs - !$acc declare create(Gs) -@@ -45,13 +52,17 @@ module m_hypoelastic - real(kind(0d0)), allocatable, dimension(:, :, :) :: rho_K_field, G_K_field - !$acc declare create(rho_K_field, G_K_field) - -+ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_x -+ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_y -+ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_z -+ !$acc declare create(fd_coeff_x,fd_coeff_y,fd_coeff_z) - #endif - - contains - - subroutine s_initialize_hypoelastic_module - -- integer :: i -+ integer :: i, k, r - - @:ALLOCATE_GLOBAL(Gs(1:num_fluids)) - @:ALLOCATE_GLOBAL(rho_K_field(0:m,0:n,0:p), G_K_field(0:m,0:n,0:p)) -@@ -69,6 +80,29 @@ contains - end do - !$acc update device(Gs) - -+ @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) -+ if (n > 0) then -+ @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) -+ end if -+ if (p > 0) then -+ @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) -+ end if -+ -+ ! Computing centered finite difference coefficients -+ call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & -+ fd_number, fd_order) -+ !$acc update device(fd_coeff_x) -+ if (n > 0) then -+ call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & -+ fd_number, fd_order) -+ !$acc update device(fd_coeff_y) -+ end if -+ if (p > 0) then -+ call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & -+ fd_number, fd_order) -+ !$acc update device(fd_coeff_z) -+ end if -+ - end subroutine s_initialize_hypoelastic_module - - !> The purpose of this procedure is to compute the source terms -@@ -84,7 +118,7 @@ contains - - real(kind(0d0)) :: rho_K, G_K - -- integer :: i, k, l, q !< Loop variables -+ integer :: i, k, l, q, r !< Loop variables - integer :: ndirs !< Number of coordinate directions - - ndirs = 1; if (n > 0) ndirs = 2; if (p > 0) ndirs = 3 -@@ -97,82 +131,91 @@ contains - do q = 0, p - do l = 0, n - do k = 0, m -- du_dx(k, l, q) = & -- (q_prim_vf(momxb)%sf(k - 2, l, q) & -- - 8d0*q_prim_vf(momxb)%sf(k - 1, l, q) & -- + 8d0*q_prim_vf(momxb)%sf(k + 1, l, q) & -- - q_prim_vf(momxb)%sf(k + 2, l, q)) & -- /(12d0*dx(k)) -+ du_dx(k, l, q) = 0d0; - end do - end do - end do -+ !$acc end parallel loop -+ -+ !$acc parallel loop collapse(3) gang vector default(present) -+ do q = 0, p -+ do l = 0, n -+ do k = 0, m -+ !$acc loop seq -+ do r = -fd_number, fd_number -+ du_dx(k, l, q) = du_dx(k, l, q) & -+ + q_prim_vf(momxb)%sf(k + r, l, q)*fd_coeff_x(r, k) -+ end do -+ -+ end do -+ end do -+ end do -+ !$acc end parallel loop - - if (ndirs > 1) then - !$acc parallel loop collapse(3) gang vector default(present) - do q = 0, p -- do l = 0, n -- do k = 0, m -- du_dy(k, l, q) = & -- (q_prim_vf(momxb)%sf(k, l - 2, q) & -- - 8d0*q_prim_vf(momxb)%sf(k, l - 1, q) & -- + 8d0*q_prim_vf(momxb)%sf(k, l + 1, q) & -- - q_prim_vf(momxb)%sf(k, l + 2, q)) & -- /(12d0*dy(l)) -- dv_dx(k, l, q) = & -- (q_prim_vf(momxb + 1)%sf(k - 2, l, q) & -- - 8d0*q_prim_vf(momxb + 1)%sf(k - 1, l, q) & -- + 8d0*q_prim_vf(momxb + 1)%sf(k + 1, l, q) & -- - q_prim_vf(momxb + 1)%sf(k + 2, l, q)) & -- /(12d0*dx(k)) -- dv_dy(k, l, q) = & -- (q_prim_vf(momxb + 1)%sf(k, l - 2, q) & -- - 8d0*q_prim_vf(momxb + 1)%sf(k, l - 1, q) & -- + 8d0*q_prim_vf(momxb + 1)%sf(k, l + 1, q) & -- - q_prim_vf(momxb + 1)%sf(k, l + 2, q)) & -- /(12d0*dy(l)) -- end do -+ do l = 0, n -+ do k = 0, m -+ du_dy(k, l, q) = 0d0; dv_dx(k, l, q) = 0d0; dv_dy(k, l, q) = 0d0; - end do -+ end do -+ end do -+ !$acc end parallel loop -+ -+ !$acc parallel loop collapse(3) gang vector default(present) -+ do q = 0, p -+ do l = 0, n -+ do k = 0, m -+ !$acc loop seq -+ do r = -fd_number, fd_number -+ du_dy(k, l, q) = du_dy(k, l, q) & -+ + q_prim_vf(momxb)%sf(k, l + r, q)*fd_coeff_y(r, l) -+ dv_dx(k, l, q) = dv_dx(k, l, q) & -+ + q_prim_vf(momxb + 1)%sf(k + r, l, q)*fd_coeff_x(r, k) -+ dv_dy(k, l, q) = dv_dy(k, l, q) & -+ + q_prim_vf(momxb + 1)%sf(k, l + r, q)*fd_coeff_y(r, l) -+ end do -+ end do -+ end do - end do -+ !$acc end parallel loop - - ! 3D - if (ndirs == 3) then -+ - !$acc parallel loop collapse(3) gang vector default(present) - do q = 0, p -- do l = 0, n -- do k = 0, m -- du_dz(k, l, q) = & -- (q_prim_vf(momxb)%sf(k, l, q - 2) & -- - 8d0*q_prim_vf(momxb)%sf(k, l, q - 1) & -- + 8d0*q_prim_vf(momxb)%sf(k, l, q + 1) & -- - q_prim_vf(momxb)%sf(k, l, q + 2)) & -- /(12d0*dz(q)) -- dv_dz(k, l, q) = & -- (q_prim_vf(momxb + 1)%sf(k, l, q - 2) & -- - 8d0*q_prim_vf(momxb + 1)%sf(k, l, q - 1) & -- + 8d0*q_prim_vf(momxb + 1)%sf(k, l, q + 1) & -- - q_prim_vf(momxb + 1)%sf(k, l, q + 2)) & -- /(12d0*dz(q)) -- dw_dx(k, l, q) = & -- (q_prim_vf(momxe)%sf(k - 2, l, q) & -- - 8d0*q_prim_vf(momxe)%sf(k - 1, l, q) & -- + 8d0*q_prim_vf(momxe)%sf(k + 1, l, q) & -- - q_prim_vf(momxe)%sf(k + 2, l, q)) & -- /(12d0*dx(k)) -- dw_dy(k, l, q) = & -- (q_prim_vf(momxe)%sf(k, l - 2, q) & -- - 8d0*q_prim_vf(momxe)%sf(k, l - 1, q) & -- + 8d0*q_prim_vf(momxe)%sf(k, l + 1, q) & -- - q_prim_vf(momxe)%sf(k, l + 2, q)) & -- /(12d0*dy(l)) -- dw_dz(k, l, q) = & -- (q_prim_vf(momxe)%sf(k, l, q - 2) & -- - 8d0*q_prim_vf(momxe)%sf(k, l, q - 1) & -- + 8d0*q_prim_vf(momxe)%sf(k, l, q + 1) & -- - q_prim_vf(momxe)%sf(k, l, q + 2)) & -- /(12d0*dz(q)) -- end do -+ do l = 0, n -+ do k = 0, m -+ du_dz(k, l, q) = 0d0; dv_dz(k, l, q) = 0d0; dw_dx(k, l, q) = 0d0; -+ dw_dy(k, l, q) = 0d0; dw_dz(k, l, q) = 0d0; - end do -+ end do -+ end do -+ !$acc end parallel loop -+ -+ !$acc parallel loop collapse(3) gang vector default(present) -+ do q = 0, p -+ do l = 0, n -+ do k = 0, m -+ !$acc loop seq -+ do r = -fd_number, fd_number -+ du_dz(k, l, q) = du_dz(k, l, q) & -+ + q_prim_vf(momxb)%sf(k, l, q + r)*fd_coeff_z(r, q) -+ dv_dz(k, l, q) = dv_dz(k, l, q) & -+ + q_prim_vf(momxb + 1)%sf(k, l, q + r)*fd_coeff_z(r, q) -+ dw_dx(k, l, q) = dw_dx(k, l, q) & -+ + q_prim_vf(momxe)%sf(k + r, l, q)*fd_coeff_x(r, k) -+ dw_dy(k, l, q) = dw_dy(k, l, q) & -+ + q_prim_vf(momxe)%sf(k, l + r, q)*fd_coeff_y(r, l) -+ dw_dz(k, l, q) = dw_dz(k, l, q) & -+ + q_prim_vf(momxe)%sf(k, l, q + r)*fd_coeff_z(r, q) -+ end do -+ end do -+ end do - end do -+ !$acc end parallel loop - end if - end if - -@@ -189,7 +232,7 @@ contains - G_K_field(k, l, q) = G_K - - !TODO: take this out if not needed -- if (G_K < 1000) then -+ if (G_K < verysmall) then - G_K_field(k, l, q) = 0 - end if - end do -@@ -314,4 +357,21 @@ contains - - end subroutine s_compute_hypoelastic_rhs - -+ subroutine s_finalize_hypoelastic_module() ! -------------------- -+ -+ @:DEALLOCATE_GLOBAL(Gs) -+ @:DEALLOCATE_GLOBAL(rho_K_field, G_K_field) -+ @:DEALLOCATE_GLOBAL(du_dx) -+ @:DEALLOCATE_GLOBAL(fd_coeff_x) -+ if (n > 0) then -+ @:DEALLOCATE_GLOBAL(du_dy,dv_dx,dv_dy) -+ @:DEALLOCATE_GLOBAL(fd_coeff_y) -+ if (p > 0) then -+ @:DEALLOCATE_GLOBAL(du_dz, dv_dz, dw_dx, dw_dy, dw_dz) -+ @:DEALLOCATE_GLOBAL(fd_coeff_z) -+ end if -+ end if -+ -+ end subroutine s_finalize_hypoelastic_module -+ - end module m_hypoelastic -diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp -index a0fa5972..01c34581 100644 ---- a/src/simulation/m_ibm.fpp -+++ b/src/simulation/m_ibm.fpp -@@ -208,7 +208,7 @@ contains - - if (model_eqns /= 4) then - ! If in simulation, use acc mixture subroutines -- if (hypoelasticity) then -+ if (elasticity) then - call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv_K, alpha_IP, & - alpha_rho_IP, Re_K, j, k, l, G_K, Gs) - else if (bubbles) then -diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp -index 26700d16..513d5bec 100644 ---- a/src/simulation/m_mpi_proxy.fpp -+++ b/src/simulation/m_mpi_proxy.fpp -@@ -173,7 +173,40 @@ contains - !! available to the other processors. Then, the purpose of - !! this subroutine is to distribute the user inputs to the - !! remaining processors in the communicator. -- subroutine s_mpi_bcast_user_inputs -+ -+ subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root) -+ -+#ifdef MFC_MPI -+ -+ implicit none -+ integer, intent(in) :: counts ! Array of vector lengths for each process -+ real(kind(0d0)), intent(in), dimension(counts) :: my_vector ! Input vector on each process -+ integer, intent(in) :: root ! Rank of the root process -+ real(kind(0d0)), allocatable, intent(out) :: gathered_vector(:) ! Gathered vector on the root process -+ -+ integer :: i, offset, ierr -+ integer, allocatable :: recounts(:), displs(:) -+ -+ allocate (recounts(num_procs)) -+ -+ call MPI_GATHER(counts, 1, MPI_INTEGER, recounts, 1, MPI_INTEGER, root, & -+ MPI_COMM_WORLD, ierr) -+ -+ allocate (displs(size(recounts))) -+ -+ displs(1) = 0 -+ -+ do i = 2, size(recounts) -+ displs(i) = displs(i - 1) + recounts(i - 1) -+ end do -+ -+ allocate (gathered_vector(sum(recounts))) -+ call MPI_GATHERV(my_vector, counts, MPI_DOUBLE_PRECISION, gathered_vector, recounts, displs, MPI_DOUBLE_PRECISION, & -+ root, MPI_COMM_WORLD, ierr) -+#endif -+ end subroutine s_mpi_gather_data -+ -+ subroutine s_mpi_bcast_user_inputs() ! --------------------------------- - - #ifdef MFC_MPI - -@@ -202,7 +235,8 @@ contains - & 'parallel_io', 'hypoelasticity', 'bubbles', 'polytropic', & - & 'polydisperse', 'qbmm', 'acoustic_source', 'probe_wrt', 'integral_wrt', & - & 'prim_vars_wrt', 'weno_avg', 'file_per_process', 'relax', & -- & 'adv_n', 'adap_dt', 'ib', 'bodyForces', 'bf_x', 'bf_y', 'bf_z' ] -+ & 'adv_n', 'adap_dt', 'ib', 'bodyForces', 'bf_x', 'bf_y', 'bf_z', & -+ & 'hyperelasticity' ] - call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) - #:endfor - -@@ -212,7 +246,8 @@ contains - & 'bc_y%vb1','bc_y%vb2','bc_y%vb3','bc_y%ve1','bc_y%ve2','bc_y%ve3', & - & 'bc_z%vb1','bc_z%vb2','bc_z%vb3','bc_z%ve1','bc_z%ve2','bc_z%ve3', & - & 'x_domain%beg', 'x_domain%end', 'y_domain%beg', 'y_domain%end', & -- & 'z_domain%beg', 'z_domain%end'] -+ & 'z_domain%beg', 'z_domain%end', 'x_a', 'x_b', 'y_a', 'y_b', 'z_a', & -+ & 'z_b'] - call MPI_BCAST(${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - #:endfor - -diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp -index c2056b42..72bb1c87 100644 ---- a/src/simulation/m_rhs.fpp -+++ b/src/simulation/m_rhs.fpp -@@ -39,6 +39,8 @@ module m_rhs - - use m_hypoelastic - -+ use m_hyperelastic -+ - use m_acoustic_src - - use m_viscous -@@ -615,7 +617,6 @@ contains - if (riemann_solver /= 1) then - do l = adv_idx%beg + 1, adv_idx%end - flux_src_n(i)%vf(l)%sf => flux_src_n(i)%vf(adv_idx%beg)%sf -- - !$acc enter data attach(flux_src_n(i)%vf(l)%sf) - end do - end if -@@ -623,7 +624,6 @@ contains - do l = 1, sys_size - flux_n(i)%vf(l)%sf => flux_n(1)%vf(l)%sf - flux_src_n(i)%vf(l)%sf => flux_src_n(1)%vf(l)%sf -- - !$acc enter data attach(flux_n(i)%vf(l)%sf,flux_src_n(i)%vf(l)%sf) - end do - end if -@@ -778,7 +778,7 @@ contains - end do - end do - end if -- -+ !print *, "I got here A" - call nvtxStartRange("RHS-CONVERT") - call s_convert_conservative_to_primitive_variables( & - q_cons_qp%vf, & -@@ -786,10 +786,16 @@ contains - gm_alpha_qp%vf, & - ix, iy, iz) - call nvtxEndRange -+ !print *, "I got here B" - - call nvtxStartRange("RHS-MPI") - call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) - call nvtxEndRange -+ !print *, "I got here c" -+ -+ call nvtxStartRange("RHS-ELASTIC") -+ if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_qp%vf,q_prim_qp%vf) -+ call nvtxEndRange - - if (t_step == t_step_stop) return - ! ================================================================== -@@ -897,10 +903,8 @@ contains - end if - ix%end = m; iy%end = n; iz%end = p - ! =============================================================== -- call nvtxStartRange("RHS_riemann_solver") -- - ! Computing Riemann Solver Flux and Source Flux ================= -- -+ call nvtxStartRange("RHS_riemann_solver") - call s_riemann_solver(qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, & - dqR_prim_dx_n(id)%vf, & - dqR_prim_dy_n(id)%vf, & -@@ -917,9 +921,10 @@ contains - flux_gsrc_n(id)%vf, & - id, ix, iy, iz) - call nvtxEndRange -+ !print *, "I got here e" - -- ! Additional physics and source terms ============================== -- -+ ! =============================================================== -+ ! Additional physics and source terms =========================== - ! RHS addition for advection source - call nvtxStartRange("RHS_advection_source") - call s_compute_advection_source_term(id, & -@@ -935,6 +940,7 @@ contains - q_prim_qp%vf, & - rhs_vf) - call nvtxEndRange -+ !print *, "I got here f" - - ! RHS additions for viscosity - call nvtxStartRange("RHS_add_phys") -@@ -1006,6 +1012,7 @@ contains - rhs_vf) - call nvtxEndRange - ! END: Additional pphysics and source terms ============================ -+ !print *, "I got here g" - - if (run_time_info .or. probe_wrt .or. ib) then - -@@ -1033,6 +1040,7 @@ contains - time_avg = 0d0 - end if - ! ================================================================== -+ !print *, "I got here h" - - call nvtxEndRange - end subroutine s_compute_rhs -diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp -index bfca7142..f0d4b3e6 100644 ---- a/src/simulation/m_riemann_solvers.fpp -+++ b/src/simulation/m_riemann_solvers.fpp -@@ -162,14 +162,14 @@ module m_riemann_solvers - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsx_vf, flux_src_rsx_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsy_vf, flux_src_rsy_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsz_vf, flux_src_rsz_vf) -- !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & -- !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) -+ !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & -+ !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) - #else - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsx_vf, flux_src_rsx_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsy_vf, flux_src_rsy_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsz_vf, flux_src_rsz_vf -- !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & -- !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) -+ !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & -+ !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf) - #endif - !> @} - -@@ -313,6 +313,7 @@ contains - real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R - real(kind(0d0)) :: G_L, G_R - real(kind(0d0)), dimension(2) :: Re_L, Re_R -+ real(kind(0d0)), dimension(3) :: xi_field_L, xi_field_R - - real(kind(0d0)) :: rho_avg - real(kind(0d0)), dimension(num_dims) :: vel_avg -@@ -356,8 +357,7 @@ contains - #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] - - if (norm_dir == ${NORM_DIR}$) then -- !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, & -- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S) -+ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, xi_field_L, xi_field_R) - do l = is3%beg, is3%end - do k = is2%beg, is2%end - do j = is1%beg, is1%end -@@ -440,31 +440,24 @@ contains - !$acc loop seq - do i = 1, 2 - Re_L(i) = dflt_real -- - if (Re_size(i) > 0) Re_L(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_L(i) = alpha_L(Re_idx(i, q))/Res(i, q) & - + Re_L(i) - end do -- - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) -- - end do - - !$acc loop seq - do i = 1, 2 - Re_R(i) = dflt_real -- - if (Re_size(i) > 0) Re_R(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_R(i) = alpha_R(Re_idx(i, q))/Res(i, q) & - + Re_R(i) - end do -- - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) - end do - end if -@@ -472,26 +465,17 @@ contains - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R - -- H_L = (E_L + pres_L)/rho_L -- H_R = (E_R + pres_R)/rho_R -- -+ ! elastic energy update - if (hypoelasticity) then -- !$acc loop seq -- do i = 1, strxe - strxb + 1 -- tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -- tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -- end do -- -- G_L = 0d0 -- G_R = 0d0 -- -+ G_L = 0d0; G_R = 0d0 - !$acc loop seq - do i = 1, num_fluids - G_L = G_L + alpha_L(i)*Gs(i) - G_R = G_R + alpha_R(i)*Gs(i) - end do -- - do i = 1, strxe - strxb + 1 -+ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) - ! Elastic contribution to energy if G large enough - !TODO take out if statement if stable without - if ((G_L > 1000) .and. (G_R > 1000)) then -@@ -506,19 +490,57 @@ contains - end do - end if - -+ ! elastic energy update -+ !if ( hyperelasticity ) then -+ ! G_L = 0d0 -+ ! G_R = 0d0 -+ ! -+ ! !$acc loop seq -+ ! do i = 1, num_fluids -+ ! G_L = G_L + alpha_L(i)*Gs(i) -+ ! G_R = G_R + alpha_R(i)*Gs(i) -+ ! end do -+ ! ! Elastic contribution to energy if G large enough -+ ! if ((G_L > 1d-3) .and. (G_R > 1d-3)) then -+ ! E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) -+ ! E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) -+ ! !$acc loop seq -+ ! do i = 1, b_size-1 -+ ! tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ ! tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -+ ! end do -+ ! !$acc loop seq -+ ! do i = 1, b_size-1 -+ ! tau_e_L(i) = 0d0 -+ ! tau_e_R(i) = 0d0 -+ ! end do -+ ! !$acc loop seq -+ ! do i = 1, num_dims -+ ! xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) -+ ! xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) -+ ! end do -+ ! end if -+ !end if -+ -+ ! Enthalpy with elastic energy -+ H_L = (E_L + pres_L)/rho_L -+ H_R = (E_R + pres_R)/rho_R -+ - @:compute_average_state() - - call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & -- vel_L_rms, c_L) -+ vel_L_rms, c_L, Gs) - - call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & -- vel_R_rms, c_R) -+ vel_R_rms, c_R, Gs) - - !> The computation of c_avg does not require all the variables, and therefore the non '_avg' - ! variables are placeholders to call the subroutine. - - call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & -- vel_avg_rms, c_avg) -+ vel_avg_rms, c_avg, Gs) -+ -+ !SGR added Gs to all of the above speed of sound clacs - - if (any(Re_size > 0)) then - !$acc loop seq -@@ -541,6 +563,11 @@ contains - , vel_L(dir_idx(1)) + sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + & - tau_e_L(dir_idx_tau(1)))/rho_L)) -+ else if (hyperelasticity) then -+ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L) & -+ , vel_R(dir_idx(1)) - sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R)) -+ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R) & -+ , vel_L(dir_idx(1)) + sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L)) - else - s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) - s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) -@@ -716,6 +743,18 @@ contains - /(s_M - s_P) - end do - -+ ! Xi field -+ !if ( hyperelasticity ) then -+ ! do i = 1, num_dims -+ ! flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & -+ ! (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & -+ ! - s_P*rho_L*vel_L(dir_idx(1))*xi_field_L(i) & -+ ! + s_M*s_P*(rho_L*xi_field_L(i) & -+ ! - rho_R*xi_field_R(i))) & -+ ! /(s_M - s_P) -+ ! end do -+ !end if -+ - ! Div(U)? - !$acc loop seq - do i = 1, num_dims -@@ -822,7 +861,6 @@ contains - - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf -- - type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf - - type(scalar_field), & -@@ -862,6 +900,11 @@ contains - real(kind(0d0)) :: s_L, s_R, s_M, s_P, s_S - real(kind(0d0)) :: xi_L, xi_R !< Left and right wave speeds functions - real(kind(0d0)) :: xi_M, xi_P -+ real(kind(0d0)) :: xi_MP, xi_PP -+ -+ real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R -+ real(kind(0d0)), dimension(num_dims) :: xi_field_L, xi_field_R -+ real(kind(0d0)) :: G_L, G_R - - real(kind(0d0)) :: nbub_L, nbub_R - real(kind(0d0)), dimension(nb) :: R0_L, R0_R -@@ -880,9 +923,10 @@ contains - real(kind(0d0)) :: vel_L_rms, vel_R_rms, vel_avg_rms - real(kind(0d0)) :: vel_L_tmp, vel_R_tmp - real(kind(0d0)) :: blkmod1, blkmod2 -- real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star -+ real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star, vel_K_Star - real(kind(0d0)) :: pres_SL, pres_SR, Ms_L, Ms_R - real(kind(0d0)) :: start, finish -+ real(kind(0d0)) :: flux_ene_e - real(kind(0d0)) :: zcoef, pcorr !< low Mach number correction - integer :: i, j, k, l, q !< Generic loop iterators - integer :: idx1, idxi -@@ -909,15 +953,16 @@ contains - flux_gsrc_vf, & - norm_dir, ix, iy, iz) - -+ idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 -+ - #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] - - if (norm_dir == ${NORM_DIR}$) then -+ -+ ! 6-EQUATION MODEL WITH HLLC - if (model_eqns == 3) then - !ME3 -- -- !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & -- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R) -- -+ !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R, flux_ene_e, xi_field_L, xi_field_R) - do l = is3%beg, is3%end - do k = is2%beg, is2%end - do j = is1%beg, is1%end -@@ -994,39 +1039,85 @@ contains - !$acc loop seq - do i = 1, 2 - Re_L(i) = dflt_real -- - if (Re_size(i) > 0) Re_L(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q))/Res(i, q) & - + Re_L(i) - end do -- - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) -- - end do - - !$acc loop seq - do i = 1, 2 - Re_R(i) = dflt_real -- - if (Re_size(i) > 0) Re_R(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res(i, q) & - + Re_R(i) - end do -- - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) - end do - end if - - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L -- - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R - -+ ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY -+ if (hypoelasticity) then -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -+ end do -+ G_L = 0d0; G_R = 0d0 -+ !$acc loop seq -+ do i = 1, num_fluids -+ G_L = G_L + alpha_L(i)*Gs(i) -+ G_R = G_R + alpha_R(i)*Gs(i) -+ end do -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ ! Elastic contribution to energy if G large enough -+ if ((G_L > verysmall) .and. (G_R > verysmall)) then -+ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) -+ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) -+ ! Additional terms in 2D and 3D -+ if ((i == 2) .or. (i == 4) .or. (i == 5)) then -+ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) -+ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) -+ end if -+ end if -+ end do -+ end if -+ -+ ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY -+ if (hyperelasticity) then -+ !$acc loop seq -+ do i = 1, num_dims -+ xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) -+ xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) -+ end do -+ G_L = 0d0; G_R = 0d0; -+ !$acc loop seq -+ do i = 1, num_fluids -+ ! Mixture left and right shear modulus -+ G_L = G_L + alpha_L(i)*Gs(i) -+ G_R = G_R + alpha_R(i)*Gs(i) -+ end do -+ ! Elastic contribution to energy if G large enough -+ if ( G_L > verysmall .and. G_R > verysmall ) then -+ E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) -+ E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) -+ end if -+ !$acc loop seq -+ do i = 1, b_size - 1 -+ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -+ end do -+ end if -+ - H_L = (E_L + pres_L)/rho_L - H_R = (E_R + pres_R)/rho_R - -@@ -1034,13 +1125,10 @@ contains - - call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & - vel_L_rms, c_L) -- - call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & - vel_R_rms, c_R) -- - !> The computation of c_avg does not require all the variables, and therefore the non '_avg' - ! variables are placeholders to call the subroutine. -- - call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & - vel_avg_rms, c_avg) - -@@ -1051,222 +1139,226 @@ contains - end do - end if - -+ ! COMPUTING THE DIRECT WAVE SPEEDS - if (wave_speeds == 1) then -- s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) -- s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) -+ if (elasticity) then -+ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & -+ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & -+ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) -+ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & -+ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & -+ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) -+ s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & -+ tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & -+ rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & -+ rho_R*(s_R - vel_R(idx1))) -+ else -+ s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) -+ s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) -+ s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & -+ (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & -+ /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) - -- s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & -- (s_L - vel_L(dir_idx(1))) - & -- rho_R*vel_R(dir_idx(1))* & -- (s_R - vel_R(dir_idx(1)))) & -- /(rho_L*(s_L - vel_L(dir_idx(1))) - & -- rho_R*(s_R - vel_R(dir_idx(1)))) -+ end if - elseif (wave_speeds == 2) then - pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & - (vel_L(dir_idx(1)) - & - vel_R(dir_idx(1)))) -- - pres_SR = pres_SL -- - Ms_L = max(1d0, sqrt(1d0 + ((5d-1 + gamma_L)/(1d0 + gamma_L))* & - (pres_SL/pres_L - 1d0)*pres_L/ & - ((pres_L + pi_inf_L/(1d0 + gamma_L))))) - Ms_R = max(1d0, sqrt(1d0 + ((5d-1 + gamma_R)/(1d0 + gamma_R))* & - (pres_SR/pres_R - 1d0)*pres_R/ & - ((pres_R + pi_inf_R/(1d0 + gamma_R))))) -- - s_L = vel_L(dir_idx(1)) - c_L*Ms_L - s_R = vel_R(dir_idx(1)) + c_R*Ms_R -- - s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & - (pres_L - pres_R)/ & - (rho_avg*c_avg)) - end if - -- if (s_L >= 0d0) then -- p_Star = pres_L ! Only useful to recalculate the radial momentum geometric source flux -- !$acc loop seq -- do i = 1, num_fluids -- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)*s_S -+ ! follows Einfeldt et al. -+ ! s_M/P = min/max(0.,s_L/R) -+ s_M = min(0d0, s_L); s_P = max(0d0, s_R) - -- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)*vel_L(dir_idx(1)) -+ ! goes with q_star_L/R = xi_L/R * (variable) -+ ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) ) -+ xi_L = (s_L - vel_L(idx1))/(s_L - s_S) -+ xi_R = (s_R - vel_R(idx1))/(s_R - s_S) - -- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & -- (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & -- (gammas(i)*pres_L + pi_infs(i)) + & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & -- qvs(i))*vel_L(dir_idx(1)) -- end do -- !$acc loop seq -- do i = 1, num_dims -- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & -- rho_L*vel_L(dir_idx(1))*vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*pres_L -+ ! goes with numerical star velocity in x/y/z directions -+ ! xi_P/M = 0.5 +/m sgn(0.5,s_star) -+ xi_M = (5d-1 + sign(5d-1, s_S)) -+ xi_P = (5d-1 - sign(5d-1, s_S)) - -- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & -- dir_flg(dir_idx(i))*(s_S - vel_L(dir_idx(i))) -- ! Compute the star velocities for the non-conservative terms -- end do -- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_L + pres_L)*vel_L(dir_idx(1)) -+ ! goes with the numerical velocity in x/y/z directions -+ ! xi_P/M (pressure) = min/max(0. sgn(1,sL/sR)) -+ xi_MP = -min(0d0, sign(1d0, s_L)) -+ xi_PP = max(0d0, sign(1d0, s_R)) - -- if (.not. f_is_default(sigma)) then -- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, c_idx)*s_S -- end if -+ ! COMPUTING FLUXES -+ ! MASS FLUX. -+ !$acc loop seq -+ do i = 1, contxe -+ flux_rs${XYZ}$_vf(j, k, l, i) = & -+ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & -+ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) -+ end do - -- ! Compute right solution state -- else if (s_R <= 0d0) then -- p_Star = pres_R -- ! Only useful to recalculate the radial momentum geometric source flux -- !$acc loop seq -- do i = 1, num_fluids -- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)*s_S -+ ! MOMENTUM FLUX. -+ ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) -+ !$acc loop seq -+ do i = 1, num_dims -+ !idxi = dir_idx(i) -+ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & -+ xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & -+ (1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & -+ xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & -+ (1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) -+ end do - -- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)*vel_R(dir_idx(1)) -+ ! ENERGY FLUX. -+ ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) -+ flux_rs${XYZ}$_vf(j, k, l, E_idx) = & -+ xi_M*(vel_L(idx1)*(E_L + pres_L) + & -+ s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & -+ + xi_P*(vel_R(idx1)*(E_R + pres_R) + & -+ s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) -+ -+ ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux -+ if (elasticity) then -+ flux_ene_e = 0d0; -+ !$acc loop seq -+ do i = 1, num_dims -+ ! MOMENTUM ELASTIC FLUX. -+ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & -+ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) & -+ - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) -+ ! ENERGY ELASTIC FLUX. -+ flux_ene_e = flux_ene_e - & -+ xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & -+ s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & -+ xi_P*(vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & -+ s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) -+ end do -+ flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e -+ end if - -- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & -- (qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)* & -- (gammas(i)*pres_R + pi_infs(i)) + & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)* & -- qvs(i))*vel_R(dir_idx(1)) -- end do -- !$acc loop seq -- do i = 1, num_dims -- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & -- rho_R*vel_R(dir_idx(1))*vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*pres_R -+ ! VOLUME FRACTION FLUX. -+ !$acc loop seq -+ do i = advxb, advxe -+ flux_rs${XYZ}$_vf(j, k, l, i) = & -+ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*s_S + & -+ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*s_S -+ end do - -- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & -- dir_flg(dir_idx(i))*(s_S - vel_R(dir_idx(i))) -- ! Compute the star velocities for the non-conservative terms -- end do -- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_R + pres_R)*vel_R(dir_idx(1)) -+ ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. -+ !$acc loop seq -+ do i = 1, num_dims -+ !idxi = dir_idx(i) -+ vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = & -+ xi_M*(vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_MP*(xi_L - 1) + 1) - vel_L(dir_idx(i)))) + & -+ xi_P*(vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(dir_idx(i)))) -+ end do - -- if (.not. f_is_default(sigma)) then -- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx)*s_S -- end if -+ ! INTERNAL ENERGIES ADVECTION FLUX. -+ ! K-th pressure and velocity in preparation for the internal energy flux -+ vel_K_Star = vel_L(idx1)*(1d0 - xi_MP) + xi_MP*vel_R(idx1) + & -+ xi_MP*xi_PP*(s_S - vel_R(idx1)) -+ !$acc loop seq -+ do i = 1, num_fluids -+ p_K_Star = xi_M*(xi_MP*((pres_L + pi_infs(i)/(1d0 + gammas(i)))* & -+ xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - pres_L) + pres_L) + & -+ xi_P*(xi_PP*((pres_R + pi_infs(i)/(1d0 + gammas(i)))* & -+ xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - pres_R) + pres_R) -+ -+ flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & -+ (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & -+ (gammas(i)*p_K_Star + pi_infs(i)) + & -+ qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & -+ qvs(i))*vel_K_Star -+ end do - -- ! Compute left star solution state -- else if (s_S >= 0d0) then -- xi_L = (s_L - vel_L(dir_idx(1)))/(s_L - s_S) -- rho_Star = rho_L*xi_L -- E_Star = xi_L*(E_L + (s_S - vel_L(dir_idx(1)))* & -- (rho_L*s_S + pres_L/(s_L - vel_L(dir_idx(1))))) -- p_Star = rho_L*(s_L - vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1))) + pres_L -- !$acc loop seq -- do i = 1, num_fluids -- p_K_Star = (pres_L + pi_infs(i)/(1d0 + gammas(i)))* & -- xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) -+ flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) - -- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)*s_S -+ ! HYPOELASTIC STRESS EVOLUTION FLUX. -+ if (hypoelasticity) then -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & -+ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & -+ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) -+ end do -+ end if - -- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)*xi_L*s_S -+ ! REFERENCE MAP FLUX. -+ if (hyperelasticity) then -+ !$acc loop seq -+ do i = 1, num_dims -+ flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & -+ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*xi_field_L(i) & -+ - rho_L*vel_L(idx1)*xi_field_L(i)) + & -+ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*xi_field_R(i) & -+ - rho_R*vel_R(idx1)*xi_field_R(i)) -+ end do -+ end if - -- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & -- (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & -- (gammas(i)*p_K_Star + pi_infs(i)) + & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & -- qvs(i))*s_S -- end do -- !$acc loop seq -- do i = 1, num_dims -- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & -- rho_Star*s_S*(s_S*dir_flg(dir_idx(i)) + vel_L(dir_idx(i))* & -- (1d0 - dir_flg(dir_idx(i)))) + dir_flg(dir_idx(i))*p_Star -+ ! SURFACE TENSION FLUX. need to check -+ if (.not. f_is_default(sigma)) then -+ flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -+ (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & -+ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S -+ end if - -- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & -- dir_flg(dir_idx(i))*(s_S*xi_L - vel_L(dir_idx(i))) -- ! Compute the star velocities for the non-conservative terms -- end do -- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_Star + p_Star)*s_S -+ ! correction pressure for the cylindrical terms -+ p_Star = xi_M*(pres_L + xi_MP*rho_L*(s_L - & -+ vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1)))) + & -+ xi_P*(pres_R + xi_PP*rho_R*(s_R - & -+ vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1)))) - -- if (.not. f_is_default(sigma)) then -- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, c_idx)*s_S -+ ! Geometrical source flux for cylindrical coordinates -+ #:if (NORM_DIR == 2) -+ if (cyl_coord) then -+ !Substituting the advective flux into the inviscid geometrical source flux -+ !$acc loop seq -+ do i = 1, E_idx -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) -+ end do -+ !$acc loop seq -+ do i = intxb, intxe -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) -+ end do -+ ! Recalculating the radial momentum geometric source flux -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star -+ ! Geometrical source of the void fraction(s) is zero -+ !$acc loop seq -+ do i = advxb, advxe -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 -+ end do - end if -+ #:endif -+ #:if (NORM_DIR == 3) -+ if (grid_geometry == 3) then -+ !$acc loop seq -+ do i = 1, sys_size -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 -+ end do -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star - -- ! Compute right star solution state -- else -- xi_R = (s_R - vel_R(dir_idx(1)))/(s_R - s_S) -- -- rho_Star = rho_R*xi_R -- -- E_Star = xi_R*(E_R + (s_S - vel_R(dir_idx(1)))* & -- (rho_R*s_S + pres_R/(s_R - vel_R(dir_idx(1))))) -- -- p_Star = rho_R*(s_R - vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1))) + pres_R -- !$acc loop seq -- do i = 1, num_fluids -- p_K_Star = (pres_R + pi_infs(i)/(1d0 + gammas(i)))* & -- xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) -- -- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)*s_S -- -- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)*xi_R*s_S -- -- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & -- (qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)* & -- (gammas(i)*p_K_Star + pi_infs(i)) + & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)* & -- qvs(i))*s_S -- end do -- !$acc loop seq -- do i = 1, num_dims -- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = rho_Star*s_S* & -- (s_S*dir_flg(dir_idx(i)) + vel_R(dir_idx(i))*(1d0 - dir_flg(dir_idx(i)))) + & -- dir_flg(dir_idx(i))*p_Star -- -- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & -- dir_flg(dir_idx(i))*(s_S*xi_R - vel_R(dir_idx(i))) -- ! Compute the star velocities for the non-conservative terms -- end do -- -- if (.not. f_is_default(sigma)) then -- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx)*s_S -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) - end if -- -- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_Star + p_Star)*s_S -- -- end if -- -- flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) -- -- ! Geometrical source flux for cylindrical coordinates -- if (cyl_coord .and. norm_dir == 2) then -- ! Substituting the advective flux into the inviscid geometrical source flux -- !$acc loop seq -- do i = 1, E_idx -- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) -- end do -- !$acc loop seq -- do i = intxb, intxe -- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) -- end do -- ! Recalculating the radial momentum geometric source flux (subtracting the pressure part) -- flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & -- flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star -- ! Geometrical source of the void fraction(s) is zero -- !$acc loop seq -- do i = advxb, advxe -- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 -- end do -- end if -+ #:endif - - end do - end do - end do -+ - elseif (model_eqns == 4) then - !ME4 -- !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, & -- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) -+ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) - do l = is3%beg, is3%end - do k = is2%beg, is2%end - do j = is1%beg, is1%end -@@ -1632,11 +1724,11 @@ contains - end if - - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms -- - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms - - H_L = (E_L + pres_L)/rho_L - H_R = (E_R + pres_R)/rho_R -+ - if (avg_state == 2) then - !$acc loop seq - do i = 1, nb -@@ -1749,13 +1841,11 @@ contains - - call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & - vel_L_rms, c_L) -- - call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & - vel_R_rms, c_R) - - !> The computation of c_avg does not require all the variables, and therefore the non '_avg' - ! variables are placeholders to call the subroutine. -- - call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & - vel_avg_rms, c_avg) - -@@ -1861,7 +1951,6 @@ contains - - ! Energy flux. - ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) -- - flux_rs${XYZ}$_vf(j, k, l, E_idx) = & - xi_M*(vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) + & - s_M*(xi_L*(E_L + (s_S - vel_L(dir_idx(1)))* & -@@ -1874,7 +1963,6 @@ contains - + (s_M/s_L)*(s_P/s_R)*pcorr*s_S - - ! Volume fraction flux -- - !$acc loop seq - do i = advxb, advxe - flux_rs${XYZ}$_vf(j, k, l, i) = & -@@ -1980,8 +2068,10 @@ contains - end do - !$acc end parallel loop - else -+ ! 5-EQUATION MODEL WITH HLLC, INTERFACE CAPTURING ONLY - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & -- !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp) copyin(is1,is2,is3) -+ !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, & -+ !$acc tau_e_L, tau_e_R, xi_field_L, xi_field_R, vel_L_tmp, vel_R_tmp) copyin(is1,is2,is3) - do l = is3%beg, is3%end - do k = is2%beg, is2%end - do j = is1%beg, is1%end -@@ -2064,39 +2154,85 @@ contains - !$acc loop seq - do i = 1, 2 - Re_L(i) = dflt_real -- - if (Re_size(i) > 0) Re_L(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q))/Res(i, q) & - + Re_L(i) - end do -- - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) -- - end do - - !$acc loop seq - do i = 1, 2 - Re_R(i) = dflt_real -- - if (Re_size(i) > 0) Re_R(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res(i, q) & - + Re_R(i) - end do -- - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) - end do - end if - - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L -- - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R - -+ ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY -+ if (hypoelasticity) then -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -+ end do -+ G_L = 0d0; G_R = 0d0 -+ !$acc loop seq -+ do i = 1, num_fluids -+ G_L = G_L + alpha_L(i)*Gs(i) -+ G_R = G_R + alpha_R(i)*Gs(i) -+ end do -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ ! Elastic contribution to energy if G large enough -+ if ((G_L > verysmall) .and. (G_R > verysmall)) then -+ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) -+ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) -+ ! Additional terms in 2D and 3D -+ if ((i == 2) .or. (i == 4) .or. (i == 5)) then -+ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) -+ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) -+ end if -+ end if -+ end do -+ end if -+ -+ ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY -+ if (hyperelasticity) then -+ !$acc loop seq -+ do i = 1, num_dims -+ xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) -+ xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) -+ end do -+ G_L = 0d0; G_R = 0d0; -+ !$acc loop seq -+ do i = 1, num_fluids -+ ! Mixture left and right shear modulus -+ G_L = G_L + alpha_L(i)*Gs(i) -+ G_R = G_R + alpha_R(i)*Gs(i) -+ end do -+ ! Elastic contribution to energy if G large enough -+ if ( G_L > verysmall .and. G_R > verysmall ) then -+ E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) -+ E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) -+ end if -+ !$acc loop seq -+ do i = 1, b_size - 1 -+ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -+ end do -+ end if -+ - H_L = (E_L + pres_L)/rho_L - H_R = (E_R + pres_R)/rho_R - -@@ -2110,7 +2246,6 @@ contains - - !> The computation of c_avg does not require all the variables, and therefore the non '_avg' - ! variables are placeholders to call the subroutine. -- - call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & - vel_avg_rms, c_avg) - -@@ -2126,16 +2261,25 @@ contains - end if - - if (wave_speeds == 1) then -- s_L = min(vel_L(idx1) - c_L, vel_R(idx1) - c_R) -- s_R = max(vel_R(idx1) + c_R, vel_L(idx1) + c_L) -- -- s_S = (pres_R - pres_L + rho_L*vel_L(idx1)* & -- (s_L - vel_L(idx1)) - & -- rho_R*vel_R(idx1)* & -- (s_R - vel_R(idx1))) & -- /(rho_L*(s_L - vel_L(idx1)) - & -- rho_R*(s_R - vel_R(idx1))) -+ if (elasticity) then -+ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & -+ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & -+ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) -+ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & -+ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & -+ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) -+ s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & -+ tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & -+ rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & -+ rho_R*(s_R - vel_R(idx1))) -+ else -+ s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) -+ s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) -+ s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & -+ (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & -+ /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) - -+ end if - elseif (wave_speeds == 2) then - pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & - (vel_L(idx1) - & -@@ -2172,6 +2316,8 @@ contains - xi_M = (5d-1 + sign(5d-1, s_S)) - xi_P = (5d-1 - sign(5d-1, s_S)) - -+ ! COMPUTING THE HLLC FLUXES -+ ! MASS FLUX. - if (low_Mach == 1) then - @:compute_low_Mach_correction() - else -@@ -2181,75 +2327,88 @@ contains - !$acc loop seq - do i = 1, contxe - flux_rs${XYZ}$_vf(j, k, l, i) = & -- xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & -- *(vel_L(idx1) + s_M*(xi_L - 1d0)) & -- + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & -- *(vel_R(idx1) + s_P*(xi_R - 1d0)) -+ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & -+ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) - end do - -- ! Momentum flux. -- ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w) -- !$acc loop seq -+ ! MOMENTUM FLUX. -+ ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) -+ !$acc loop seq - do i = 1, num_dims -- idxi = dir_idx(i) -- flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & -- xi_M*(rho_L*(vel_L(idx1)* & -- vel_L(idxi) + & -- s_M*(xi_L*(dir_flg(idxi)*s_S + & -- (1d0 - dir_flg(idxi))* & -- vel_L(idxi)) - vel_L(idxi))) + & -- dir_flg(idxi)*(pres_L)) & -- + xi_P*(rho_R*(vel_R(idx1)* & -- vel_R(idxi) + & -- s_P*(xi_R*(dir_flg(idxi)*s_S + & -- (1d0 - dir_flg(idxi))* & -- vel_R(idxi)) - vel_R(idxi))) + & -- dir_flg(idxi)*(pres_R)) & -- + (s_M/s_L)*(s_P/s_R)*dir_flg(idxi)*pcorr -+ !idxi = dir_idx(i) -+ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & -+ xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & -+ (1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & -+ xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & -+ (1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) & -+ + (s_M/s_L)*(s_P/s_R)*dir_flg(dir_idx(i))*pcorr - end do - -- ! Energy flux. -- ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) -+ ! ENERGY FLUX. -+ ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) - flux_rs${XYZ}$_vf(j, k, l, E_idx) = & - xi_M*(vel_L(idx1)*(E_L + pres_L) + & -- s_M*(xi_L*(E_L + (s_S - vel_L(idx1))* & -- (rho_L*s_S + pres_L/ & -- (s_L - vel_L(idx1)))) - E_L)) & -+ s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & - + xi_P*(vel_R(idx1)*(E_R + pres_R) + & -- s_P*(xi_R*(E_R + (s_S - vel_R(idx1))* & -- (rho_R*s_S + pres_R/ & -- (s_R - vel_R(idx1)))) - E_R)) & -+ s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) & - + (s_M/s_L)*(s_P/s_R)*pcorr*s_S - -- ! Volume fraction flux -+ ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux -+ if (elasticity) then -+ flux_ene_e = 0d0; -+ !$acc loop seq -+ do i = 1, num_dims -+ ! MOMENTUM ELASTIC FLUX. -+ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & -+ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) & -+ - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) -+ ! ENERGY ELASTIC FLUX. -+ flux_ene_e = flux_ene_e - & -+ xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & -+ s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & -+ xi_P*(vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & -+ s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) -+ end do -+ flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e -+ end if -+ -+ ! HYPOELASTIC STRESS EVOLUTION FLUX. -+ if (hypoelasticity) then -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & -+ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & -+ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) -+ end do -+ end if -+ -+ ! VOLUME FRACTION FLUX. - !$acc loop seq - do i = advxb, advxe -- flux_rs${XYZ}$_vf(j, k, l, i) = & -- xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & -- *(vel_L(idx1) + s_M*(xi_L - 1d0)) & -- + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & -- *(vel_R(idx1) + s_P*(xi_R - 1d0)) -+ flux_rs${XYZ}$_vf(j, k, l, i) = & -+ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & -+ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) - end do - -- ! Source for volume fraction advection equation -+ ! VOLUME FRACTION SOURCE FLUX. - !$acc loop seq - do i = 1, num_dims - idxi = dir_idx(i) - vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & -- xi_M*(vel_L(idxi) + & -- dir_flg(idxi)* & -- s_M*(xi_L - 1d0)) & -- + xi_P*(vel_R(idxi) + & -- dir_flg(idxi)* & -- s_P*(xi_R - 1d0)) -- -- !if ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0d0 -+ xi_M*(vel_L(idxi) + dir_flg(idxi)*s_M*(xi_L - 1d0)) + & -+ xi_P*(vel_R(idxi) + dir_flg(idxi)*s_P*(xi_R - 1d0)) - end do - - flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) - -- ! Geometrical source flux for cylindrical coordinates -+ ! SURFACE TENSION FLUX. need to check -+ !if (.not. f_is_default(sigma)) then -+ ! flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -+ ! (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & -+ ! xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S -+ !end if - -+ ! Geometrical source flux for cylindrical coordinates - #:if (NORM_DIR == 2) - if (cyl_coord) then - !Substituting the advective flux into the inviscid geometrical source flux -@@ -2544,7 +2703,7 @@ contains - - !$acc update device(is1, is2, is3) - -- if (hypoelasticity) then -+ if (elasticity) then - if (norm_dir == 1) then - dir_idx_tau = (/1, 2, 4/) - else if (norm_dir == 2) then -diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp -index 5e1c6f6e..10158e8e 100644 ---- a/src/simulation/m_start_up.fpp -+++ b/src/simulation/m_start_up.fpp -@@ -46,9 +46,10 @@ module m_start_up - - use m_derived_variables !< Procedures used to compute quantities derived - !! from the conservative and primitive variables -- - use m_hypoelastic - -+ use m_hyperelastic -+ - use m_phase_change !< Phase-change module - - use m_viscous -@@ -139,6 +140,7 @@ contains - teno_CT, mp_weno, weno_avg, & - riemann_solver, low_Mach, wave_speeds, avg_state, & - bc_x, bc_y, bc_z, & -+ x_a, y_a, z_a, x_b, y_b, z_b, & - x_domain, y_domain, z_domain, & - hypoelasticity, & - ib, num_ibs, patch_ib, & -@@ -146,8 +148,8 @@ contains - fd_order, probe, num_probes, t_step_old, & - alt_soundspeed, mixture_err, weno_Re_flux, & - null_weights, precision, parallel_io, cyl_coord, & -- rhoref, pref, bubbles, bubble_model, & -- R0ref, & -+ rhoref, pref, bubbles, bubble_model, & -+ - #:if not MFC_CASE_OPTIMIZATION - nb, mapped_weno, wenoz, teno, weno_order, num_fluids, & - #:endif -@@ -161,7 +163,7 @@ contains - R0_type, file_per_process, sigma, & - pi_fac, adv_n, adap_dt, bf_x, bf_y, bf_z, & - k_x, k_y, k_z, w_x, w_y, w_z, p_x, p_y, p_z, & -- g_x, g_y, g_z -+ g_x, g_y, g_z, hyperelasticity, R0ref - - ! Checking that an input file has been provided by the user. If it - ! has, then the input file is read in, otherwise, simulation exits. -@@ -359,7 +361,7 @@ contains - end if - end do - -- if ((bubbles .eqv. .true.) .or. (hypoelasticity .eqv. .true.)) then -+ if ((bubbles .eqv. .true.) .or. (elasticity .eqv. .true.)) then - ! Read pb and mv for non-polytropic qbmm - if (qbmm .and. .not. polytropic) then - do i = 1, nb -@@ -589,7 +591,7 @@ contains - NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) - - ! Read the data for each variable -- if (bubbles .or. hypoelasticity) then -+ if ( bubbles .or. elasticity ) then - - do i = 1, sys_size!adv_idx%end - var_MOK = int(i, MPI_OFFSET_KIND) -@@ -614,6 +616,7 @@ contains - MPI_DOUBLE_PRECISION, status, ierr) - end do - end if -+ - - call s_mpi_barrier() - -@@ -679,9 +682,9 @@ contains - NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) - - ! Read the data for each variable -- if (bubbles .or. hypoelasticity) then -+ if ( bubbles .or. elasticity ) then - -- do i = 1, sys_size!adv_idx%end -+ do i = 1, sys_size !adv_idx%end - var_MOK = int(i, MPI_OFFSET_KIND) - ! Initial displacement to skip at beginning of file - disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) -@@ -1120,7 +1123,7 @@ contains - ! Time-stepping loop controls - if ((mytime + dt) >= finaltime) dt = finaltime - mytime - t_step = t_step + 1 -- -+ - end subroutine s_perform_time_step - - subroutine s_save_performance_metrics(t_step, time_avg, time_final, io_time_avg, io_time_final, proc_time, io_proc_time, file_exists, start, finish, nt) -@@ -1272,7 +1275,6 @@ contains - call acc_present_dump() - #endif - -- if (hypoelasticity) call s_initialize_hypoelastic_module() - if (relax) call s_initialize_phasechange_module() - call s_initialize_data_output_module() - call s_initialize_derived_variables_module() -@@ -1312,9 +1314,11 @@ contains - #endif - - call s_initialize_cbc_module() -- - call s_initialize_derived_variables() - -+ if (hypoelasticity) call s_initialize_hypoelastic_module() -+ if (hyperelasticity) call s_initialize_hyperelastic_module() -+ - end subroutine s_initialize_modules - - subroutine s_initialize_mpi_domain -@@ -1395,6 +1399,7 @@ contains - do i = 1, sys_size - !$acc update device(q_cons_ts(1)%vf(i)%sf) - end do -+ - if (qbmm .and. .not. polytropic) then - !$acc update device(pb_ts(1)%sf, mv_ts(1)%sf) - end if -@@ -1410,7 +1415,6 @@ contains - !$acc update device(bc_y%vb1, bc_y%vb2, bc_y%vb3, bc_y%ve1, bc_y%ve2, bc_y%ve3) - !$acc update device(bc_z%vb1, bc_z%vb2, bc_z%vb3, bc_z%ve1, bc_z%ve2, bc_z%ve3) - -- - !$acc update device(relax, relax_model) - if (relax) then - !$acc update device(palpha_eps, ptgalpha_eps) -@@ -1428,6 +1432,8 @@ contains - s_write_data_files => null() - - call s_finalize_time_steppers_module() -+ if (hypoelasticity) call s_finalize_hypoelastic_module() -+ if (hyperelasticity) call s_finalize_hyperelastic_module() - call s_finalize_derived_variables_module() - call s_finalize_data_output_module() - call s_finalize_rhs_module() -diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp -index 2e9ca8fe..b5faba05 100644 ---- a/src/simulation/m_surface_tension.fpp -+++ b/src/simulation/m_surface_tension.fpp -@@ -1,7 +1,7 @@ - #:include 'macros.fpp' - #:include 'inline_capillary.fpp' - --!> @brief This module is used to compute source terms for hypoelastic model -+!> @brief This module is used to compute source terms for surface tension model - module m_surface_tension - - ! Dependencies ============================================================= -diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp -index d34c1fc0..b940bdc8 100644 ---- a/src/simulation/m_time_steppers.fpp -+++ b/src/simulation/m_time_steppers.fpp -@@ -25,6 +25,8 @@ module m_time_steppers - - use m_ibm - -+ use m_hyperelastic -+ - use m_mpi_proxy !< Message passing interface (MPI) module proxy - - use m_boundary_conditions -@@ -181,8 +183,7 @@ contains - end if - end if - -- if (hypoelasticity) then -- -+ if (elasticity) then - do i = stress_idx%beg, stress_idx%end - @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & - iy_t%beg:iy_t%end, & -@@ -191,6 +192,15 @@ contains - end do - end if - -+ if (hyperelasticity) then -+ do i = xibeg, xiend + 1 -+ @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & -+ iy_t%beg:iy_t%end, & -+ iz_t%beg:iz_t%end)) -+ @:ACC_SETUP_SFs(q_prim_vf(i)) -+ end do -+ end if -+ - if (model_eqns == 3) then - do i = internalEnergies_idx%beg, internalEnergies_idx%end - @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & -@@ -812,6 +822,10 @@ contains - call s_pressure_relaxation_procedure(q_cons_ts(1)%vf) - end if - -+ call nvtxStartRange("RHS-ELASTIC") -+ if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_ts(1)%vf, q_prim_vf) -+ call nvtxEndRange -+ - if (adv_n) call s_comp_alpha_from_n(q_cons_ts(1)%vf) - - if (ib) then -@@ -829,7 +843,6 @@ contains - time = time + (finish - start) - end if - ! ================================================================== -- - end subroutine s_3rd_order_tvd_rk - - !> Strang splitting scheme with 3rd order TVD RK time-stepping algorithm for -@@ -959,6 +972,7 @@ contains - end if - - end subroutine s_time_step_cycling -+ - !> Module deallocation and/or disassociation procedures - subroutine s_finalize_time_steppers_module - -@@ -993,12 +1007,18 @@ contains - @:DEALLOCATE(q_prim_vf(i)%sf) - end do - -- if (hypoelasticity) then -+ if (elasticity) then - do i = stress_idx%beg, stress_idx%end - @:DEALLOCATE(q_prim_vf(i)%sf) - end do - end if - -+ if (hyperelasticity) then -+ do i = xibeg, xiend + 1 -+ @:DEALLOCATE(q_prim_vf(i)%sf) -+ end do -+ end if -+ - if (bubbles) then - do i = bub_idx%beg, bub_idx%end - @:DEALLOCATE(q_prim_vf(i)%sf) -diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp -index 0019779e..5bdf4b84 100644 ---- a/src/simulation/m_viscous.fpp -+++ b/src/simulation/m_viscous.fpp -@@ -12,8 +12,6 @@ module m_viscous - use m_global_parameters !< Definitions of the global parameters - - use m_weno -- -- use m_helper - ! ========================================================================== - - private; public s_get_viscous, & -diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp -index 3f0e885c..8fc4523f 100644 ---- a/src/simulation/p_main.fpp -+++ b/src/simulation/p_main.fpp -@@ -36,7 +36,6 @@ program p_main - - !Initialize MPI - call s_initialize_mpi_domain() -- - !Initialize Modules - call s_initialize_modules() - -@@ -56,7 +55,7 @@ program p_main - - ! Time-stepping Loop ======================================================= - do -- if (t_step == t_step_stop) then -+ if (t_step > t_step_stop) then - call s_save_performance_metrics(t_step, time_avg, time_final, io_time_avg, & - io_time_final, proc_time, io_proc_time, file_exists, start, finish, nt) - exit -@@ -65,7 +64,7 @@ program p_main - call s_perform_time_step(t_step, time_avg, time_final, io_time_avg, io_time_final, & - proc_time, io_proc_time, file_exists, start, finish, nt) - -- if (mod(t_step - t_step_start, t_step_save) == 0 .or. t_step == t_step_stop) then -+ if (mod(t_step - t_step_start, t_step_save) == 0 .or. t_step > t_step_stop) then - call s_save_data(t_step, start, finish, io_time_avg, nt) - end if - -diff --git a/submit_gpu.sh b/submit_gpu.sh -new file mode 100755 -index 00000000..b29b29be ---- /dev/null -+++ b/submit_gpu.sh -@@ -0,0 +1,49 @@ -+#!/bin/bash -+ -+### A100s -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwex_pre -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta -+ -+### A40s -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwex_pre -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# test -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 03:00:00 -# test_sim -t simulation -a bciv-delta-gpu -c delta -+ -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# bwex_post -t post_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# test_post -t post_process -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 02:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -+ -+./mfc.sh run tests/6954E28B/case.py -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -+./mfc.sh run tests/6954E28B/case.py -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -+ -diff --git a/submit_hyper.sh b/submit_hyper.sh -new file mode 100755 -index 00000000..ba197a99 ---- /dev/null -+++ b/submit_hyper.sh -@@ -0,0 +1,7 @@ -+#!/bin/bash -+ -+./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -+./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -+ -+ -diff --git a/submit_pc.sh b/submit_pc.sh -new file mode 100755 -index 00000000..e45b98db ---- /dev/null -+++ b/submit_pc.sh -@@ -0,0 +1,9 @@ -+#!/bin/bash -+ -+#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -+#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -+ -+./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t pre_process -c delta -+./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t simulation -c delta -+ -diff --git a/submit_test.sh b/submit_test.sh -new file mode 100755 -index 00000000..69b80bbe ---- /dev/null -+++ b/submit_test.sh -@@ -0,0 +1,52 @@ -+#!/bin/bash -+ -+#./mfc.sh run ./examples/3D_phasechange_bubble/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -+#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -+#./mfc.sh run ./examples/3D_phasechange_bubble/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+ -+#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -+#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -+#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+ -+#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -+#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -+#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+ -+#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 00:10:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 04:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.3/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 01:00:00 -# pre_bubingel -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# sim_bubingel -t simulation -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# pre_bubinwater -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# sim_bubinwater -t simulation -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -+./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+ -+ -+#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -+#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 02:00:00 -# test1 -t simulation -c oscar -+#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar -+ -+ -+#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/finalruns/elcom/bubliq/25wv/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/finalruns/elcom/bubliq/75wv/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+ -diff --git a/toolchain/bootstrap/docker.sh b/toolchain/bootstrap/docker.sh -index 73e61372..60e34d92 100644 ---- a/toolchain/bootstrap/docker.sh -+++ b/toolchain/bootstrap/docker.sh -@@ -30,4 +30,4 @@ if (($?)); then - error "Error running Docker container with $@." - - exit 1 --fi -\ No newline at end of file -+fi -diff --git a/toolchain/bootstrap/modules.sh b/toolchain/bootstrap/modules.sh -index 097dca13..b437157f 100644 ---- a/toolchain/bootstrap/modules.sh -+++ b/toolchain/bootstrap/modules.sh -@@ -23,8 +23,9 @@ if [ -v $u_c ]; then - log "$C""ACCESS$W: Bridges2 (b) | Expanse (e) | Delta (d)" - log "$Y""Gatech$W: Phoenix (p)" - log "$R""Caltech$W: Richardson (r)" -+ log "$BR""Brown$W: Oscar (o)" - log "$B""DoD$W: Carpenter (c) | Nautilus (n)" -- log_n "($G""a$W/$G""f$W/$G""s$W/$G""w$W/$C""b$W/$C""e$CR/$C""d$CR/$Y""p$CR/$R""r$CR/$B""c$CR/$B""n$CR): " -+ log_n "($G""a$W/$G""f$W/$G""s$W/$G""w$W/$C""b$W/$C""e$CR/$C""d$CR/$Y""p$CR/$R""r$CR/$B""c$CR/$B""n$CR/$BR""o"$CR"): " - read u_c - log - fi -diff --git a/toolchain/mfc/bench.py b/toolchain/mfc/bench.py -index 52792f26..98e34309 100644 ---- a/toolchain/mfc/bench.py -+++ b/toolchain/mfc/bench.py -@@ -16,7 +16,6 @@ class BenchCase: - path: str - args: typing.List[str] - -- - def bench(targets = None): - if targets is None: - targets = ARG("targets") -diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py -index b39507d3..88eb7b00 100644 ---- a/toolchain/mfc/run/case_dicts.py -+++ b/toolchain/mfc/run/case_dicts.py -@@ -19,6 +19,7 @@ class ParamType(Enum): - - COMMON = { - 'hypoelasticity': ParamType.LOG, -+ 'hyperelasticity': ParamType.LOG, - 'cyl_coord': ParamType.LOG, - 'pref': ParamType.REAL, - 'p': ParamType.INT, -@@ -47,6 +48,7 @@ COMMON = { - 'relax_model': ParamType.INT, - 'sigma': ParamType.REAL, - 'adv_n': ParamType.LOG, -+ 'hyperelasticity': ParamType.LOG, - } - - PRE_PROCESS = COMMON.copy() -@@ -75,6 +77,7 @@ PRE_PROCESS.update({ - 'pi_fac': ParamType.REAL, - 'ib': ParamType.LOG, - 'num_ibs': ParamType.INT, -+ 'pre_stress': ParamType.LOG, - }) - - for ib_id in range(1, 10+1): -@@ -107,14 +110,16 @@ for f_id in range(1, 10+1): - "mu_v", "k_v", "G", "cv", "qv", "qvp" ]: - PRE_PROCESS[f"fluid_pp({f_id})%{real_attr}"] = ParamType.REAL - --for p_id in range(1, 10+1): -+for p_id in range(1, 10+4): - for attribute, ty in [("geometry", ParamType.INT), ("smoothen", ParamType.LOG), - ("smooth_patch_id", ParamType.INT), ("hcid", ParamType.INT)]: - PRE_PROCESS[f"patch_icpp({p_id})%{attribute}"] = ty - -- for real_attr in ["radius", "radii", "epsilon", "beta", "normal", "alpha_rho", -- "smooth_coeff", "rho", "vel", "alpha", "gamma", -+ for real_attr in ["radius", "radii", "epsilon", "beta", "normal", "alpha_rho", "a2", -+ "a3", "a4", "a5", "a6", "a7","a8", "a9", "a10", "a11", "a12", 'non_axis_sym', -+ "normal", "smooth_coeff", "rho", "vel", "pres", "alpha", "gamma", - "pi_inf", "r0", "v0", "p0", "m0", "cv", "qv", "qvp", "cf_val"]: -+ - PRE_PROCESS[f"patch_icpp({p_id})%{real_attr}"] = ParamType.REAL - PRE_PROCESS[f"patch_icpp({p_id})%pres"] = ParamType.REAL.analytic() - -@@ -279,7 +284,6 @@ for f_id in range(1,10+1): - SIMULATION[f"integral({int_id})%{cmp}min"] = ParamType.REAL - SIMULATION[f"integral({int_id})%{cmp}max"] = ParamType.REAL - -- - # Removed: 'fourier_modes%beg', 'fourier_modes%end', 'chem_wrt' - # Feel free to return them if they are needed once more. - POST_PROCESS = COMMON.copy() -@@ -314,6 +318,7 @@ POST_PROCESS.update({ - 'qbmm': ParamType.LOG, - 'qm_wrt': ParamType.LOG, - 'cf_wrt': ParamType.LOG, -+ 'sim_data': ParamType.LOG, - 'ib': ParamType.LOG - }) - -diff --git a/toolchain/modules b/toolchain/modules -index 178d9966..bc0566a3 100644 ---- a/toolchain/modules -+++ b/toolchain/modules -@@ -60,6 +60,12 @@ d-cpu gcc/11.4.0 openmpi - d-gpu nvhpc/22.11 openmpi+cuda/4.1.5+cuda cmake - d-gpu CC=nvc CXX=nvc++ FC=nvfortran - -+o Brown Oscar -+o-all python -+o-cpu hpcx-mpi -+o-gpu nvhpc cuda/12.3.0 cmake/3.26.3 -+o-gpu CC=nvc CXX=nvc++ FC=nvfortran -+ - c DoD Carpenter - c-all python/3.12.1 - c-cpu compiler-rt/2024.2.0 ifort/2024.2.0 icc/2023.1.0 mpi/latest cmake/3.28.1-intel-2023.0.0 -@@ -70,3 +76,4 @@ n-all slurm - n-cpu penguin/openmpi/4.1.5/gcc-8.5.0 - n-gpu penguin/openmpi/4.1.5/nvhpc-22.3 nvidia/nvhpc/22.3 cuda/cuda-11.6 - n-gpu CC=nvc CXX=nvc++ FC=nvfortran -+ -diff --git a/toolchain/templates/oscar.mako b/toolchain/templates/oscar.mako -new file mode 100644 -index 00000000..158a217c ---- /dev/null -+++ b/toolchain/templates/oscar.mako -@@ -0,0 +1,56 @@ -+#!/usr/bin/env bash -+ -+<%namespace name="helpers" file="helpers.mako"/> -+ -+% if engine == 'batch': -+#SBATCH --nodes=${nodes} -+#SBATCH --ntasks-per-node=${tasks_per_node} -+#SBATCH --cpus-per-task=1 -+#SBATCH --job-name="${name}" -+#SBATCH --time=${walltime} -+% if partition: -+#SBATCH --partition=${partition} -+% endif -+% if account: -+#SBATCH --account="${account}" -+% endif -+% if gpu: -+#SBATCH --gpus-per-node=${tasks_per_node} -+#SBATCH --mem=64G -+#SBATCH --gpu-bind=closest -+% endif -+#SBATCH --output="${name}.out" -+#SBATCH --error="${name}.err" -+#SBATCH --export=ALL -+% if email: -+#SBATCH --mail-user=${email} -+#SBATCH --mail-type="BEGIN, END, FAIL" -+% endif -+% endif -+ -+${helpers.template_prologue()} -+ -+ok ":) Loading modules:\n" -+cd "${MFC_ROOTDIR}" -+. ./mfc.sh load -c o -m ${'g' if gpu else 'c'} -+cd - > /dev/null -+echo -+ -+% for target in targets: -+ ${helpers.run_prologue(target)} -+ -+ % if not mpi: -+ (set -x; ${profiler} "${target.get_install_binpath(case)}") -+ % else: -+ (set -x; ${profiler} \ -+ mpirun -np ${nodes*tasks_per_node} \ -+ ${' '.join([f"'{x}'" for x in ARG('--') ])} \ -+ "${target.get_install_binpath(case)}") -+ % endif -+ -+ ${helpers.run_epilogue(target)} -+ -+ echo -+% endfor -+ -+${helpers.template_epilogue()} -diff --git a/toolchain/util.sh b/toolchain/util.sh -index c67c9cad..fddbe22a 100644 ---- a/toolchain/util.sh -+++ b/toolchain/util.sh -@@ -1,10 +1,10 @@ - #!/bin/bash - - if [ -t 1 ]; then -- RED="\x1B[31m"; CYAN="\x1B[36m"; GREEN="\x1B[32m" -+ RED="\x1B[31m"; CYAN="\x1B[36m"; GREEN="\x1B[32m"; BROWN="\x1B[38;5;58m" - YELLOW="\x1B[33m"; MAGENTA="\x1B[35m"; BLUE="\x1B[34m"; COLOR_RESET="\033[m" - -- R=$RED; C=$CYAN; G=$GREEN -+ R=$RED; C=$CYAN; G=$GREEN; BR=$BROWN - Y=$YELLOW; M=$MAGENTA; B=$BLUE; CR=$COLOR_RESET; W=$CR - fi - From 2c9bd2c1b6657e222d8029aa09c76e4822db7b74 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 4 Aug 2024 22:13:58 -0500 Subject: [PATCH 274/380] small changes, still not passing 3D --- diff.txt | 8030 +++++++++++++++++++++++++++++++ src/simulation/p_main.fpp | 4 +- toolchain/mfc/run/case_dicts.py | 2 +- 3 files changed, 8033 insertions(+), 3 deletions(-) create mode 100644 diff.txt diff --git a/diff.txt b/diff.txt new file mode 100644 index 0000000000..8eb6fd7bcb --- /dev/null +++ b/diff.txt @@ -0,0 +1,8030 @@ +diff --git a/batch_mfc.sh b/batch_mfc.sh +new file mode 100755 +index 00000000..41df3c34 +--- /dev/null ++++ b/batch_mfc.sh +@@ -0,0 +1,14 @@ ++#!/bin/bash ++ ++./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar ++ ++./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar ++ ++./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar ++ +diff --git a/examples/2D_lungwave/case.py b/examples/2D_lungwave/case.py +new file mode 100644 +index 00000000..e5888cbe +--- /dev/null ++++ b/examples/2D_lungwave/case.py +@@ -0,0 +1,193 @@ ++#!/usr/bin/env python3 ++ ++import math ++import json ++ ++pi = 3.141592653589 ++# material parameters ++ ++#material1 :: gas ++#patterson 2018 ++ ++gammag = 1.4 #unitless ++Bg =0 #pascals ++rhog = 1.18 #kg/m^3 ++c_g = 347.2 #m/s ++G_g = 0 #pa ++ ++ #material2 :: lung ++ ++gammal = 5.5 ++Bl = 492.E+06 ++rhol = 996.0 ++c_l = 1648.7 ++G_l = 1E3 ++ ++#primitive vartiables ++patmos = 101325. #pa ++ ++#problem specific variable ++lambda_wave = 1E-3 ++ ++#define pulse ++P_amp = 10.E+6 ++P_len = 45 #length of the impulse ++theta = -math.pi/2 #direction of propagation ++ ++#non-dim ++ ++#define characteristic density, length, time, stress material ++rho_char = rhog ++length_char = lambda_wave ++c_char = c_g ++time_char = length_char/c_char ++stress_char = rho_char*c_char*c_char/gammag ++ ++#non-dim the properties ++rhog_n = rhog/rho_char ++c_g_n = c_g/c_char ++rhol_n = rhol/rho_char ++c_l_n = c_l/c_char ++Bg_n = Bg/stress_char ++Bl_n = Bl/stress_char ++G_g_n = G_g/stress_char ++G_l_n = G_l/stress_char ++patmos_n = patmos/stress_char ++P_amp_n = P_amp/stress_char ++ ++#geometry ++dlengx = 1. ++dlengy = 20. ++Nx = 200 ++Ny = dlengy*Nx ++dx = dlengx/Nx ++dy = dlengy/Ny ++alphal_back = 1.0 ++alphag_back = 0.0 ++alphal_lung = 0.0 ++alphag_lung = 1.0 ++ ++interface_amp = 0.5 ++ ++# time stepping requirements ++time_end = 2.5 ++cfl = 0.5 ++ ++dt = cfl * dx/c_l ++Nt = int(time_end/dt) ++Nframes = 50000 ++tstart = 0 ++tstop = Nt ++tsave = int(Nt/Nframes) ++ ++#interface profile ++interface_amp = 0.5 ++ ++# Configuring case dictionary ++print(json.dumps({ ++ # Logistics ================================================================ ++ 'run_time_info' : 'T', ++ # ========================================================================== ++ ++ # Computational Domain Parameters ========================================== ++ 'x_domain%beg' : 0., ++ 'x_domain%end' : dlengx, ++ 'y_domain%beg' : -dlengy/2., ++ 'y_domain%end' : dlengy/2., ++ 'm' : int(Nx), ++ 'n' : int(Ny), ++ 'p' : 0, ++ 'dt' : dt, ++ 't_step_start' : tstart, ++ 't_step_stop' : tstop, ++ 't_step_save' : tsave, ++ # ========================================================================== ++ ++ # Simulation Algorithm Parameters ========================================== ++ 'num_patches' : 2, ++ 'model_eqns' : 2, ++ 'alt_soundspeed' : 'F', ++ 'num_fluids' : 2, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'T', ++ 'mixture_err' : 'T', ++ 'time_stepper' : 3, ++ 'weno_order' : 5, ++ 'weno_eps' : 1.E-16, ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'T', ++ 'riemann_solver' : 2, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -1, ++ 'bc_x%end' : -1, ++ 'bc_y%beg' : -6, ++ 'bc_y%end' : -6, ++ # ========================================================================== ++ ++ # Formatted Database Files Structure Parameters ============================ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt' :'T', ++ 'parallel_io' :'T', ++ # ========================================================================== ++ ++ # Monopole setting ========================================================= ++ 'Monopole' : 'T', # creating an acoustic wave ++ 'num_mono' : 1, # place in the middle and expand ++ 'Mono(1)%pulse' : 3, # sine wave ++ 'Mono(1)%npulse' : 1, # 1 pulse ++ 'Mono(1)%mag' : 10.0*patmos_n, # magnitude ++ 'Mono(1)%length' : 1*dlengx, # impulse length ++ 'Mono(1)%loc(1)' : dlengx/2, # x_center of the domain ++ 'Mono(1)%loc(2)' : 5.0*dlengx, # upper boundary of the domain ++ 'Mono(1)%dir' : -math.pi/2, # direction: -pi/2 ++ #============================================================================== ++ ++ # Patch 1: Background ====================================================== ++ 'patch_icpp(1)%geometry' : 3, ++ 'patch_icpp(1)%x_centroid' : dlengx/2, ++ 'patch_icpp(1)%y_centroid' : 0., ++ 'patch_icpp(1)%length_x' : dlengx, ++ 'patch_icpp(1)%length_y' : dlengy, ++ 'patch_icpp(1)%vel(1)' : 0., ++ 'patch_icpp(1)%vel(2)' : 0.E+00, ++ 'patch_icpp(1)%pres' : patmos_n, ++ 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, ++ 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, ++ 'patch_icpp(1)%alpha(1)' : alphal_back, ++ 'patch_icpp(1)%alpha(2)' : alphag_back, ++ # ========================================================================== ++ ++ ++ # Patch 2: Lung ============================================================ ++ 'patch_icpp(2)%geometry' : 7, ++ 'patch_icpp(2)%hcid' : 205, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ 'patch_icpp(2)%x_centroid' : dlengx/2., ++ 'patch_icpp(2)%y_centroid' : -dlengy/4., ++ 'patch_icpp(2)%length_x' : dlengx, ++ 'patch_icpp(2)%length_y' : dlengy/2.+2, ++ 'patch_icpp(2)%a2' : interface_amp, ++ 'patch_icpp(2)%vel(1)' : 0.E+00, ++ 'patch_icpp(2)%vel(2)' : 0.0, ++ 'patch_icpp(2)%pres' : patmos_n, ++ 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, ++ 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, ++ 'patch_icpp(2)%alpha(1)' : alphal_lung, ++ 'patch_icpp(2)%alpha(2)' : alphag_lung, ++ # ========================================================================== ++ ++ # Fluids Physical Parameters =============================================== ++ 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), ++ 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), ++ 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), ++ 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), ++ # ========================================================================== ++ ++})) ++ ++# ============================================================================== +diff --git a/examples/2D_lungwave_horizontal/case.py b/examples/2D_lungwave_horizontal/case.py +new file mode 100644 +index 00000000..d11aeac2 +--- /dev/null ++++ b/examples/2D_lungwave_horizontal/case.py +@@ -0,0 +1,189 @@ ++#!/usr/bin/env python3 ++ ++import math ++import json ++ ++pi = 3.141592653589 ++# material parameters ++ ++#material1 :: gas ++#patterson 2018 ++ ++gammag = 1.4 #unitless ++Bg =0 #pascals ++rhog = 1.18 #kg/m^3 ++c_g = 347.2 #m/s ++G_g = 0 #pa ++ ++#material2 :: water ++gammal = 5.5 ++Bl = 492.E+06 ++rhol = 996.0 ++c_l = 1648.7 ++G_l = 1E3 ++ ++#primitive vartiables ++patmos = 101325. #pa ++ ++#problem specific variable ++lambda_wave = 1E-3 ++ ++#define pulse ++P_amp = 10.E+6 ++P_len = 45 #length of the impulse ++theta = -math.pi/2 #direction of propagation ++ ++#non-dim ++ ++#define characteristic density, length, time, stress material ++rho_char = rhog ++length_char = lambda_wave ++c_char = c_g ++time_char = length_char/c_char ++stress_char = rho_char*c_char*c_char/gammag ++ ++#non-dim the properties ++rhog_n = rhog/rho_char ++c_g_n = c_g/c_char ++rhol_n = rhol/rho_char ++c_l_n = c_l/c_char ++Bg_n = Bg/stress_char ++Bl_n = Bl/stress_char ++G_g_n = G_g/stress_char ++G_l_n = G_l/stress_char ++patmos_n = patmos/stress_char ++P_amp_n = P_amp/stress_char ++ ++#geometry ++dlengx = 10. ++dlengy = 2. ++Ny = 500 ++Nx = dlengx*Ny ++dx = dlengx/Nx ++dy = dlengy/Ny ++alphal_back = 1.0 ++alphag_back = 0.0 ++alphal_lung = 0.0 ++alphag_lung = 1.0 ++ ++interface_amp = 0.5 ++ ++# time stepping requirements ++time_end = 5 ++cfl = 8.0 ++ ++dt = cfl * dx/c_l ++Nt = int(time_end/dt) ++Nframes = 500 ++tstart = 0 ++tstop = Nt ++tsave = int(Nt/Nframes) ++ ++# Configuring case dictionary ++print(json.dumps({ ++ # Logistics ================================================================ ++ 'run_time_info' : 'T', ++ # ========================================================================== ++ ++ # Computational Domain Parameters ========================================== ++ 'x_domain%beg' : -dlengx/2., ++ 'x_domain%end' : dlengx/2., ++ 'y_domain%beg' : 0., ++ 'y_domain%end' : dlengy, ++ 'm' : int(Nx), ++ 'n' : int(Ny), ++ 'p' : 0, ++ 'dt' : dt, ++ 't_step_start' : tstart, ++ 't_step_stop' : tstop, ++ 't_step_save' : tsave, ++ # ========================================================================== ++ ++ # Simulation Algorithm Parameters ========================================== ++ 'num_patches' : 2, ++ 'model_eqns' : 2, ++ 'alt_soundspeed' : 'F', ++ 'num_fluids' : 2, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'T', ++ 'mixture_err' : 'T', ++ 'time_stepper' : 3, ++ 'weno_order' : 5, ++ 'weno_eps' : 1.E-16, ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'T', ++ 'riemann_solver' : 2, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -6, ++ 'bc_x%end' : -6, ++ 'bc_y%beg' : -1, ++ 'bc_y%end' : -1, ++ # ========================================================================== ++ ++ # Formatted Database Files Structure Parameters ============================ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt' :'T', ++ 'parallel_io' :'T', ++ # ========================================================================== ++ ++ # Monopole setting ========================================================= ++ 'Monopole' : 'T', # creating an acoustic wave ++ 'num_mono' : 1, # place in the middle and expand ++ 'Mono(1)%pulse' : 3, # square wave ++ 'Mono(1)%npulse' : 1, # 1 pulse ++ 'Mono(1)%mag' : 100.0*patmos_n,# magnitude ++ 'Mono(1)%length' : 45.0*dlengy, # pulse length ++ 'Mono(1)%support' : 2, # 2D semi infinite plane (x: -inf,inf; y:-len/2, len/2) ++ 'Mono(1)%support_width' : 30, ++ 'Mono(1)%loc(1)' : 0.7*dlengy, # x_center of the domain ++ 'Mono(1)%loc(2)' : dlengy/2, # upper boundary of the domain ++ 'Mono(1)%dir' : -math.pi, # direction: -pi/2 ++ ++ # Patch 1: Background ====================================================== ++ 'patch_icpp(1)%geometry' : 3, ++ 'patch_icpp(1)%x_centroid' : 0., ++ 'patch_icpp(1)%y_centroid' : dlengy/2., ++ 'patch_icpp(1)%length_x' : dlengx, ++ 'patch_icpp(1)%length_y' : dlengy, ++ 'patch_icpp(1)%vel(1)' : 0., ++ 'patch_icpp(1)%vel(2)' : 0.E+00, ++ 'patch_icpp(1)%pres' : patmos_n, ++ 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, ++ 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, ++ 'patch_icpp(1)%alpha(1)' : alphal_back, ++ 'patch_icpp(1)%alpha(2)' : alphag_back, ++ # ========================================================================== ++ ++ # Patch 2: Lung ============================================================ ++ 'patch_icpp(2)%geometry' : 7, ++ 'patch_icpp(2)%hcid' : 206, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ 'patch_icpp(2)%x_centroid' : -dlengx/4., ++ 'patch_icpp(2)%y_centroid' : dlengy/2., ++ 'patch_icpp(2)%length_x' : dlengx/2.+2, ++ 'patch_icpp(2)%length_y' : dlengy, ++ 'patch_icpp(2)%a2' : interface_amp, ++ 'patch_icpp(2)%vel(1)' : 0.E+00, ++ 'patch_icpp(2)%vel(2)' : 0.0, ++ 'patch_icpp(2)%pres' : patmos_n, ++ 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, ++ 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, ++ 'patch_icpp(2)%alpha(1)' : alphal_lung, ++ 'patch_icpp(2)%alpha(2)' : alphag_lung, ++ # ========================================================================== ++ ++ # Fluids Physical Parameters =============================================== ++ 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), ++ 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), ++ 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), ++ 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), ++ ++ #============================================================================== ++})) ++ ++# ============================================================================== +diff --git a/examples/2D_phasechange_bubble/case.py b/examples/2D_phasechange_bubble/case.py +new file mode 100644 +index 00000000..5fbe5f83 +--- /dev/null ++++ b/examples/2D_phasechange_bubble/case.py +@@ -0,0 +1,286 @@ ++#!/usr/bin/env python3 ++import math, json ++ ++## 1 FOR BACKGROUND, 2 FOR BUBBLE ++# Pressure [Pa] ++p01 = 5E6 ++p02 = 3550 ++ ++# Temperature [K] ++T01 = 298.15 ++T02 = 298.15 ++#T02 = 7.914 ++ ++#### FLUID PROPERTIES #### ++ ++### liquid water ### ++# pi infty ++piwl = 1.0E+09 ++# qv ++qvwl = -1167000 ++# qv' ++qvpwl = 0.0E0 ++# cv ++cvwl = 1816 ++# cp ++cpwl = 4267 ++# gamma ++gamwl = cpwl / cvwl ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) ++rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) ++ ++# speed of sound FOR ++c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) ++c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) ++ ++# part for Gases - relations from IMR ++Ru = 8.3144598 # Universal gas constant (J/mol-K) ++ ++### Vapor water ### ++Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) ++# gamma ++gamwv = 1.4 ++# cp ++cpwv = Rv * gamwv/(gamwv-1) ++# cv ++cvwv = cpwv/gamwv ++# pi infinity ++piwv = 0.0E0 ++# qv ++qvwv = 2030000 ++# qv' ++qvpwv = -23400 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) ++rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) ++ ++# speed of sound ++c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) ++c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) ++ ++### Air ### ++ ++Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) ++# gamma ++gama = 1.4 ++# cp ++cpa = Ra * gama/(gama-1) ++# cv ++cva = cpa/gama ++# pi infinity ++pia = 0.0E0 ++# qv ++qva = 0.0E0 ++# qv' ++qvpa = 0.0E0 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0a1 = (p01 + pia)/((gama-1)*cva*T01) ++rho0a2 = (p02 + pia)/((gama-1)*cva*T02) ++ ++# Speed of sound ++c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) ++c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) ++ ++## SHOCK RELATIONS ++p02Op01 = p02 / p01 ++ ++# Mach number of the shocked region - this should agree with Min, if everything is correct ++Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) ++ ++# shock speed ++ss = Ms * c_a1 ++ ++### volume fractions for each of the patches ### ++C0 = 0.25 # vapor concentration for IMR ++ ++# water liquid ++awl1 = 1.00E00-2.00E-12 ++awl2 = 1.00E-12 ++# water vapor ++awv1 = 1.00E-12 ++awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) ++# air ++aa1 = 1.0 - awl1 - awv1 ++aa2 = 1.0 - awl2 - awv2 ++ ++## SIMULATION PARAMETERS ++ ++# CFL ++cfl = 0.50 ++ ++# Bubble Initial Radius ++R0 = 30E-06 ++ ++# number of elements ++Nx0 = 400 ++Nx = 1600 ++Ny = 1600 ++Nz = 1600 ++ ++# domain boundaries ++xb = 0.00 ++xe = 120E-6 ++ ++yb = 0.00 ++ye = 120E-6 ++ ++zb = 0.00 ++ze = 120E-6 ++ ++# typical cell size ++dx = ( xe - xb ) / Nx ++dy = ( ye - yb ) / Ny ++dz = ( ze - zb ) / Nz ++ ++# time step ++ ++# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) ++SF = 200 ++ ++# Critical time-step ++tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) ++ ++# making Nt divisible by SF ++# tendA = 1.5 * tc ++tend = 1.2 * tc ++ ++# 1 - ensure NtA is sufficient to go a little beyond tendA ++# NtA = int( tendA // dt + 1 ) ++ ++# Array of saves. it is the same as Nt/Sf = t_step_save ++# AS = int( NtA // SF + 1 ) ++ ++# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) ++# Nt = AS * SF ++Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) ++ ++dt = tend / Nt ++ ++AS = int( Nt//SF ) ++ ++# Total physical time ++# tend = Nt * dt ++ ++# Configuring case dictionary ================================================== ++print(json.dumps({ ++ # Logistics ================================================ ++ 'run_time_info': 'T', ++ # ========================================================== ++ # Computational Domain Parameters ========================== ++ 'x_domain%beg' : xb, ++ 'x_domain%end' : xe, ++ 'y_domain%beg' : yb, ++ 'y_domain%end' : ye, ++ 'stretch_x' : 'T', ++ 'loops_x' : 3, ++ 'a_x' : 4.0E0, ++ 'x_a' : -2.0*R0, ++ 'x_b' : 2.0*R0, ++ 'stretch_y' : 'T', ++ 'loops_y' : 3, ++ 'a_y' : 4.0E0, ++ 'y_a' : -2.0*R0, ++ 'y_b' : 2.0*R0, ++ 'cyl_coord' : 'T', ++ 'm' : Nx, ++ 'n' : Ny, ++ 'p' : 0, ++ 'dt' : dt, ++ 't_step_start' : 0, ++ 't_step_stop' : Nt, ++ 't_step_save' : AS, ++ # ========================================================== ++ # Simulation Algorithm Parameters ========================== ++ 'num_patches' : 2, ++ 'model_eqns' : 3, ++ 'num_fluids' : 3, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'T', ++ 'mixture_err' : 'T', ++ 'relax' : 'T', ++ 'relax_model' : 6, ++ 'palpha_eps' : 1.0E-8, ++ 'ptgalpha_eps' : 1.0E-2, ++ 'time_stepper' : 3, ++ 'weno_order' : 3, ++ 'weno_eps' : 1.0E-16, ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'F', ++ 'riemann_solver' : 2, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -2, ++ 'bc_x%end' : -6, ++ 'bc_y%beg' : -2, ++ 'bc_y%end' : -6, ++ # ========================================================== ++ # Formatted Database Files Structure Parameters ============ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt':'T', ++ 'parallel_io' :'T', ++ # ========================================================== ++ # Patch 1: High pressured water ============================ ++ # Specify the cubic water background grid geometry ++ 'patch_icpp(1)%geometry' : 3, ++ 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, ++ 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, ++ 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, ++ 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, ++ 'patch_icpp(1)%vel(1)' : 0.0E+00, ++ 'patch_icpp(1)%vel(2)' : 0.0E+00, ++ 'patch_icpp(1)%pres' : p01, ++ 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, ++ 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, ++ 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, ++ 'patch_icpp(1)%alpha(1)' : awl1, ++ 'patch_icpp(1)%alpha(2)' : awv1, ++ 'patch_icpp(1)%alpha(3)' : aa1, ++ # ========================================================== ++ # Patch 2: (Vapor) Bubble ================================== ++ 'patch_icpp(2)%geometry' : 2, ++ 'patch_icpp(2)%x_centroid' : xb, ++ 'patch_icpp(2)%y_centroid' : yb, ++ 'patch_icpp(2)%radius' : R0, ++ 'patch_icpp(2)%vel(1)' : 0.0E+00, ++ 'patch_icpp(2)%vel(2)' : 0.0E+00, ++ 'patch_icpp(2)%pres' : p02, ++ 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, ++ 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, ++ 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, ++ 'patch_icpp(2)%alpha(1)' : awl2, ++ 'patch_icpp(2)%alpha(2)' : awv2, ++ 'patch_icpp(2)%alpha(3)' : aa2, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ # ========================================================== ++ # Fluids Physical Parameters =============================== ++ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), ++ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), ++ 'fluid_pp(1)%cv' : cvwl, ++ 'fluid_pp(1)%qv' : qvwl, ++ 'fluid_pp(1)%qvp' : qvpwl, ++ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), ++ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), ++ 'fluid_pp(2)%cv' : cvwv, ++ 'fluid_pp(2)%qv' : qvwv, ++ 'fluid_pp(2)%qvp' : qvpwv, ++ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), ++ 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), ++ 'fluid_pp(3)%cv' : cva, ++ 'fluid_pp(3)%qv' : qva, ++ 'fluid_pp(3)%qvp' : qvpa, ++ # ========================================================== ++})) +diff --git a/examples/2D_phasechange_bubble/casefile.py b/examples/2D_phasechange_bubble/casefile.py +new file mode 100644 +index 00000000..722d0049 +--- /dev/null ++++ b/examples/2D_phasechange_bubble/casefile.py +@@ -0,0 +1,300 @@ ++#!/usr/bin/env python3 ++import math, json ++ ++## 1 FOR BACKGROUND, 2 FOR BUBBLE ++# Pressure [Pa] ++p01 = 5E6 ++p02 = 3550 ++ ++# Temperature [K] ++T01 = 298.15 ++T02 = 298.15 ++#T02 = 7.914 ++ ++#### FLUID PROPERTIES #### ++ ++### liquid water ### ++# pi infty ++piwl = 1.0E+09 ++# qv ++qvwl = -1167000 ++# qv' ++qvpwl = 0.0E0 ++# cv ++cvwl = 1816 ++# cp ++cpwl = 4267 ++# gamma ++gamwl = cpwl / cvwl ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) ++rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) ++ ++# speed of sound FOR ++c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) ++c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) ++ ++# part for Gases - relations from IMR ++Ru = 8.3144598 # Universal gas constant (J/mol-K) ++ ++### Vapor water ### ++Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) ++# gamma ++gamwv = 1.4 ++# cp ++cpwv = Rv * gamwv/(gamwv-1) ++# cv ++cvwv = cpwv/gamwv ++# pi infinity ++piwv = 0.0E0 ++# qv ++qvwv = 2030000 ++# qv' ++qvpwv = -23400 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) ++rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) ++ ++# speed of sound ++c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) ++c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) ++ ++### Air ### ++ ++Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) ++# gamma ++gama = 1.4 ++# cp ++cpa = Ra * gama/(gama-1) ++# cv ++cva = cpa/gama ++# pi infinity ++pia = 0.0E0 ++# qv ++qva = 0.0E0 ++# qv' ++qvpa = 0.0E0 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0a1 = (p01 + pia)/((gama-1)*cva*T01) ++rho0a2 = (p02 + pia)/((gama-1)*cva*T02) ++ ++# Speed of sound ++c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) ++c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) ++ ++## SHOCK RELATIONS ++p02Op01 = p02 / p01 ++ ++# Mach number of the shocked region - this should agree with Min, if everything is correct ++Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) ++ ++# shock speed ++ss = Ms * c_a1 ++ ++### volume fractions for each of the patches ### ++C0 = 0.25 # vapor concentration for IMR ++ ++# water liquid ++awl1 = 1.00E00-2.00E-12 ++awl2 = 1.00E-12 ++# water vapor ++awv1 = 1.00E-12 ++awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) ++# air ++aa1 = 1.0 - awl1 - awv1 ++aa2 = 1.0 - awl2 - awv2 ++ ++## SIMULATION PARAMETERS ++ ++# CFL ++cfl = 0.50 ++ ++# Bubble Initial Radius ++R0 = 30E-06 ++ ++# number of elements ++Nx0 = 400 ++Nx = 100 ++Ny = 100 ++Nz = 100 ++ ++# domain boundaries ++xb = 0.00 ++xe = 120E-6 ++ ++yb = 0.00 ++ye = 120E-6 ++ ++zb = 0.00 ++ze = 120E-6 ++ ++# typical cell size ++dx = ( xe - xb ) / Nx ++dy = ( ye - yb ) / Ny ++dz = ( ze - zb ) / Nz ++ ++# time step ++ ++# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) ++SF = 200 ++ ++# Critical time-step ++tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) ++ ++# making Nt divisible by SF ++# tendA = 1.5 * tc ++tend = 1.2 * tc ++ ++# 1 - ensure NtA is sufficient to go a little beyond tendA ++# NtA = int( tendA // dt + 1 ) ++ ++# Array of saves. it is the same as Nt/Sf = t_step_save ++# AS = int( NtA // SF + 1 ) ++ ++# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) ++# Nt = AS * SF ++Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) ++ ++dt = tend / Nt ++ ++AS = int( Nt//SF ) ++ ++# Total physical time ++# tend = Nt * dt ++ ++# Configuring case dictionary ================================================== ++print(json.dumps({ ++ # Logistics ================================================ ++ 'run_time_info': 'T', ++ # ========================================================== ++ # Computational Domain Parameters ========================== ++ 'x_domain%beg' : xb, ++ 'x_domain%end' : xe, ++ 'y_domain%beg' : yb, ++ 'y_domain%end' : ye, ++ 'z_domain%beg' : zb, ++ 'z_domain%end' : ze, ++ 'stretch_x' : 'T', ++ 'loops_x' : 3, ++ 'a_x' : 4.0E0, ++ 'x_a' : -2.0*R0, ++ 'x_b' : 2.0*R0, ++ 'stretch_y' : 'T', ++ 'loops_y' : 3, ++ 'a_y' : 4.0E0, ++ 'y_a' : -2.0*R0, ++ 'y_b' : 2.0*R0, ++ 'stretch_z' : 'T', ++ 'loops_z' : 3, ++ 'a_z' : 4.0E0, ++ 'z_a' : -2.0*R0, ++ 'z_b' : 2.0*R0, ++ 'cyl_coord' : 'F', ++ 'm' : Nx, ++ 'n' : Ny, ++ 'p' : Nz, ++ 'dt' : dt, ++ 't_step_start' : 0, ++ 't_step_stop' : Nt, ++ 't_step_save' : AS, ++ # ========================================================== ++ # Simulation Algorithm Parameters ========================== ++ 'num_patches' : 2, ++ 'model_eqns' : 3, ++ 'num_fluids' : 3, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'T', ++ 'mixture_err' : 'T', ++ 'relax' : 'T', ++ 'relax_model' : 6, ++ 'palpha_eps' : 1.0E-6, ++ 'ptgalpha_eps' : 1.0E-2, ++ 'time_stepper' : 3, ++ 'weno_order' : 3, ++ 'weno_eps' : 1.0E-32, ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'F', ++ 'riemann_solver' : 2, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -2, ++ 'bc_x%end' : -6, ++ 'bc_y%beg' : -2, ++ 'bc_y%end' : -6, ++ 'bc_z%beg' : -2, ++ 'bc_z%end' : -6, ++ # ========================================================== ++ # Formatted Database Files Structure Parameters ============ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt':'T', ++ 'parallel_io' :'T', ++ # ========================================================== ++ # Patch 1: High pressured water ============================ ++ # Specify the cubic water background grid geometry ++ 'patch_icpp(1)%geometry' : 9, ++ 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, ++ 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, ++ 'patch_icpp(1)%z_centroid' : ( ze + zb ) * 500000 / 100, ++ 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, ++ 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, ++ 'patch_icpp(1)%length_z' : ( ze - zb ) * 1000000 / 100, ++ 'patch_icpp(1)%vel(1)' : 0.0E+00, ++ 'patch_icpp(1)%vel(2)' : 0.0E+00, ++ 'patch_icpp(1)%vel(3)' : 0.0E+00, ++ 'patch_icpp(1)%pres' : p01, ++ 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, ++ 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, ++ 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, ++ 'patch_icpp(1)%alpha(1)' : awl1, ++ 'patch_icpp(1)%alpha(2)' : awv1, ++ 'patch_icpp(1)%alpha(3)' : aa1, ++ # ========================================================== ++ # Patch 2: (Vapor) Bubble ================================== ++ 'patch_icpp(2)%geometry' : 8, ++ 'patch_icpp(2)%x_centroid' : xb, ++ 'patch_icpp(2)%y_centroid' : yb, ++ 'patch_icpp(2)%z_centroid' : zb, ++ 'patch_icpp(2)%radius' : R0, ++ 'patch_icpp(2)%vel(1)' : 0.0E+00, ++ 'patch_icpp(2)%vel(2)' : 0.0E+00, ++ 'patch_icpp(2)%vel(3)' : 0.0E+00, ++ 'patch_icpp(2)%pres' : p02, ++ 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, ++ 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, ++ 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, ++ 'patch_icpp(2)%alpha(1)' : awl2, ++ 'patch_icpp(2)%alpha(2)' : awv2, ++ 'patch_icpp(2)%alpha(3)' : aa2, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ # ========================================================== ++ # Fluids Physical Parameters =============================== ++ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), ++ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), ++ 'fluid_pp(1)%cv' : cvwl, ++ 'fluid_pp(1)%qv' : qvwl, ++ 'fluid_pp(1)%qvp' : qvpwl, ++ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), ++ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), ++ 'fluid_pp(2)%cv' : cvwv, ++ 'fluid_pp(2)%qv' : qvwv, ++ 'fluid_pp(2)%qvp' : qvpwv, ++ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), ++ 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), ++ 'fluid_pp(3)%cv' : cva, ++ 'fluid_pp(3)%qv' : qva, ++ 'fluid_pp(3)%qvp' : qvpa, ++ # ========================================================== ++})) +diff --git a/examples/3D_CAV/3D_CAV_sph_col.py b/examples/3D_CAV/3D_CAV_sph_col.py +new file mode 100644 +index 00000000..a54df0a5 +--- /dev/null ++++ b/examples/3D_CAV/3D_CAV_sph_col.py +@@ -0,0 +1,205 @@ ++import math ++import json ++ ++ ++## Deine characteristic values for the sim ++Ri = 50E-6 ++T = 407.9 ++rhog = 0.027 ++Pb = 3550 ++Pl = 101325 ++#mulc = 9E-04 ++#mubc = 1.0E-05 ++domain_length = 3*Ri ++ ++ ++## fluid properties ++Pi_inf_l = 1.0E+09 ++Pi_inf_b = 0.0E+00 ++nl = 2.35 ++nb = 1.47 ++alpha1 = 1.0E+00 ++Cv_l = 1816 ++rhol = (Pl+Pi_inf_l)/((nl-1)*Cv_l*T) ++alpha2 = alpha1 ++cl = (nl*(Pl+Pi_inf_l)/rhol)**(0.5) ++ ++## Defining Characteristic Values ++Rc = Ri ++rhoc = rhol ++uc = (Pl/rhol)**(0.5E+00) ++tc = Ri/uc ++Pc = rhoc*uc**(2.0E+00) ++ ++## Non-Dimensionalizing values using characteristic values ++Rin = Ri/Rc ++rholn = rhol/rhoc ++rhogn = rhog/rhoc ++Pln = Pl/Pc ++Pbn = Pb/Pc ++tcn = tc/tc ++Pi_inf_ln = Pi_inf_l/Pc ++leng = domain_length/Rc ++clc = cl/uc ++ ++ ++## Non-Dimensional Numbers ++#Rel = rhol*uc*2*Rin/mulc ++#Reb = rhog*uc*2*Rin/mubc ++Ma = uc/cl ++ ++## Grid Specifications ++CFL = 0.1 ++PpBr = 192 ++Nx = PpBr*leng ++Ny = Nx ++Nz = Nx ++x_beg = 0.0E+00 ++x_end = leng ++y_beg = 0.0E+00 ++y_end = leng ++z_beg = 0.0E+00 ++z_end = leng ++delta_x = leng/Nx ++delta_t = CFL*delta_x/clc ++Nt = int(1.1*tcn/delta_t) ++x_centroidl = (x_end+x_beg)/(2.0E+00) ++y_centroidl = (y_end+y_beg)/(2.0E+00) ++z_centroidl = (z_end+z_beg)/(2.0E+00) ++x_centroidb = 0.0E+00 ++y_centroidb = 0.0E+00 ++z_centroidb = 0.0E+00 ++ ++ ++# Configuring case dictionary ++print(json.dumps({ ++ # Logistics ================================================ ++ 'run_time_info' : 'T', ++ 'sim_data' : 'T', ++ # ========================================================== ++ ++ # Computational Domain Parameters ========================== ++ 'x_domain%beg' : x_beg, ++ 'x_domain%end' : x_end, ++ 'y_domain%beg' : y_beg, ++ 'y_domain%end' : y_end, ++ 'z_domain%beg' : z_beg, ++ 'z_domain%end' : z_end, ++ 'm' : int(Nx), ++ 'n' : int(Ny), ++ 'p' : int(Nz), ++ 'cyl_coord' : 'F', ++ 'dt' : delta_t, ++ 't_step_start' : 0, ++ 't_step_stop' : Nt, ++ 't_step_save' : int(Nt/360), ++# ========================================================== ++ ++ # Simulation Algorithm Parameters ========================== ++ 'num_patches' : 2, ++ 'model_eqns' : 2, ++ 'alt_soundspeed' : 'F', ++ 'num_fluids' : 2, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'T', ++ 'mixture_err' : 'T', ++ 'time_stepper' : 3, ++ 'weno_order' : 5, ++ 'weno_eps' : 1.E-100, ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'F', ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'riemann_solver' : 2, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -2, ++ 'bc_x%end' : -6, ++ 'bc_y%beg' : -2, ++ 'bc_y%end' : -6, ++ 'bc_z%beg' : -2, ++ 'bc_z%end' : -6, ++ 'stretch_x' : 'T', ++ 'stretch_y' : 'T', ++ 'stretch_z' : 'T', ++ 'a_x' : 4.0E+00, ++ 'x_a' : -1.5E+00, ++ 'x_b' : 1.5E+00, ++ 'a_y' : 4.0E+00, ++ 'y_a' : -1.5E+00, ++ 'y_b' : 1.5E+00, ++ 'a_z' : 4.0E+00, ++ 'z_a' : -1.5E+00, ++ 'z_b' : 1.5E+00, ++ # ========================================================== ++ ++ # Formatted Database Files Structure Parameters ============ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt' :'T', ++ 'parallel_io' :'T', ++ 'fd_order' :'1', ++ 'probe_wrt' :'T', ++ 'num_probes' : 1, ++ 'probe(1)%x' : 0., ++ 'probe(1)%y' : 0., ++ 'probe(1)%z' : 0., ++ # ========================================================== ++ ++ # Patch 1: Background ============================ ++ 'patch_icpp(1)%geometry' : 9, ++ 'patch_icpp(1)%x_centroid' : 40*x_centroidl, ++ 'patch_icpp(1)%y_centroid' : 40*y_centroidl, ++ 'patch_icpp(1)%z_centroid' : 40*z_centroidl, ++ 'patch_icpp(1)%length_x' : 40*leng, ++ 'patch_icpp(1)%length_y' : 40*leng, ++ 'patch_icpp(1)%length_z' : 40*leng, ++ 'patch_icpp(1)%vel(1)' : 0.E+00, ++ 'patch_icpp(1)%vel(2)' : 0.E+00, ++ 'patch_icpp(1)%vel(3)' : 0.E+00, ++ 'patch_icpp(1)%pres' : Pln, ++ 'patch_icpp(1)%alpha_rho(1)' : alpha1*rholn, ++ 'patch_icpp(1)%alpha_rho(2)' : 0.0E+00, ++ 'patch_icpp(1)%alpha(1)' : alpha1, ++ 'patch_icpp(1)%alpha(2)' : 0.0E+00, ++ # ========================================================== ++ # Patch 2: Bubble ====================================== ++ 'patch_icpp(2)%geometry' : 14, ++ 'patch_icpp(2)%x_centroid' : x_centroidb, ++ 'patch_icpp(2)%y_centroid' : y_centroidb, ++ 'patch_icpp(2)%z_centroid' : z_centroidb, ++ 'patch_icpp(2)%radius' : Rin, ++ 'patch_icpp(2)%smoothen' : 'T', ++ 'patch_icpp(2)%smooth_patch_id': 1, ++ 'patch_icpp(2)%smooth_coeff' : 1.5E+00, ++ 'patch_icpp(2)%non_axis_sym' : 'F', ++ 'patch_icpp(2)%a2' : 0.0E+00, ++ 'patch_icpp(2)%a3' : 0.0E+00, ++ 'patch_icpp(2)%a4' : 0.0E+00, ++ 'patch_icpp(2)%a5' : 0.0E+00, ++ 'patch_icpp(2)%a6' : 0.0E+00, ++ 'patch_icpp(2)%a7' : 0.0E+00, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ 'patch_icpp(2)%vel(1)' : 0.E+00, ++ 'patch_icpp(2)%vel(2)' : 0.E+00, ++ 'patch_icpp(2)%vel(3)' : 0.E+00, ++ 'patch_icpp(2)%pres' : Pbn, ++ 'patch_icpp(2)%alpha_rho(1)' : 0.0E+00, ++ 'patch_icpp(2)%alpha_rho(2)' : alpha2*rhogn, ++ 'patch_icpp(2)%alpha(1)' : 0.0E+00, ++ 'patch_icpp(2)%alpha(2)' : alpha2, ++ # ========================================================== ++ ++ # Fluids Physical Parameters =============================== ++ 'fluid_pp(1)%gamma' : 1/(nl-1), ++ 'fluid_pp(1)%pi_inf' : nl*Pi_inf_ln/(nl-1), ++ 'fluid_pp(2)%gamma' : 1/(nb-1), ++ 'fluid_pp(2)%pi_inf' : 0.0E+00, ++# 'fluid_pp(1)%Re(1)' : Rel, ++# 'fluid_pp(2)%Re(1)' : Reb, ++ # ========================================================== ++})) ++ ++# ============================================================================== ++ +diff --git a/examples/3D_ctr_test/case.py b/examples/3D_ctr_test/case.py +new file mode 100644 +index 00000000..aac9ec36 +--- /dev/null ++++ b/examples/3D_ctr_test/case.py +@@ -0,0 +1,399 @@ ++#!/usr/bin/env python3 ++import math, json ++ ++## 1 FOR BACKGROUND, 2 FOR BUBBLE, 3 FOR GEL ++# Pressure [Pa] ++p01 = 5E6 ++p02 = 3550 ++p03 = p01 ++ ++# Temperature [K] ++T01 = 298.15 ++T02 = 298.15 ++T03 = T01 ++ ++#### FLUID PROPERTIES #### ++ ++### liquid water ### ++# pi infty ++piwl = 1.0E+09 ++# qv ++qvwl = -1167000 ++# qv' ++qvpwl = 0.0E0 ++# cv ++cvwl = 1816 ++# cp ++cpwl = 4267 ++# gamma ++gamwl = cpwl / cvwl ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) ++rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) ++rho0wl3 = (p03 + piwl)/((gamwl-1)*cvwl*T03) ++ ++# speed of sound FOR ++c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) ++c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) ++c_wl3 = math.sqrt( gamwl * ( p03 + piwl ) / rho0wl3 ) ++ ++# part for Gases - relations from IMR ++Ru = 8.3144598 # Universal gas constant (J/mol-K) ++ ++### Vapor water ### ++Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) ++# gamma ++gamwv = 1.4 ++# cp ++cpwv = Rv * gamwv/(gamwv-1) ++# cv ++cvwv = cpwv/gamwv ++# pi infinity ++piwv = 0.0E0 ++# qv ++qvwv = 2030000 ++# qv' ++qvpwv = -23400 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) ++rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) ++rho0wv3 = (p03 + piwv)/((gamwv-1)*cvwv*T03) ++ ++# speed of sound ++c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) ++c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) ++c_wv3 = math.sqrt( gamwv * ( p03 + piwv ) / rho0wv3 ) ++ ++### Air ### ++ ++Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) ++gamwa = 1.4 ++# cp ++cpa = Ra * gamwa/(gamwa-1) ++# cv ++cva = cpa/gamwa ++# pi infinity ++pia = 0.0E0 ++# qv ++qvwa = 0.0E0 ++# qv' ++qvpwa = 0.0E0 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wa1 = (p01 + pia)/((gamwa-1)*cva*T01) ++rho0wa2 = (p02 + pia)/((gamwa-1)*cva*T02) ++ ++# Speed of sound ++c_a1 = math.sqrt( gamwa * ( p01 + pia ) / rho0wa1 ) ++c_a2 = math.sqrt( gamwa * ( p02 + pia ) / rho0wa2 ) ++ ++### 3% polyacrylamide gel ### ++# gamma ++gamwg = 2.35 ++# pi infty ++pig = 1.0E+09 ++# qv ++qvwg = -1167000 ++# qv' ++qvpwg = 0.0E0 ++# cv ++cvg = 1816 ++# cp ++cpg = gamwg*cvg ++ ++## FOR PATCHES 1 & 2 & 3 ## ++ ++# density ++rho0wg1 = (p01 + pig)/((gamwg-1)*cvg*T01) ++rho0wg2 = (p02 + pig)/((gamwg-1)*cvg*T02) ++rho0wg3 = (p03 + pig)/((gamwg-1)*cvg*T03) ++ ++# Speed of sound ++c_g1 = math.sqrt( gamwg * ( p01 + pig ) / rho0wg1 ) ++c_g2 = math.sqrt( gamwg * ( p02 + pig ) / rho0wg2 ) ++c_g3 = math.sqrt( gamwg * ( p03 + pig ) / rho0wg3 ) ++ ++## SHOCK RELATIONS ++p02Op01 = p02 / p01 ++ ++# Mach number of the shocked region - this should agree with Min, if everything is correct ++Ms = math.sqrt( ( gamwa + 1. ) / ( 2. * gamwa ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) ++ ++# shock speed ++ss = Ms * c_a1 ++ ++### volume fractions for each of the patches ### ++C0 = 0.5 # vapor concentration for IMR ++ ++# patch 1: liquid water ++liq_wv = 1.00E-15 ++liq_wg = 0. ++liq_wa = 1.00E-15 ++liq_wl = 1.00E00 - liq_wv - liq_wa - liq_wg ++# water vapor ++vap_wl = 1.00E-15 ++vap_wv = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0wa2 + 1 ) ++vap_wg = 0. ++vap_wa = 1.00E-15 ++vap_tot = vap_wl + vap_wv + vap_wa + vap_wg ++# bub ++bub_wl = 1.00E-15 ++bub_wv = vap_tot ++bub_wg = 0. ++bub_wa = 1.00E00 - bub_wl - bub_wv - bub_wg ++# gel ++gel_wv = 0. ++gel_wl = 0. ++gel_wa = 0. ++gel_wg = 1.00E00 - gel_wl - gel_wv - gel_wa ++ ++## SIMULATION PARAMETERS ++ ++# CFL ++cfl = 0.50 ++ ++# Bubble Initial Radius ++R0 = 230.4E-06 ++ ++# number of elements ++Nx0 = 400 ++Nx = 399 ++Ny = 199 ++Nz = 199 ++ ++lref = 921.6E-6 ++# domain boundaries ++xb = -lref ++xe = lref ++ ++yb = 0.00 ++ye = lref ++ ++zb = 0.00 ++ze = lref ++ ++lenx = ( xe - xb ) ++leny = ( ye - yb ) ++lenz = ( ze - zb ) ++ ++xcenl = (xb + xe)/2.0 ++ycenl = (yb + ye)/2.0 ++zcenl = (zb + ze)/2.0 ++ ++#xdist = 6.51E-10 #2.17E-5 ++#sod = xdist/R0 ++sod = -2.17 ++xcenb = sod*R0 ++ycenb = 0.00 ++zcenb = 0.00 ++ ++xbg = 0 ++xeg = xe ++ ++lenxg = (xeg - xbg) ++lenyg = leny ++lenzg = lenz ++xceng = (xbg + xeg)/2.0 ++yceng = ycenl ++zceng = zcenl ++ ++# typical cell size ++dx = ( xe - xb ) / Nx ++dy = ( ye - yb ) / Ny ++dz = ( ze - zb ) / Nz ++#print(dx) ++# time step ++ ++# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) ++SF = 60 ++ ++# Critical time-step ++tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) ++ ++# making Nt divisible by SF ++# tendA = 1.5 * tc ++tend = 1.2 * tc ++ ++# 1 - ensure NtA is sufficient to go a little beyond tendA ++# NtA = int( tendA // dt + 1 ) ++ ++# Array of saves. it is the same as Nt/Sf = t_step_save ++# AS = int( NtA // SF + 1 ) ++ ++# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) ++# Nt = AS * SF ++Nt = int(10E3 * tend // tc * Nx / Nx0 + 1) ++#print(Nt) ++dt = tend / Nt ++ ++AS = int( Nt//SF ) ++ ++# Total physical time ++# tend = Nt * dt ++ ++# Configuring case dictionary ================================================== ++print(json.dumps({ ++ # Logistics ================================================ ++ 'run_time_info': 'T', ++ # ========================================================== ++ # Computational Domain Parameters ========================== ++ 'x_domain%beg' : xb, ++ 'x_domain%end' : xe, ++ 'y_domain%beg' : yb, ++ 'y_domain%end' : ye, ++ 'z_domain%beg' : zb, ++ 'z_domain%end' : ze, ++ 'stretch_x' : 'F', ++ 'loops_x' : 1, ++ 'a_x' : 4.0E0, ++ 'x_a' : -2.0*R0, ++ 'x_b' : 2.0*R0, ++ 'stretch_y' : 'F', ++ 'loops_y' : 1, ++ 'a_y' : 4.0E0, ++ 'y_a' : -2.0*R0, ++ 'y_b' : 2.0*R0, ++ 'stretch_z' : 'F', ++ 'loops_z' : 1, ++ 'a_z' : 4.0E0, ++ 'z_a' : -2.0*R0, ++ 'z_b' : 2.0*R0, ++ 'cyl_coord' : 'F', ++ 'm' : Nx, ++ 'n' : Ny, ++ 'p' : Nz, ++ 'dt' : dt, ++ 't_step_start' : 0, ++ 't_step_stop' : Nt, ++ 't_step_save' : AS, ++ # ========================================================== ++ # Simulation Algorithm Parameters ========================== ++ 'num_patches' : 3, ++ 'model_eqns' : 3, ++ 'num_fluids' : 4, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'T', ++ 'mixture_err' : 'T', ++ 'relax' : 'T', ++ 'relax_model' : 6, ++ 'palpha_eps' : 1.0E-6, ++ 'ptgalpha_eps' : 1.0E-2, ++ 'time_stepper' : 3, ++ 'weno_order' : 3, ++ 'weno_eps' : 1.0E-16, ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'F', ++ 'riemann_solver' : 2, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -6, #-2, ++ 'bc_x%end' : -6, ++ 'bc_y%beg' : -2, ++ 'bc_y%end' : -6, ++ 'bc_z%beg' : -2, ++ 'bc_z%end' : -6, ++ # ========================================================== ++ # Formatted Database Files Structure Parameters ============ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt':'T', ++ 'parallel_io' :'T', ++ # ========================================================== ++ # Patch 1: High pressured water ============================ ++ # Specify the cubic water background grid geometry ++ 'patch_icpp(1)%geometry' : 9, ++ 'patch_icpp(1)%x_centroid' : xcenl, ++ 'patch_icpp(1)%y_centroid' : ycenl, ++ 'patch_icpp(1)%z_centroid' : zcenl, ++ 'patch_icpp(1)%length_x' : lenx, ++ 'patch_icpp(1)%length_y' : leny, ++ 'patch_icpp(1)%length_z' : lenz, ++ 'patch_icpp(1)%vel(1)' : 0.0E+00, ++ 'patch_icpp(1)%vel(2)' : 0.0E+00, ++ 'patch_icpp(1)%vel(3)' : 0.0E+00, ++ 'patch_icpp(1)%pres' : p01, ++ 'patch_icpp(1)%alpha_rho(1)' : liq_wl * rho0wl1, ++ 'patch_icpp(1)%alpha_rho(2)' : liq_wv * rho0wv1, ++ 'patch_icpp(1)%alpha_rho(3)' : liq_wa * rho0wa1, ++ 'patch_icpp(1)%alpha_rho(4)' : liq_wg * rho0wg1, ++ 'patch_icpp(1)%alpha(1)' : liq_wl, ++ 'patch_icpp(1)%alpha(2)' : liq_wv, ++ 'patch_icpp(1)%alpha(3)' : liq_wa, ++ 'patch_icpp(1)%alpha(4)' : liq_wg, ++ # ========================================================== ++ # Patch 2: (Vapor) Bubble ================================== ++ 'patch_icpp(2)%geometry' : 8, ++ 'patch_icpp(2)%x_centroid' : xcenb, ++ 'patch_icpp(2)%y_centroid' : ycenb, ++ 'patch_icpp(2)%z_centroid' : zcenb, ++ 'patch_icpp(2)%radius' : R0, ++ 'patch_icpp(2)%vel(1)' : 0.0E+00, ++ 'patch_icpp(2)%vel(2)' : 0.0E+00, ++ 'patch_icpp(2)%vel(3)' : 0.0E+00, ++ 'patch_icpp(2)%pres' : p02, ++ 'patch_icpp(2)%alpha_rho(1)' : bub_wl * rho0wl2, ++ 'patch_icpp(2)%alpha_rho(2)' : bub_wv * rho0wv2, ++ 'patch_icpp(2)%alpha_rho(3)' : bub_wa * rho0wa2, ++ 'patch_icpp(2)%alpha_rho(4)' : bub_wg * rho0wg2, ++ 'patch_icpp(2)%alpha(1)' : bub_wl, ++ 'patch_icpp(2)%alpha(2)' : bub_wv, ++ 'patch_icpp(2)%alpha(3)' : bub_wa, ++ 'patch_icpp(2)%alpha(4)' : bub_wg, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ # ========================================================== ++ # Patch 3: Gel Object ====================================== ++ 'patch_icpp(3)%geometry' : 9, ++ 'patch_icpp(3)%x_centroid' : xceng, ++ 'patch_icpp(3)%y_centroid' : yceng, ++ 'patch_icpp(3)%z_centroid' : zceng, ++ 'patch_icpp(3)%length_x' : lenxg, ++ 'patch_icpp(3)%length_y' : lenyg, ++ 'patch_icpp(3)%length_z' : lenzg, ++ 'patch_icpp(3)%vel(1)' : 0.0E+00, ++ 'patch_icpp(3)%vel(2)' : 0.0E+00, ++ 'patch_icpp(3)%vel(3)' : 0.0E+00, ++ 'patch_icpp(3)%pres' : p03, ++ 'patch_icpp(3)%alpha_rho(1)' : gel_wl * rho0wl2, ++ 'patch_icpp(3)%alpha_rho(2)' : gel_wv * rho0wv2, ++ 'patch_icpp(3)%alpha_rho(3)' : gel_wa * rho0wa2, ++ 'patch_icpp(3)%alpha_rho(4)' : gel_wg * rho0wg2, ++ 'patch_icpp(3)%alpha(1)' : gel_wl, ++ 'patch_icpp(3)%alpha(2)' : gel_wv, ++ 'patch_icpp(3)%alpha(3)' : gel_wa, ++ 'patch_icpp(3)%alpha(4)' : gel_wg, ++ 'patch_icpp(3)%alter_patch(1)' : 'T', ++ # ========================================================== ++ # Fluids Physical Parameters =============================== ++ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), ++ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), ++ 'fluid_pp(1)%cv' : cvwl, ++ 'fluid_pp(1)%qv' : qvwl, ++ 'fluid_pp(1)%qvp' : qvpwl, ++ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), ++ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), ++ 'fluid_pp(2)%cv' : cvwv, ++ 'fluid_pp(2)%qv' : qvwv, ++ 'fluid_pp(2)%qvp' : qvpwv, ++ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gamwa - 1 ), ++ 'fluid_pp(3)%pi_inf' : gamwa * pia / ( gamwa - 1 ), ++ 'fluid_pp(3)%cv' : cva, ++ 'fluid_pp(3)%qv' : qvwa, ++ 'fluid_pp(3)%qvp' : qvpwa, ++ 'fluid_pp(4)%gamma' : 1.0E+00 / ( gamwg - 1), ++ 'fluid_pp(4)%pi_inf' : gamwg * pig / ( gamwg - 1), ++ 'fluid_pp(4)%cv' : cvg, ++ 'fluid_pp(4)%qv' : qvwg, ++ 'fluid_pp(4)%qvp' : qvpwg, ++ # ========================================================== ++})) +diff --git a/examples/3D_ctr_test/old_case.py b/examples/3D_ctr_test/old_case.py +new file mode 100644 +index 00000000..092c0213 +--- /dev/null ++++ b/examples/3D_ctr_test/old_case.py +@@ -0,0 +1,399 @@ ++#!/usr/bin/env python3 ++import math, json ++ ++## 1 FOR BACKGROUND, 2 FOR BUBBLE, 3 FOR GEL ++# Pressure [Pa] ++p01 = 5E6 ++p02 = 3550 ++p03 = p01 ++ ++# Temperature [K] ++T01 = 298.15 ++T02 = 298.15 ++T03 = T01 ++ ++#### FLUID PROPERTIES #### ++ ++### liquid water ### ++# pi infty ++piwl = 1.0E+09 ++# qv ++qvwl = -1167000 ++# qv' ++qvpwl = 0.0E0 ++# cv ++cvwl = 1816 ++# cp ++cpwl = 4267 ++# gamma ++gamwl = cpwl / cvwl ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) ++rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) ++rho0wl3 = (p03 + piwl)/((gamwl-1)*cvwl*T03) ++ ++# speed of sound FOR ++c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) ++c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) ++c_wl3 = math.sqrt( gamwl * ( p03 + piwl ) / rho0wl3 ) ++ ++# part for Gases - relations from IMR ++Ru = 8.3144598 # Universal gas constant (J/mol-K) ++ ++### Vapor water ### ++Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) ++# gamma ++gamwv = 1.4 ++# cp ++cpwv = Rv * gamwv/(gamwv-1) ++# cv ++cvwv = cpwv/gamwv ++# pi infinity ++piwv = 0.0E0 ++# qv ++qvwv = 2030000 ++# qv' ++qvpwv = -23400 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) ++rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) ++rho0wv3 = (p03 + piwv)/((gamwv-1)*cvwv*T03) ++ ++# speed of sound ++c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) ++c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) ++c_wv3 = math.sqrt( gamwv * ( p03 + piwv ) / rho0wv3 ) ++ ++### Air ### ++ ++Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) ++gamwa = 1.4 ++# cp ++cpa = Ra * gamwa/(gamwa-1) ++# cv ++cva = cpa/gamwa ++# pi infinity ++pia = 0.0E0 ++# qv ++qvwa = 0.0E0 ++# qv' ++qvpwa = 0.0E0 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wa1 = (p01 + pia)/((gamwa-1)*cva*T01) ++rho0wa2 = (p02 + pia)/((gamwa-1)*cva*T02) ++ ++# Speed of sound ++c_a1 = math.sqrt( gamwa * ( p01 + pia ) / rho0wa1 ) ++c_a2 = math.sqrt( gamwa * ( p02 + pia ) / rho0wa2 ) ++ ++### 3% polyacrylamide gel ### ++# gamma ++gamwg = 2.35 ++# pi infty ++pig = 1.0E+09 ++# qv ++qvwg = -1167000 ++# qv' ++qvpwg = 0.0E0 ++# cv ++cvg = 1816 ++# cp ++cpg = gamwg*cvg ++ ++## FOR PATCHES 1 & 2 & 3 ## ++ ++# density ++rho0wg1 = (p01 + pig)/((gamwg-1)*cvg*T01) ++rho0wg2 = (p02 + pig)/((gamwg-1)*cvg*T02) ++rho0wg3 = (p03 + pig)/((gamwg-1)*cvg*T03) ++ ++# Speed of sound ++c_g1 = math.sqrt( gamwg * ( p01 + pig ) / rho0wg1 ) ++c_g2 = math.sqrt( gamwg * ( p02 + pig ) / rho0wg2 ) ++c_g3 = math.sqrt( gamwg * ( p03 + pig ) / rho0wg3 ) ++ ++## SHOCK RELATIONS ++p02Op01 = p02 / p01 ++ ++# Mach number of the shocked region - this should agree with Min, if everything is correct ++Ms = math.sqrt( ( gamwa + 1. ) / ( 2. * gamwa ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) ++ ++# shock speed ++ss = Ms * c_a1 ++ ++### volume fractions for each of the patches ### ++C0 = 0.1 # vapor concentration for IMR ++ ++# patch 1: liquid water ++liq_wv = 1.00E-15 ++liq_wg = 1.00E-15 ++liq_wa = 1.00E-15 ++liq_wl = 1.00E00 - liq_wv - liq_wa - liq_wg ++# water vapor ++vap_wl = 1.00E-15 ++vap_wv = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0wa2 + 1 ) ++vap_wg = 1.00E-15 ++vap_wa = 1.00E-15 ++vap_tot = vap_wl + vap_wv + vap_wa + vap_wg ++# bub ++bub_wl = 1.00E-15 ++bub_wv = vap_tot ++bub_wg = 1.00E-15 ++bub_wa = 1.00E00 - bub_wl - bub_wv - bub_wg ++# gel ++gel_wv = 1.00E-15 ++gel_wl = 1.00E-15 ++gel_wa = 1.00E-15 ++gel_wg = 1.00E00 - gel_wl - gel_wv - gel_wa ++ ++## SIMULATION PARAMETERS ++ ++# CFL ++cfl = 0.50 ++ ++# Bubble Initial Radius ++R0 = 230.4E-06 ++ ++# number of elements ++Nx0 = 400 ++Nx = 199*2 ++Ny = 199 ++Nz = 199 ++ ++lref = 921.6E-6 ++# domain boundaries ++xb = -lref ++xe = lref ++ ++yb = 0.00 ++ye = lref ++ ++zb = 0.00 ++ze = lref ++ ++lenx = ( xe - xb ) ++leny = ( ye - yb ) ++lenz = ( ze - zb ) ++ ++xcenl = (xb + xe)/2.0 ++ycenl = (yb + ye)/2.0 ++zcenl = (zb + ze)/2.0 ++ ++#xdist = 6.51E-10 #2.17E-5 ++#sod = xdist/R0 ++sod = -2.17 ++xcenb = sod*R0 ++ycenb = 0.00 ++zcenb = 0.00 ++ ++xbg = 0 ++xeg = xe ++ ++lenxg = (xeg - xbg) ++lenyg = leny ++lenzg = lenz ++xceng = (xbg + xeg)/2.0 ++yceng = ycenl ++zceng = zcenl ++ ++# typical cell size ++dx = ( xe - xb ) / Nx ++dy = ( ye - yb ) / Ny ++dz = ( ze - zb ) / Nz ++#print(dx) ++# time step ++ ++# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) ++SF = 60 ++ ++# Critical time-step ++tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) ++ ++# making Nt divisible by SF ++# tendA = 1.5 * tc ++tend = 1.2 * tc ++ ++# 1 - ensure NtA is sufficient to go a little beyond tendA ++# NtA = int( tendA // dt + 1 ) ++ ++# Array of saves. it is the same as Nt/Sf = t_step_save ++# AS = int( NtA // SF + 1 ) ++ ++# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) ++# Nt = AS * SF ++Nt = int(10E3 * tend // tc * Nx / Nx0 + 1) ++#print(Nt) ++dt = tend / Nt ++ ++AS = int( Nt//SF ) ++ ++# Total physical time ++# tend = Nt * dt ++ ++# Configuring case dictionary ================================================== ++print(json.dumps({ ++ # Logistics ================================================ ++ 'run_time_info': 'T', ++ # ========================================================== ++ # Computational Domain Parameters ========================== ++ 'x_domain%beg' : xb, ++ 'x_domain%end' : xe, ++ 'y_domain%beg' : yb, ++ 'y_domain%end' : ye, ++ 'z_domain%beg' : zb, ++ 'z_domain%end' : ze, ++ 'stretch_x' : 'F', ++ 'loops_x' : 1, ++ 'a_x' : 4.0E0, ++ 'x_a' : -2.0*R0, ++ 'x_b' : 2.0*R0, ++ 'stretch_y' : 'F', ++ 'loops_y' : 1, ++ 'a_y' : 4.0E0, ++ 'y_a' : -2.0*R0, ++ 'y_b' : 2.0*R0, ++ 'stretch_z' : 'F', ++ 'loops_z' : 1, ++ 'a_z' : 4.0E0, ++ 'z_a' : -2.0*R0, ++ 'z_b' : 2.0*R0, ++ 'cyl_coord' : 'F', ++ 'm' : Nx, ++ 'n' : Ny, ++ 'p' : Nz, ++ 'dt' : dt, ++ 't_step_start' : 0, ++ 't_step_stop' : Nt, ++ 't_step_save' : AS, ++ # ========================================================== ++ # Simulation Algorithm Parameters ========================== ++ 'num_patches' : 3, ++ 'model_eqns' : 3, ++ 'num_fluids' : 4, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'T', ++ 'mixture_err' : 'T', ++ 'relax' : 'T', ++ 'relax_model' : 6, ++ 'palpha_eps' : 1.0E-6, ++ 'ptgalpha_eps' : 1.0E-2, ++ 'time_stepper' : 3, ++ 'weno_order' : 3, ++ 'weno_eps' : 1.0E-16, ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'F', ++ 'riemann_solver' : 2, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -6, #-2, ++ 'bc_x%end' : -6, ++ 'bc_y%beg' : -2, ++ 'bc_y%end' : -6, ++ 'bc_z%beg' : -2, ++ 'bc_z%end' : -6, ++ # ========================================================== ++ # Formatted Database Files Structure Parameters ============ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt':'T', ++ 'parallel_io' :'T', ++ # ========================================================== ++ # Patch 1: High pressured water ============================ ++ # Specify the cubic water background grid geometry ++ 'patch_icpp(1)%geometry' : 9, ++ 'patch_icpp(1)%x_centroid' : xcenl, ++ 'patch_icpp(1)%y_centroid' : ycenl, ++ 'patch_icpp(1)%z_centroid' : zcenl, ++ 'patch_icpp(1)%length_x' : lenx, ++ 'patch_icpp(1)%length_y' : leny, ++ 'patch_icpp(1)%length_z' : lenz, ++ 'patch_icpp(1)%vel(1)' : 0.0E+00, ++ 'patch_icpp(1)%vel(2)' : 0.0E+00, ++ 'patch_icpp(1)%vel(3)' : 0.0E+00, ++ 'patch_icpp(1)%pres' : p01, ++ 'patch_icpp(1)%alpha_rho(1)' : liq_wl * rho0wl1, ++ 'patch_icpp(1)%alpha_rho(2)' : liq_wv * rho0wv1, ++ 'patch_icpp(1)%alpha_rho(3)' : liq_wa * rho0wa1, ++ 'patch_icpp(1)%alpha_rho(4)' : liq_wg * rho0wg1, ++ 'patch_icpp(1)%alpha(1)' : liq_wl, ++ 'patch_icpp(1)%alpha(2)' : liq_wv, ++ 'patch_icpp(1)%alpha(3)' : liq_wa, ++ 'patch_icpp(1)%alpha(4)' : liq_wg, ++ # ========================================================== ++ # Patch 2: (Vapor) Bubble ================================== ++ 'patch_icpp(2)%geometry' : 8, ++ 'patch_icpp(2)%x_centroid' : xcenb, ++ 'patch_icpp(2)%y_centroid' : ycenb, ++ 'patch_icpp(2)%z_centroid' : zcenb, ++ 'patch_icpp(2)%radius' : R0, ++ 'patch_icpp(2)%vel(1)' : 0.0E+00, ++ 'patch_icpp(2)%vel(2)' : 0.0E+00, ++ 'patch_icpp(2)%vel(3)' : 0.0E+00, ++ 'patch_icpp(2)%pres' : p02, ++ 'patch_icpp(2)%alpha_rho(1)' : bub_wl * rho0wl2, ++ 'patch_icpp(2)%alpha_rho(2)' : bub_wv * rho0wv2, ++ 'patch_icpp(2)%alpha_rho(3)' : bub_wa * rho0wa2, ++ 'patch_icpp(2)%alpha_rho(4)' : bub_wg * rho0wg2, ++ 'patch_icpp(2)%alpha(1)' : bub_wl, ++ 'patch_icpp(2)%alpha(2)' : bub_wv, ++ 'patch_icpp(2)%alpha(3)' : bub_wa, ++ 'patch_icpp(2)%alpha(4)' : bub_wg, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ # ========================================================== ++ # Patch 3: Gel Object ====================================== ++ 'patch_icpp(3)%geometry' : 9, ++ 'patch_icpp(3)%x_centroid' : xceng, ++ 'patch_icpp(3)%y_centroid' : yceng, ++ 'patch_icpp(3)%z_centroid' : zceng, ++ 'patch_icpp(3)%length_x' : lenxg, ++ 'patch_icpp(3)%length_y' : lenyg, ++ 'patch_icpp(3)%length_z' : lenzg, ++ 'patch_icpp(3)%vel(1)' : 0.0E+00, ++ 'patch_icpp(3)%vel(2)' : 0.0E+00, ++ 'patch_icpp(3)%vel(3)' : 0.0E+00, ++ 'patch_icpp(3)%pres' : p03, ++ 'patch_icpp(3)%alpha_rho(1)' : gel_wl * rho0wl2, ++ 'patch_icpp(3)%alpha_rho(2)' : gel_wv * rho0wv2, ++ 'patch_icpp(3)%alpha_rho(3)' : gel_wa * rho0wa2, ++ 'patch_icpp(3)%alpha_rho(4)' : gel_wg * rho0wg2, ++ 'patch_icpp(3)%alpha(1)' : gel_wl, ++ 'patch_icpp(3)%alpha(2)' : gel_wv, ++ 'patch_icpp(3)%alpha(3)' : gel_wa, ++ 'patch_icpp(3)%alpha(4)' : gel_wg, ++ 'patch_icpp(3)%alter_patch(1)' : 'T', ++ # ========================================================== ++ # Fluids Physical Parameters =============================== ++ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), ++ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), ++ 'fluid_pp(1)%cv' : cvwl, ++ 'fluid_pp(1)%qv' : qvwl, ++ 'fluid_pp(1)%qvp' : qvpwl, ++ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), ++ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), ++ 'fluid_pp(2)%cv' : cvwv, ++ 'fluid_pp(2)%qv' : qvwv, ++ 'fluid_pp(2)%qvp' : qvpwv, ++ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gamwa - 1 ), ++ 'fluid_pp(3)%pi_inf' : gamwa * pia / ( gamwa - 1 ), ++ 'fluid_pp(3)%cv' : cva, ++ 'fluid_pp(3)%qv' : qvwa, ++ 'fluid_pp(3)%qvp' : qvpwa, ++ 'fluid_pp(4)%gamma' : 1.0E+00 / ( gamwg - 1), ++ 'fluid_pp(4)%pi_inf' : gamwg * pig / ( gamwg - 1), ++ 'fluid_pp(4)%cv' : cvg, ++ 'fluid_pp(4)%qv' : qvwg, ++ 'fluid_pp(4)%qvp' : qvpwg, ++ # ========================================================== ++})) +diff --git a/examples/3D_hyperelasticity/hyper_gel.py b/examples/3D_hyperelasticity/hyper_gel.py +new file mode 100644 +index 00000000..09782de4 +--- /dev/null ++++ b/examples/3D_hyperelasticity/hyper_gel.py +@@ -0,0 +1,312 @@ ++import math ++import json ++#need quadrant and collapse near hypoelastic wall ++ ++## Define characteristic values for the sim ++Ri = 230.4E-6 ++# temperature ++T = (10*101325+1.0E+09)/(1000*(2.35-1)*1816) ++# print("T :: ",T) ++rhog = 1 ++Pb = 3550 #Pb = 101325 ++Pl = 101325 #Pl = 20*101325 ++Po = Pl ++Pi_inf_l = 1.0E+09 ++Pi_inf_b = 0.0E+00 ++Pi_inf_o = 1.1754E+09 ++ ++## fluid properties ++# liquid ++nl = 2.35E+00 ++cv_l = 1816 ++rhol = (Pl+Pi_inf_l)/((nl-1)*cv_l*T) ++# object ++obj_rhol = rhol ++cv_o = cv_l ++rhoo = 1060 ++no = 2.35 ++#no = 1.19E+00 ++muo = 0.060E+00 ++# gas ++ng = 1.47E+00 ++ ++# alpha seeding fractions ++bub_wl = 1.0E-12 ++bub_wo = 1.0E-12 ++bub_wg = 1 - bub_wl - bub_wo ++liq_wo = 1.0E-12 ++liq_wg = 1.0E-12 ++liq_wl = 1 - liq_wo - liq_wg ++obj_wl = 1.0E-12 ++obj_wg = 1.0E-12 ++obj_wo = 1 - obj_wl - obj_wg ++ ++Gl = 0. ++Gg = 0. ++Go = 0.57E+03 #1.0933E+04 ++ ++## mixture values in the liquid ++#rhoml = (alpha1-alph_eps)*rhol+alph_eps*rhog ++#pi_inf_m = (alpha1-alph_eps)*Pi_inf_l ++#nml = (alpha1-alph_eps)*nl+alph_eps*ng ++cl = (nl*(Pl+Pi_inf_l)/rhol)**(0.5) ++rhoml = liq_wl*rhol + liq_wg*rhog + liq_wo*rhoo ++ ++## Defining Characteristic Values ++Rc = Ri ++rhoc = rhol ++uc = (Pl/rhol)**(0.5E+00) ++ucc = (Pl/rhoml)**(0.5E+00) ++# characteristic collapse time, change later to prevent horrific confusion ++tc = Ri/uc ++Pc = rhoc*uc**(2.0E+00) ++ ++## Non-Dimensionalizing values using characteristic values ++Rin = Ri/Rc ++rholn = rhol/rhoc ++rhogn = rhog/rhoc ++rhoon = rhoo/rhoc ++Pln = Pl/Pc ++Pbn = Pb/Pc ++Pon = Po/Pc ++tcn = tc/tc ++Pi_inf_ln = Pi_inf_l/Pc ++clc = cl/uc ++sod_nd = 2.17 ++#clmc = clm/ucc ++Pi_inf_on = Pi_inf_o/Pc ++ ++# Un comment if dimensional ++#Rin = Ri ++#rholn = rhol ++#rhogn = rhog ++#rhoon = rhoo ++#Pln = Pl ++#Pbn = Pb/rhoo ++#Pon = Po ++#tcn = tc ++#Pi_inf_ln = Pi_inf_l ++#leng = domain_length ++#clc = cl ++#sod_nd = sod ++ ++## Non-Dimensional Numbers ++#Rel = rhol*uc*2*Rin/mulc ++#Reb = rhog*uc*2*Rin/mubc ++Rel = 0 ++Reb = 0 ++Reo = rhoo*uc*2/muo ++Ma = uc/cl ++Co = Pl/Go ++iCo = 1/Co ++ ++## GEOMETRY:: Grid Specifications ++lengx = 8.0E+00 ++lengy = 3.0E+00 ++lengz = 3.0E+00 ++CFL = 0.3 ++PPBR = 16 #92 ++x_beg = -5.0E+00 ++x_end = 3.0E+00 ++y_beg = 0.0E+00 ++y_end = lengy ++z_beg = 0.0E+00 ++z_end = lengz ++Nx = PPBR*lengx ++Ny = PPBR*lengy ++Nz = PPBR*lengz ++delta_x = lengx/Nx ++delta_t = CFL*delta_x/clc ++ ++#print("NX :: ",Nx,", NY :: ",Ny,", NZ :: ",Nz) ++ ++#delta_t_c = 0.185*delta_x/clmc ++#print(delta_t_c) ++ ++Nt = int(1.7*tcn/delta_t) ++# liquid centroid, patch 1 ++x_centroidl = x_beg/(2.0E+00) ++y_centroidl = (y_end+y_beg)/(2.0E+00) ++z_centroidl = (z_end+z_beg)/(2.0E+00) ++# bubble centroid, patch 2 ++x_centroidb = -sod_nd ++y_centroidb = 0.0 ++z_centroidb = 0.0 ++# objective centroid, patch 3 ++x_centroido = x_end/2 ++y_centroido = (y_end+y_beg)/(2.0E+00) ++z_centroido = (z_end+z_beg)/(2.0E+00) ++ ++# Configuring case dictionary ++print(json.dumps({ ++ # Logistics ================================================ ++ 'run_time_info' : 'T', ++ 'sim_data' : 'T', ++ # ========================================================== ++ ++ # Computational Domain Parameters ========================== ++ 'x_domain%beg' : x_beg, ++ 'x_domain%end' : x_end, ++ 'y_domain%beg' : y_beg, ++ 'y_domain%end' : y_end, ++ 'z_domain%beg' : z_beg, ++ 'z_domain%end' : z_end, ++ 'm' : int(Nx), ++ 'n' : int(Ny), ++ 'p' : int(Nz), ++ 'cyl_coord' : 'F', ++ 'dt' : delta_t, ++ 't_step_start' : 0, ++ 't_step_stop' : Nt, ++ 't_step_save' : int(5),#int(Nt/150), ++# ========================================================== ++ ++ # Simulation Algorithm Parameters ========================== ++ 'num_patches' : 3, ++ 'model_eqns' : 2, ++ 'hypoelasticity' : 'F', ++ 'hyperelasticity' : 'T', ++ 'pre_stress' : 'F', ++ 'alt_soundspeed' : 'F', ++ 'num_fluids' : 3, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'F', ++ 'mixture_err' : 'T', ++ 'time_stepper' : 3, ++ 'weno_order' : 5, ++ 'weno_eps' : 1.E-16, ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'T', ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'riemann_solver' : 1, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -6, #-16,#-2 ++ 'bc_x%end' : -6, ++ 'bc_y%beg' : -2, ++ 'bc_y%end' : -6, ++ 'bc_z%beg' : -2, ++ 'bc_z%end' : -6, ++ 'stretch_x' : 'F', ++ 'stretch_y' : 'F', ++ 'stretch_z' : 'F', ++ 'a_x' : 4.0E+00, ++ 'x_a' : -1.5E+00-sod_nd, ++ 'x_b' : 2.5E+00, ++ #'loops_x' : 0, ++ 'a_y' : 4.0E+00, ++ 'y_a' : -1.5E+00, ++ 'y_b' : 1.5E+00, ++ #'loops_y' : 0, ++ 'a_z' : 4.0E+00, ++ 'z_a' : -1.5E+00, ++ 'z_b' : 1.5E+00, ++ #'loops_z' : 0, ++ # ========================================================== ++ ++ # Formatted Database Files Structure Parameters ============ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt' :'T', ++ 'parallel_io' :'T', ++ 'probe_wrt' :'T', ++ 'fd_order' : 1, ++ 'num_probes' : 1, ++ 'probe(1)%x' : 0., ++ 'probe(1)%y' : 0., ++ 'probe(1)%z' : 0., ++ # ========================================================== ++ ++ # Patch 1: Background ============================ ++ 'patch_icpp(1)%geometry' : 9,# for 3D ++ 'patch_icpp(1)%x_centroid' : x_centroidl, #100*x_centroidl, ++ 'patch_icpp(1)%y_centroid' : y_centroidl, #100*y_centroidl, ++ 'patch_icpp(1)%z_centroid' : z_centroidl, #100*z_centroidl, ++ 'patch_icpp(1)%length_x' : lengx, #200*lengx, ++ 'patch_icpp(1)%length_y' : lengy, #200*lengy, ++ 'patch_icpp(1)%length_z' : lengz, #200*lengz, ++ 'patch_icpp(1)%vel(1)' : 0.E+00, ++ 'patch_icpp(1)%vel(2)' : 0.E+00, ++ 'patch_icpp(1)%vel(3)' : 0.E+00, ++ 'patch_icpp(1)%pres' : Pln, ++ 'patch_icpp(1)%alpha_rho(1)' : liq_wl*rholn, ++ 'patch_icpp(1)%alpha_rho(2)' : liq_wg*rhogn, ++ 'patch_icpp(1)%alpha_rho(3)' : liq_wo*rhoon, ++ 'patch_icpp(1)%alpha(1)' : liq_wl, ++ 'patch_icpp(1)%alpha(2)' : liq_wg, ++ 'patch_icpp(1)%alpha(3)' : liq_wo, ++ # ========================================================== ++ # Patch 2: Bubble ====================================== ++ # Specify the spherical gas bubble grid geometry ++ 'patch_icpp(2)%geometry' : 8,# for 3D ++ 'patch_icpp(2)%smoothen' : 'T', ++ 'patch_icpp(2)%smooth_patch_id' : 1, ++ 'patch_icpp(2)%smooth_coeff' : 4.0E+00, ++ 'patch_icpp(2)%x_centroid' : x_centroidb, ++ 'patch_icpp(2)%y_centroid' : y_centroidb, ++ 'patch_icpp(2)%z_centroid' : z_centroidb, ++ 'patch_icpp(2)%radius' : Rin, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ # Specify the patch primitive variables ++ 'patch_icpp(2)%vel(1)' : 0.E+00, ++ 'patch_icpp(2)%vel(2)' : 0.E+00, ++ 'patch_icpp(2)%vel(3)' : 0.E+00, ++ 'patch_icpp(2)%pres' : Pbn, ++ 'patch_icpp(2)%alpha_rho(1)' : bub_wl*rholn, ++ 'patch_icpp(2)%alpha_rho(2)' : bub_wg*rhogn, ++ 'patch_icpp(2)%alpha_rho(3)' : bub_wo*rhoon, ++ 'patch_icpp(2)%alpha(1)' : bub_wl, ++ 'patch_icpp(2)%alpha(2)' : bub_wg, ++ 'patch_icpp(2)%alpha(3)' : bub_wo, ++ # ========================================================== ++ # Patch 3: Gel =========================================== ++ # Specify the gel grid geometry ++ 'patch_icpp(3)%geometry' : 9,# for 3D ++ 'patch_icpp(3)%x_centroid' : x_centroido, #100*x_centroido, ++ 'patch_icpp(3)%y_centroid' : y_centroido, #100*y_centroido, ++ 'patch_icpp(3)%z_centroid' : z_centroido, #100*z_centroido, ++ 'patch_icpp(3)%length_x' : 3.0E+00, #100*lengx, ++ 'patch_icpp(3)%length_y' : lengy, #200*lengy, ++ 'patch_icpp(3)%length_z' : lengz, #200*lengz, ++ 'patch_icpp(3)%alter_patch(1)' : 'T', ++ # Specify the patch primitive variables ++ 'patch_icpp(3)%vel(1)' : 0.E+00, ++ 'patch_icpp(3)%vel(2)' : 0.E+00, ++ 'patch_icpp(3)%vel(3)' : 0.E+00, ++ 'patch_icpp(3)%pres' : Pon, ++ 'patch_icpp(3)%alpha_rho(1)' : obj_wl*rholn, ++ 'patch_icpp(3)%alpha_rho(2)' : obj_wg*rhogn, ++ 'patch_icpp(3)%alpha_rho(3)' : obj_wo*rhoon, ++ 'patch_icpp(3)%alpha(1)' : obj_wl, ++ 'patch_icpp(3)%alpha(2)' : obj_wg, ++ 'patch_icpp(3)%alpha(3)' : obj_wo, ++ # ========================================================== ++ ++ ++ # Fluids Physical Parameters =============================== ++ 'fluid_pp(1)%gamma' : 1./(nl-1.), ++ 'fluid_pp(1)%pi_inf' : nl*Pi_inf_ln/(nl-1.), ++ 'fluid_pp(1)%G' : Gl, ++ 'fluid_pp(2)%gamma' : 1./(ng-1.), ++ 'fluid_pp(2)%pi_inf' : 0.0E+00, ++ 'fluid_pp(2)%G' : Gg, ++ 'fluid_pp(3)%gamma' : 1./(no-1.), ++ 'fluid_pp(3)%pi_inf' : no*Pi_inf_on/(no-1.), ++ 'fluid_pp(3)%G' : iCo, ++ 'fluid_pp(1)%qv' : 0.0E+00, ++ 'fluid_pp(1)%qvp' : 0.0E+00, ++ 'fluid_pp(2)%qv' : 0.0E+00, ++ 'fluid_pp(2)%qvp' : 0.0E+00, ++ 'fluid_pp(3)%qv' : 0.0E+00, ++ 'fluid_pp(3)%qvp' : 0.0E+00, ++# 'fluid_pp(1)%Re(1)' : Rel, ++# 'fluid_pp(2)%Re(1)' : Reb, ++# 'fluid_pp(3)%Re(1)' : Reo, ++ # ===========++============================================= ++})) ++ ++# ============================================================================== ++ ++ +diff --git a/examples/3D_phasechange_bubble/case.py b/examples/3D_phasechange_bubble/case.py +new file mode 100644 +index 00000000..047c8655 +--- /dev/null ++++ b/examples/3D_phasechange_bubble/case.py +@@ -0,0 +1,300 @@ ++#!/usr/bin/env python3 ++import math, json ++ ++## 1 FOR BACKGROUND, 2 FOR BUBBLE ++# Pressure [Pa] ++p01 = 5E6 ++p02 = 3550 ++ ++# Temperature [K] ++T01 = 298.15 ++T02 = 298.15 ++#T02 = 7.914 ++ ++#### FLUID PROPERTIES #### ++ ++### liquid water ### ++# pi infty ++piwl = 1.0E+09 ++# qv ++qvwl = -1167000 ++# qv' ++qvpwl = 0.0E0 ++# cv ++cvwl = 1816 ++# cp ++cpwl = 4267 ++# gamma ++gamwl = cpwl / cvwl ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) ++rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) ++ ++# speed of sound FOR ++c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) ++c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) ++ ++# part for Gases - relations from IMR ++Ru = 8.3144598 # Universal gas constant (J/mol-K) ++ ++### Vapor water ### ++Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) ++# gamma ++gamwv = 1.4 ++# cp ++cpwv = Rv * gamwv/(gamwv-1) ++# cv ++cvwv = cpwv/gamwv ++# pi infinity ++piwv = 0.0E0 ++# qv ++qvwv = 2030000 ++# qv' ++qvpwv = -23400 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) ++rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) ++ ++# speed of sound ++c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) ++c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) ++ ++### Air ### ++ ++Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) ++# gamma ++gama = 1.4 ++# cp ++cpa = Ra * gama/(gama-1) ++# cv ++cva = cpa/gama ++# pi infinity ++pia = 0.0E0 ++# qv ++qva = 0.0E0 ++# qv' ++qvpa = 0.0E0 ++ ++## FOR PATCHES 1 & 2 ## ++ ++# density ++rho0a1 = (p01 + pia)/((gama-1)*cva*T01) ++rho0a2 = (p02 + pia)/((gama-1)*cva*T02) ++ ++# Speed of sound ++c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) ++c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) ++ ++## SHOCK RELATIONS ++p02Op01 = p02 / p01 ++ ++# Mach number of the shocked region - this should agree with Min, if everything is correct ++Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) ++ ++# shock speed ++ss = Ms * c_a1 ++ ++### volume fractions for each of the patches ### ++C0 = 0.25 # vapor concentration for IMR ++ ++# water liquid ++awl1 = 1.00E00-2.00E-12 ++awl2 = 1.00E-12 ++# water vapor ++awv1 = 1.00E-12 ++awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) ++# air ++aa1 = 1.0 - awl1 - awv1 ++aa2 = 1.0 - awl2 - awv2 ++ ++## SIMULATION PARAMETERS ++ ++# CFL ++cfl = 0.50 ++ ++# Bubble Initial Radius ++R0 = 30E-06 ++ ++# number of elements ++Nx0 = 400 ++Nx = 199 ++Ny = 199 ++Nz = 199 ++ ++# domain boundaries ++xb = 0.00 ++xe = 120E-6 ++ ++yb = 0.00 ++ye = 120E-6 ++ ++zb = 0.00 ++ze = 120E-6 ++ ++# typical cell size ++dx = ( xe - xb ) / Nx ++dy = ( ye - yb ) / Ny ++dz = ( ze - zb ) / Nz ++ ++# time step ++ ++# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) ++SF = 200 ++ ++# Critical time-step ++tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) ++ ++# making Nt divisible by SF ++# tendA = 1.5 * tc ++tend = 1.2 * tc ++ ++# 1 - ensure NtA is sufficient to go a little beyond tendA ++# NtA = int( tendA // dt + 1 ) ++ ++# Array of saves. it is the same as Nt/Sf = t_step_save ++# AS = int( NtA // SF + 1 ) ++ ++# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) ++# Nt = AS * SF ++Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) ++ ++dt = tend / Nt ++ ++AS = int( Nt//SF ) ++ ++# Total physical time ++# tend = Nt * dt ++ ++# Configuring case dictionary ================================================== ++print(json.dumps({ ++ # Logistics ================================================ ++ 'run_time_info': 'T', ++ # ========================================================== ++ # Computational Domain Parameters ========================== ++ 'x_domain%beg' : xb, ++ 'x_domain%end' : xe, ++ 'y_domain%beg' : yb, ++ 'y_domain%end' : ye, ++ 'z_domain%beg' : zb, ++ 'z_domain%end' : ze, ++ 'stretch_x' : 'T', ++ 'loops_x' : 3, ++ 'a_x' : 4.0E0, ++ 'x_a' : -2.0*R0, ++ 'x_b' : 2.0*R0, ++ 'stretch_y' : 'T', ++ 'loops_y' : 3, ++ 'a_y' : 4.0E0, ++ 'y_a' : -2.0*R0, ++ 'y_b' : 2.0*R0, ++ 'stretch_z' : 'T', ++ 'loops_z' : 3, ++ 'a_z' : 4.0E0, ++ 'z_a' : -2.0*R0, ++ 'z_b' : 2.0*R0, ++ 'cyl_coord' : 'F', ++ 'm' : Nx, ++ 'n' : Ny, ++ 'p' : Nz, ++ 'dt' : dt, ++ 't_step_start' : 0, ++ 't_step_stop' : Nt, ++ 't_step_save' : AS, ++ # ========================================================== ++ # Simulation Algorithm Parameters ========================== ++ 'num_patches' : 2, ++ 'model_eqns' : 3, ++ 'num_fluids' : 3, ++ 'adv_alphan' : 'T', ++ 'mpp_lim' : 'T', ++ 'mixture_err' : 'T', ++ 'relax' : 'T', ++ 'relax_model' : 6, ++ 'palpha_eps' : 1.0E-6, ++ 'ptgalpha_eps' : 1.0E-2, ++ 'time_stepper' : 3, ++ 'weno_order' : 3, ++ 'weno_eps' : 1.0E-32, ++ 'weno_Re_flux' : 'F', ++ 'weno_avg' : 'F', ++ 'mapped_weno' : 'T', ++ 'null_weights' : 'F', ++ 'mp_weno' : 'F', ++ 'riemann_solver' : 2, ++ 'wave_speeds' : 1, ++ 'avg_state' : 2, ++ 'bc_x%beg' : -2, ++ 'bc_x%end' : -6, ++ 'bc_y%beg' : -2, ++ 'bc_y%end' : -6, ++ 'bc_z%beg' : -2, ++ 'bc_z%end' : -6, ++ # ========================================================== ++ # Formatted Database Files Structure Parameters ============ ++ 'format' : 1, ++ 'precision' : 2, ++ 'prim_vars_wrt':'T', ++ 'parallel_io' :'T', ++ # ========================================================== ++ # Patch 1: High pressured water ============================ ++ # Specify the cubic water background grid geometry ++ 'patch_icpp(1)%geometry' : 9, ++ 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, ++ 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, ++ 'patch_icpp(1)%z_centroid' : ( ze + zb ) * 500000 / 100, ++ 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, ++ 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, ++ 'patch_icpp(1)%length_z' : ( ze - zb ) * 1000000 / 100, ++ 'patch_icpp(1)%vel(1)' : 0.0E+00, ++ 'patch_icpp(1)%vel(2)' : 0.0E+00, ++ 'patch_icpp(1)%vel(3)' : 0.0E+00, ++ 'patch_icpp(1)%pres' : p01, ++ 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, ++ 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, ++ 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, ++ 'patch_icpp(1)%alpha(1)' : awl1, ++ 'patch_icpp(1)%alpha(2)' : awv1, ++ 'patch_icpp(1)%alpha(3)' : aa1, ++ # ========================================================== ++ # Patch 2: (Vapor) Bubble ================================== ++ 'patch_icpp(2)%geometry' : 8, ++ 'patch_icpp(2)%x_centroid' : xb, ++ 'patch_icpp(2)%y_centroid' : yb, ++ 'patch_icpp(2)%z_centroid' : zb, ++ 'patch_icpp(2)%radius' : R0, ++ 'patch_icpp(2)%vel(1)' : 0.0E+00, ++ 'patch_icpp(2)%vel(2)' : 0.0E+00, ++ 'patch_icpp(2)%vel(3)' : 0.0E+00, ++ 'patch_icpp(2)%pres' : p02, ++ 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, ++ 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, ++ 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, ++ 'patch_icpp(2)%alpha(1)' : awl2, ++ 'patch_icpp(2)%alpha(2)' : awv2, ++ 'patch_icpp(2)%alpha(3)' : aa2, ++ 'patch_icpp(2)%alter_patch(1)' : 'T', ++ # ========================================================== ++ # Fluids Physical Parameters =============================== ++ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), ++ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), ++ 'fluid_pp(1)%cv' : cvwl, ++ 'fluid_pp(1)%qv' : qvwl, ++ 'fluid_pp(1)%qvp' : qvpwl, ++ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), ++ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), ++ 'fluid_pp(2)%cv' : cvwv, ++ 'fluid_pp(2)%qv' : qvwv, ++ 'fluid_pp(2)%qvp' : qvpwv, ++ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), ++ 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), ++ 'fluid_pp(3)%cv' : cva, ++ 'fluid_pp(3)%qv' : qva, ++ 'fluid_pp(3)%qvp' : qvpa, ++ # ========================================================== ++})) +diff --git a/run_mfc.sh b/run_mfc.sh +new file mode 100755 +index 00000000..fc734bea +--- /dev/null ++++ b/run_mfc.sh +@@ -0,0 +1,14 @@ ++#!/bin/bash ++ ++./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar ++ ++./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar ++ ++./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar ++./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar ++ +diff --git a/src/common/include/inline_conversions.fpp b/src/common/include/inline_conversions.fpp +index a63af61e..c2f0263e 100644 +--- a/src/common/include/inline_conversions.fpp ++++ b/src/common/include/inline_conversions.fpp +@@ -1,17 +1,17 @@ + #:def s_compute_speed_of_sound() +- subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c) ++ subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c, G) + #ifdef CRAY_ACC_WAR + !DIR$ INLINEALWAYS s_compute_speed_of_sound + #else + !$acc routine seq + #endif +- real(kind(0d0)), intent(in) :: pres +- real(kind(0d0)), intent(in) :: rho, gamma, pi_inf +- real(kind(0d0)), intent(in) :: H +- real(kind(0d0)), dimension(num_fluids), intent(in) :: adv +- real(kind(0d0)), intent(in) :: vel_sum +- real(kind(0d0)), intent(out) :: c +- ++ real(kind(0d0)), intent(IN) :: pres ++ real(kind(0d0)), intent(IN) :: rho, gamma, pi_inf ++ real(kind(0d0)), intent(IN) :: H ++ real(kind(0d0)), dimension(num_fluids), intent(IN) :: adv ++ real(kind(0d0)), intent(IN) :: vel_sum ++ real(kind(0d0)), optional, dimension(num_fluids), intent(IN) :: G ++ real(kind(0d0)), intent(OUT) :: c + real(kind(0d0)) :: blkmod1, blkmod2 + + integer :: q +@@ -22,6 +22,7 @@ + blkmod2 = ((gammas(2) + 1d0)*pres + & + pi_infs(2))/gammas(2) + c = (1d0/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2))) ++ + elseif (model_eqns == 3) then + c = 0d0 + !$acc loop seq +@@ -43,6 +44,7 @@ + (pres + pi_inf/(gamma + 1d0))/ & + (rho*(1d0 - adv(num_fluids))) + end if ++ + else + c = ((H - 5d-1*vel_sum)/gamma) + end if +diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp +index 2a15083c..386a844c 100644 +--- a/src/common/m_checker_common.fpp ++++ b/src/common/m_checker_common.fpp +@@ -38,6 +38,7 @@ contains + call s_check_inputs_qbmm_and_polydisperse + if (adv_n) call s_check_inputs_adv_n + if (hypoelasticity) call s_check_inputs_hypoelasticity ++ if (hyperelasticity) call s_check_inputs_hyperelasticity + call s_check_inputs_phase_change + call s_check_inputs_ibm + #endif +@@ -173,12 +174,27 @@ contains + !> Checks constraints on the hypoelasticity parameters. + !! Called by s_check_inputs_common for pre-processing and simulation + subroutine s_check_inputs_hypoelasticity +- if (model_eqns /= 2) then +- call s_mpi_abort('hypoelasticity requires 5-equation model'// & +- '(model_eqns = 2). Exiting ...') ++ !if ((model_eqns /= 2) .or. (model_eqns /= 3)) then ++ if ((model_eqns == 1) .or. (model_eqns == 4)) then ++ call s_mpi_abort('hypoelasticity requires either '// & ++ '5-equation (model_eqns = 2) or '// & ++ '6-equation model (model_eqns = 3). Exiting ...') ++ end if ++ if (hyperelasticity) then ++ call s_mpi_abort('hyperelasticity cannot be true with hypoelasticity. '// & ++ 'Exiting ...') + end if + end subroutine s_check_inputs_hypoelasticity + ++ !> Checks constraints on the hyperelasticity parameters. ++ !! Called by s_check_inputs_common for pre-processing and simulation ++ subroutine s_check_inputs_hyperelasticity ++ if (model_eqns /= 3) then ++ call s_mpi_abort('hyperelasticity requires '// & ++ '6-equation model (model_eqns = 3). Exiting ...') ++ end if ++ end subroutine s_check_inputs_hyperelasticity ++ + !> Checks constraints on the phase change parameters. + !! Called by s_check_inputs_common for pre-processing and simulation + subroutine s_check_inputs_phase_change +diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp +index a506acb9..6f9ab2ff 100644 +--- a/src/common/m_constants.fpp ++++ b/src/common/m_constants.fpp +@@ -7,18 +7,18 @@ module m_constants + character, parameter :: dflt_char = ' ' !< Default string value + + real(kind(0d0)), parameter :: dflt_real = -1d6 !< Default real value +- real(kind(0d0)), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance +- real(kind(0d0)), parameter :: small_alf = 1d-11 !< Small alf tolerance +- real(kind(0d0)), parameter :: pi = 3.141592653589793d0 !< Pi ++ real(kind(0d0)), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance ++ real(kind(0d0)), parameter :: small_alf = 1d-11 !< Small alf tolerance ++ real(kind(0d0)), parameter :: pi = 3.141592653589793d0 !< Pi + real(kind(0d0)), parameter :: verysmall = 1.d-12 !< Very small number + +- integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils +- integer, parameter :: path_len = 400 !< Maximum path length +- integer, parameter :: name_len = 50 !< Maximum name length +- integer, parameter :: dflt_int = -100 !< Default integer value +- integer, parameter :: fourier_rings = 5 !< Fourier filter ring limit +- integer, parameter :: num_fluids_max = 10 !< Maximum number of fluids in the simulation +- integer, parameter :: num_probes_max = 10 !< Maximum number of flow probes in the simulation ++ integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils ++ integer, parameter :: path_len = 400 !< Maximum path length ++ integer, parameter :: name_len = 50 !< Maximum name length ++ integer, parameter :: dflt_int = -100 !< Default integer value ++ integer, parameter :: fourier_rings = 5 !< Fourier filter ring limit ++ integer, parameter :: num_fluids_max = 10 !< Maximum number of fluids in the simulation ++ integer, parameter :: num_probes_max = 10 !< Maximum number of flow probes in the simulation + integer, parameter :: num_patches_max = 10 + integer, parameter :: pathlen_max = 400 + integer, parameter :: nnode = 4 !< Number of QBMM nodes +diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp +index 9ad172cc..cea5f90d 100644 +--- a/src/common/m_derived_types.fpp ++++ b/src/common/m_derived_types.fpp +@@ -142,7 +142,13 @@ module m_derived_types + type(ic_model_parameters) :: model !< Model parameters + + real(kind(0d0)) :: epsilon, beta !< +- !! The spherical harmonics eccentricity parameters. ++ !! The isentropic vortex parameters administrating, respectively, both ++ !! the amplitude of the disturbance as well as its domain of influence. ++ ++ real(kind(0d0)) :: a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 !< ++ !! The parameters needed for the spherical harmonic patch ++ ++ logical :: non_axis_sym + + real(kind(0d0)), dimension(3) :: normal !< + !! Normal vector indicating the orientation of the patch. It is specified +diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp +index b6d48729..a2b77082 100644 +--- a/src/common/m_helper.fpp ++++ b/src/common/m_helper.fpp +@@ -73,8 +73,8 @@ contains + lE = q + end if + +- if (allocated(fd_coeff_s)) deallocate (fd_coeff_s) +- allocate (fd_coeff_s(-fd_number_in:fd_number_in, lb:lE)) ++ if (allocated(fd_coeff_s)) deallocate(fd_coeff_s) ++ allocate(fd_coeff_s(-fd_number_in:fd_number_in, lb:lE)) + + ! Computing the 1st order finite-difference coefficients + if (fd_order_in == 1) then +@@ -83,7 +83,6 @@ contains + fd_coeff_s(0, i) = -1d0/(s_cc(i + 1) - s_cc(i)) + fd_coeff_s(1, i) = -fd_coeff_s(0, i) + end do +- + ! Computing the 2nd order finite-difference coefficients + elseif (fd_order_in == 2) then + do i = lB, lE +@@ -91,7 +90,6 @@ contains + fd_coeff_s(0, i) = 0d0 + fd_coeff_s(1, i) = -fd_coeff_s(-1, i) + end do +- + ! Computing the 4th order finite-difference coefficients + else + do i = lB, lE +@@ -101,7 +99,6 @@ contains + fd_coeff_s(1, i) = -fd_coeff_s(-1, i) + fd_coeff_s(2, i) = -fd_coeff_s(-2, i) + end do +- + end if + + end subroutine s_compute_finite_difference_coefficients +diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp +index f6372322..c13fa233 100644 +--- a/src/common/m_phase_change.fpp ++++ b/src/common/m_phase_change.fpp +@@ -1,11 +1,3 @@ +-!> +-!! @file m_phase_change.fpp +-!! @brief Contains module m_phasechange +- +-#:include 'macros.fpp' +- +-!> @brief This module is used to relax the model equations (6-eqn model) +-!> towards pressure and temperature (6-eqn to 4-eqn), and (if wanted) Gibbs free + !> energies (6-eqn to 4-eqn) equilibrium through an infinitely fast (algebraic) + !> procedure. + module m_phase_change +@@ -356,8 +348,9 @@ contains + + ! Newton Solver for the pT-equilibrium + ns = 0 +- ! change this relative error metric. 1E4 is just arbitrary +- do while ((DABS(pS - pO) > palpha_eps) .and. (DABS((pS - pO)/pO) > palpha_eps/1e4) .or. (ns == 0)) ++ ! change this relative error metric. 1E4 is arbitrary ++ do while ((DABS(pS - pO) > palpha_eps) .and. & ++ (DABS((pS - pO)/pO) > palpha_eps/1d4) .or. (ns == 0)) + + ! increasing counter + ns = ns + 1 +diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp +index 46436cb8..5652470a 100644 +--- a/src/common/m_variables_conversion.fpp ++++ b/src/common/m_variables_conversion.fpp +@@ -22,6 +22,7 @@ module m_variables_conversion + use m_helper_basic !< Functions to compare floating point numbers + + use m_helper ++ + ! ========================================================================== + + implicit none +@@ -145,8 +146,8 @@ contains + else + pres = (pref + pi_inf)* & + (energy/ & +- (rhoref*(1 - alf)) & +- )**(1/gamma + 1) - pi_inf ++ (rhoref*(1.d0 - alf)) & ++ )**(1.d0/gamma + 1.d0) - pi_inf + end if + + if (hypoelasticity .and. present(G)) then +@@ -164,11 +165,7 @@ contains + end if + end do + +- pres = ( & +- energy - & +- 0.5d0*(mom**2.d0)/rho - & +- pi_inf - qv - E_e & +- )/gamma ++ pres = (energy - 0.5d0*(mom**2.d0)/rho - pi_inf - qv - E_e)/gamma + + end if + +@@ -409,7 +406,6 @@ contains + pi_inf = pi_inf + alpha_K(i)*pi_infs(i) + qv = qv + alpha_rho_K(i)*qvs(i) + end do +- + #ifdef MFC_SIMULATION + ! Computing the shear and bulk Reynolds numbers from species analogs + do i = 1, 2 +@@ -427,6 +423,7 @@ contains + #endif + + if (present(G_K)) then ++ !TODO Check our mixture rule? Replace with Cauchy numbers, make code nondimensional + G_K = 0d0 + do i = 1, num_fluids + G_K = G_K + alpha_K(i)*G(i) +@@ -502,6 +499,7 @@ contains + G_K = 0d0 + do i = 1, num_fluids + !TODO: change to use Gs directly here? ++ !TODO: Make this changes as well for GPUs + G_K = G_K + alpha_K(i)*G(i) + end do + G_K = max(0d0, G_K) +@@ -679,7 +677,6 @@ contains + do i = 1, nb + bubrs(i) = bub_idx%rs(i) + end do +- + !$acc update device(bubrs) + end if + +@@ -862,7 +859,7 @@ contains + + integer :: i, j, k, l, q !< Generic loop iterators + +- real(kind(0.d0)) :: ntmp ++ real(kind(0d0)) :: ntmp + + #:if MFC_CASE_OPTIMIZATION + #ifndef MFC_SIMULATION +@@ -880,7 +877,7 @@ contains + end if + #:endif + +- !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp) ++ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) + do l = izb, ize + do k = iyb, iye + do j = ixb, ixe +@@ -900,7 +897,7 @@ contains + if (model_eqns /= 4) then + #ifdef MFC_SIMULATION + ! If in simulation, use acc mixture subroutines +- if (hypoelasticity) then ++ if (elasticity) then + call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & + alpha_rho_K, Re_K, j, k, l, G_K, Gs) + else if (bubbles) then +@@ -912,7 +909,7 @@ contains + end if + #else + ! If pre-processing, use non acc mixture subroutines +- if (hypoelasticity) then ++ if (elasticity) then + call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & + rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) + else +@@ -988,7 +985,7 @@ contains + qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & + /rho_K + ! subtracting elastic contribution for pressure calculation +- if (G_K > 1000) then !TODO: check if stable for >0 ++ if (G_K .gt. verysmall) then !TODO: check if stable for >0 + qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & + ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K + ! extra terms in 2 and 3D +@@ -1002,6 +999,17 @@ contains + end do + end if + ++ if (hyperelasticity) then ++ !$acc loop seq ++ do i = strxb, strxe ++ qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K ++ end do ++ !$acc loop seq ++ do i = xibeg, xiend ++ qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K ++ end do ++ end if ++ + !$acc loop seq + do i = advxb, advxe + qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) +@@ -1016,7 +1024,9 @@ contains + end do + !$acc end parallel loop + +- end subroutine s_convert_conservative_to_primitive_variables ++ !print *, 'I got here AA' ++ ++ end subroutine s_convert_conservative_to_primitive_variables ! --------- + + !> The following procedure handles the conversion between + !! the primitive variables and the conservative variables. +@@ -1029,13 +1039,8 @@ contains + subroutine s_convert_primitive_to_conservative_variables(q_prim_vf, & + q_cons_vf) + +- type(scalar_field), & +- dimension(sys_size), & +- intent(in) :: q_prim_vf +- +- type(scalar_field), & +- dimension(sys_size), & +- intent(inout) :: q_cons_vf ++ type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf ++ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf + + ! Density, specific heat ratio function, liquid stiffness function + ! and dynamic pressure, as defined in the incompressible flow sense, +@@ -1144,10 +1149,10 @@ contains + end if + + if (hypoelasticity) then +- do i = stress_idx%beg, stress_idx%end ++ do i = strxb, strxe + q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) + ! adding elastic contribution +- if (G > 1000) then ++ if (G .gt. verysmall) then + q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & + (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) + ! extra terms in 2 and 3D +@@ -1161,6 +1166,19 @@ contains + end do + end if + ++ ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 ++ if (hyperelasticity) then ++ ! adding the elastic contribution ++ ! Multiply \tau to \rho \tau ++ do i = strxb, strxe ++ q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) ++ end do ++ ! Multiply \xi to \rho \xi ++ do i = xibeg, xiend ++ q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) ++ end do ++ end if ++ + if (.not. f_is_default(sigma)) then + q_cons_vf(c_idx)%sf(j, k, l) = q_prim_vf(c_idx)%sf(j, k, l) + end if +@@ -1168,7 +1186,6 @@ contains + end do + end do + end do +- + #else + if (proc_rank == 0) then + call s_mpi_abort('Conversion from primitive to '// & +@@ -1176,7 +1193,6 @@ contains + 'implemented. Exiting ...') + end if + #endif +- + end subroutine s_convert_primitive_to_conservative_variables + + !> The following subroutine handles the conversion between +@@ -1252,7 +1268,7 @@ contains + end do + + pres_K = qK_prim_vf(j, k, l, E_idx) +- if (hypoelasticity) then ++ if (elasticity) then + call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, & + alpha_K, alpha_rho_K, Re_K, & + j, k, l, G_K, Gs) +@@ -1310,10 +1326,11 @@ contains + end do + end do + #endif +- + end subroutine s_convert_primitive_to_flux_variables + +- subroutine s_finalize_variables_conversion_module ++ subroutine s_finalize_variables_conversion_module() ! ------------------ ++ ++ integer :: i !< Generic loop iterators + + ! Deallocating the density, the specific heat ratio function and the + ! liquid stiffness function +diff --git a/src/post_process/m_data_input.f90 b/src/post_process/m_data_input.f90 +index 567816f7..bbd063df 100644 +--- a/src/post_process/m_data_input.f90 ++++ b/src/post_process/m_data_input.f90 +@@ -370,7 +370,7 @@ contains + NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) + + ! Read the data for each variable +- if (bubbles .or. hypoelasticity) then ++ if (bubbles .or. elasticity) then + do i = 1, sys_size + var_MOK = int(i, MPI_OFFSET_KIND) + +@@ -444,7 +444,7 @@ contains + NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) + + ! Read the data for each variable +- if (bubbles .or. hypoelasticity) then ++ if (bubbles .or. elasticity) then + do i = 1, sys_size + var_MOK = int(i, MPI_OFFSET_KIND) + +diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp +index 7aa7e873..e68c021b 100644 +--- a/src/post_process/m_data_output.fpp ++++ b/src/post_process/m_data_output.fpp +@@ -16,6 +16,8 @@ module m_data_output + + use m_global_parameters ! Global parameters for the code + ++ use m_derived_variables !< Procedures used to compute quantities derived ++ + use m_mpi_proxy ! Message passing interface (MPI) module proxy + + use m_compile_specific +@@ -27,9 +29,15 @@ module m_data_output + + private; public :: s_initialize_data_output_module, & + s_open_formatted_database_file, & ++ s_open_intf_data_file, & ++ s_open_energy_data_file, & + s_write_grid_to_formatted_database_file, & + s_write_variable_to_formatted_database_file, & ++ s_write_intf_data_file, & ++ s_write_energy_data_file, & + s_close_formatted_database_file, & ++ s_close_intf_data_file, & ++ s_close_energy_data_file, & + s_finalize_data_output_module + + ! Including the Silo Fortran interface library that features the subroutines +@@ -531,7 +539,40 @@ contains + + end subroutine s_open_formatted_database_file + +- subroutine s_write_grid_to_formatted_database_file(t_step) ++ subroutine s_open_intf_data_file() ! ------------------------ ++ ++ character(LEN=path_len + 3*name_len) :: file_path !< ++ !! Relative path to a file in the case directory ++ ++ write (file_path, '(A)') '/intf_data.dat' ++ file_path = trim(case_dir)//trim(file_path) ++ ++ ! Opening the simulation data file ++ open (211, FILE=trim(file_path), & ++ FORM='formatted', & ++ POSITION='append', & ++ STATUS='unknown') ++ ++ end subroutine s_open_intf_data_file ! --------------------------------------- ++ ++ subroutine s_open_energy_data_file() ! ------------------------ ++ ++ character(LEN=path_len + 3*name_len) :: file_path !< ++ !! Relative path to a file in the case directory ++ ++ write (file_path, '(A)') '/eng_data.dat' ++ file_path = trim(case_dir)//trim(file_path) ++ ++ ! Opening the simulation data file ++ open (251, FILE=trim(file_path), & ++ FORM='formatted', & ++ POSITION='append', & ++ STATUS='unknown') ++ ++ end subroutine s_open_energy_data_file ! ---------------------------------------- ++ ++ subroutine s_write_grid_to_formatted_database_file(t_step) ! ----------- ++ + ! Description: The general objective of this subroutine is to write the + ! necessary grid data to the formatted database file, for + ! the current time-step, t_step. The local processor will +@@ -939,7 +980,196 @@ contains + + end subroutine s_write_variable_to_formatted_database_file + +- subroutine s_close_formatted_database_file ++ subroutine s_write_intf_data_file(q_prim_vf) ++ ++ type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf ++ integer :: i, j, k, l, w, cent !< Generic loop iterators ++ integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations ++ real(kind(0d0)), dimension(num_fluids) :: alpha, vol_fluid, xcom, ycom, zcom ++ real(kind=8), parameter :: pi = 4.d0*datan(1.d0) ++ real(kind(0d0)), allocatable :: x_td(:), y_td(:), x_d1(:), y_d1(:), y_d(:), x_d(:) ++ real(kind(0d0)) :: axp, axm, ayp, aym, azm, azp, tgp, euc_d, thres, maxalph_loc, maxalph_glb ++ ++ allocate (x_d1(m*n)) ++ allocate (y_d1(m*n)) ++ counter = 0 ++ maxalph_loc = 0d0 ++ do k = 0, p ++ do j = 0, n ++ do i = 0, m ++ if (q_prim_vf(E_idx + 2)%sf(i, j, k) > maxalph_loc) then ++ maxalph_loc = q_prim_vf(E_idx + 2)%sf(i, j, k) ++ end if ++ end do ++ end do ++ end do ++ ++ call s_mpi_allreduce_max(maxalph_loc, maxalph_glb) ++ if (p > 0) then ++ do l = 0, p ++ if (z_cc(l) < dz(l) .and. z_cc(l) > 0) then ++ cent = l ++ end if ++ end do ++ else ++ cent = 0 ++ end if ++ ++ thres = 0.9d0*maxalph_glb ++ do k = 0, n ++ OLoop: do j = 0, m ++ axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) ++ axm = q_prim_vf(E_idx + 2)%sf(j, k, cent) ++ ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, cent) ++ aym = q_prim_vf(E_idx + 2)%sf(j, k, cent) ++ if ((axp > thres .and. axm < thres) .or. (axp < thres .and. axm > thres) & ++ .or. (ayp > thres .and. aym < thres) .or. (ayp < thres .and. aym > thres)) then ++ if (counter == 0) then ++ counter = counter + 1 ++ x_d1(counter) = x_cc(j) ++ y_d1(counter) = y_cc(k) ++ euc_d = sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2) ++ tgp = sqrt(dx(j)**2 + dy(k)**2) ++ else ++ euc_d = dsqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2) ++ tgp = dsqrt(dx(j)**2 + dy(k)**2) ++ do i = 1, counter ++ if (euc_d < tgp) then ++ cycle OLoop ++ elseif (euc_d > tgp .and. i == counter) then ++ counter = counter + 1 ++ x_d1(counter) = x_cc(j) ++ y_d1(counter) = y_cc(k) ++ ++ end if ++ end do ++ end if ++ end if ++ end do OLoop ++ end do ++ ++ allocate (y_d(counter)) ++ allocate (x_d(counter)) ++ do i = 1, counter ++ y_d(i) = y_d1(i) ++ x_d(i) = x_d1(i) ++ end do ++ root = 0 ++ ++ call s_mpi_gather_data(x_d, counter, x_td, root) ++ call s_mpi_gather_data(y_d, counter, y_td, root) ++ if (proc_rank == 0) then ++ do i = 1, size(x_td) ++ if (i == size(x_td)) then ++ write (211, '(F12.9,1X,F12.9,1X,I4)') & ++ x_td(i), y_td(i), size(x_td) ++ else ++ write (211, '(F12.9,1X,F12.9,1X,F3.1)') & ++ x_td(i), y_td(i), 0d0 ++ end if ++ end do ++ end if ++ ++ end subroutine s_write_intf_data_file ! ----------------------------------- ++ ++ subroutine s_write_energy_data_file(q_prim_vf, q_cons_vf) ++ type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf, q_cons_vf ++ real(kind(0d0)) :: Elk, Egk, Elp, Egint, Vb, Vl, pres_av, Et ++ real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, MaxMa, MaxMa_glb, maxvel, c, Ma, H ++ real(kind(0d0)), dimension(num_dims) :: vel ++ real(kind(0d0)), dimension(num_fluids) :: gammas, pi_infs, adv ++ integer :: i, j, k, l, s !looping indicies ++ integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations ++ ++ Egk = 0d0 ++ Elp = 0d0 ++ Egint = 0d0 ++ Vb = 0d0 ++ maxvel = 0d0 ++ MaxMa = 0d0 ++ Vl = 0d0 ++ Elk = 0d0 ++ Et = 0d0 ++ Vb = 0d0 ++ dV = 0d0 ++ pres_av = 0d0 ++ pres = 0d0 ++ do k = 0, p ++ do j = 0, n ++ do i = 0, m ++ pres = 0d0 ++ dV = dx(i)*dy(j)*dz(k) ++ rho = 0d0 ++ gamma = 0d0 ++ pi_inf = 0d0 ++ pres = q_prim_vf(E_idx)%sf(i, j, k) ++ Egint = Egint + q_prim_vf(E_idx + 2)%sf(i, j, k)*(fluid_pp(2)%gamma*pres)*dV ++ do s = 1, num_dims ++ vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) ++ Egk = Egk + 0.5d0*q_prim_vf(E_idx + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV ++ Elk = Elk + 0.5d0*q_prim_vf(E_idx + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV ++ if (dabs(vel(s)) > maxvel) then ++ maxvel = dabs(vel(s)) ++ end if ++ end do ++ do l = 1, adv_idx%end - E_idx ++ adv(l) = q_prim_vf(E_idx + l)%sf(i, j, k) ++ gamma = gamma + adv(l)*fluid_pp(l)%gamma ++ pi_inf = pi_inf + adv(l)*fluid_pp(l)%pi_inf ++ rho = rho + adv(l)*q_prim_vf(l)%sf(i, j, k) ++ end do ++ ++ H = ((gamma + 1d0)*pres + pi_inf)/rho ++ ++ call s_compute_speed_of_sound(pres, rho, & ++ gamma, pi_inf, & ++ H, adv, 0d0, c) ++ ++ Ma = maxvel/c ++ if (Ma > MaxMa .and. adv(1) > 1.0d0 - 1.0d-10) then ++ MaxMa = Ma ++ end if ++ Vl = Vl + adv(1)*dV ++ Vb = Vb + adv(2)*dV ++ pres_av = pres_av + adv(1)*pres*dV ++ Et = Et + q_cons_vf(E_idx)%sf(i, j, k)*dV ++ end do ++ end do ++ end do ++ ++ tmp = pres_av ++ call s_mpi_allreduce_sum(tmp, pres_av) ++ tmp = Vl ++ call s_mpi_allreduce_sum(tmp, Vl) ++ ++ call s_mpi_allreduce_max(MaxMa, MaxMa_glb) ++ tmp = Elk ++ call s_mpi_allreduce_sum(tmp, Elk) ++ tmp = Egint ++ call s_mpi_allreduce_sum(tmp, Egint) ++ tmp = Egk ++ call s_mpi_allreduce_sum(tmp, Egk) ++ tmp = Vb ++ call s_mpi_allreduce_sum(tmp, Vb) ++ tmp = Et ++ call s_mpi_allreduce_sum(tmp, Et) ++ ++ Elp = pres_av/Vl*Vb ++ if (proc_rank == 0) then ++ write (251, '(10X, 8F24.8)') & ++ Elp, & ++ Egint, & ++ Elk, & ++ Egk, & ++ Et, & ++ Vb, & ++ Vl, & ++ MaxMa_glb ++ end if ++ ++ end subroutine s_write_energy_data_file ++ ++ subroutine s_close_formatted_database_file() ! ------------------------- + ! Description: The purpose of this subroutine is to close any formatted + ! database file(s) that may be opened at the time-step that + ! is currently being post-processed. The root process must +@@ -966,7 +1196,19 @@ contains + + end subroutine s_close_formatted_database_file + +- subroutine s_finalize_data_output_module ++ subroutine s_close_intf_data_file() ! ----------------------- ++ ++ close (211) ++ ++ end subroutine s_close_intf_data_file !--------------------- ++ ++ subroutine s_close_energy_data_file() ! ----------------------- ++ ++ close (251) ++ ++ end subroutine s_close_energy_data_file !--------------------- ++ ++ subroutine s_finalize_data_output_module() ! ------------------------- + ! Description: Deallocation procedures for the module + + ! Deallocating the generic storage employed for the flow variable(s) +diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp +index 0e5401f1..fa6941cb 100644 +--- a/src/post_process/m_global_parameters.fpp ++++ b/src/post_process/m_global_parameters.fpp +@@ -94,6 +94,10 @@ module m_global_parameters + logical :: mixture_err !< Mixture error limiter + logical :: alt_soundspeed !< Alternate sound speed + logical :: hypoelasticity !< Turn hypoelasticity on ++ logical :: hyperelasticity !< Turn hyperelasticity on ++ logical :: elasticity !< elasticity modeling, true for hyper or hypo ++ integer :: b_size !< Number of components in the b tensor ++ integer :: tensor_size !< Number of components in the nonsymmetric tensor + !> @} + + !> @name Annotations of the structure, i.e. the organization, of the state vectors +@@ -109,6 +113,7 @@ module m_global_parameters + integer :: alf_idx !< Index of specific heat ratio func. eqn. + integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. + type(int_bounds_info) :: stress_idx !< Indices of elastic stresses ++ type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. + integer :: c_idx !< Index of color function + !> @} + +@@ -118,6 +123,7 @@ module m_global_parameters + !> @} + + logical :: parallel_io !< Format of the data files ++ logical :: sim_data + logical :: file_per_process !< output format + + integer, allocatable, dimension(:) :: proc_coords !< +@@ -255,6 +261,7 @@ module m_global_parameters + integer :: intxb, intxe + integer :: bubxb, bubxe + integer :: strxb, strxe ++ integer :: xibeg, xiend + !> @} + + contains +@@ -286,7 +293,10 @@ contains + alt_soundspeed = .false. + relax = .false. + relax_model = dflt_int ++ + hypoelasticity = .false. ++ hyperelasticity = .false. ++ elasticity = .false. + + bc_x%beg = dflt_int; bc_x%end = dflt_int + bc_y%beg = dflt_int; bc_y%end = dflt_int +@@ -335,6 +345,7 @@ contains + omega_wrt = .false. + qm_wrt = .false. + schlieren_wrt = .false. ++ sim_data = .false. + cf_wrt = .false. + ib = .false. + +@@ -486,12 +497,24 @@ contains + + end if + +- if (hypoelasticity) then ++ if (hypoelasticity .or. hyperelasticity) then ++ elasticity = .true. + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ++ ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end + end if + ++ if (hyperelasticity) then ++ xi_idx%beg = sys_size + 1 ++ xi_idx%end = sys_size + num_dims ++ ! adding three more equations for the \xi field and the elastic energy ++ sys_size = xi_idx%end + 1 ++ ! number of entries in the symmetric btensor plus the jacobian ++ b_size = (num_dims*(num_dims + 1))/2 + 1 ++ tensor_size = num_dims**2 + 1 ++ end if ++ + if (.not. f_is_default(sigma)) then + c_idx = sys_size + 1 + sys_size = c_idx +@@ -517,6 +540,24 @@ contains + sys_size = internalEnergies_idx%end + alf_idx = 1 ! dummy, cannot actually have a void fraction + ++ if (hypoelasticity .or. hyperelasticity) then ++ elasticity = .true. ++ stress_idx%beg = sys_size + 1 ++ stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ++ ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D ++ sys_size = stress_idx%end ++ end if ++ ++ if (hyperelasticity) then ++ xi_idx%beg = sys_size + 1 ++ xi_idx%end = sys_size + num_dims ++ ! adding three more equations for the \xi field and the elastic energy ++ sys_size = xi_idx%end + 1 ++ ! number of entries in the symmetric btensor plus the jacobian ++ b_size = (num_dims*(num_dims + 1))/2 + 1 ++ tensor_size = num_dims**2 + 1 ++ end if ++ + if (.not. f_is_default(sigma)) then + c_idx = sys_size + 1 + sys_size = c_idx +@@ -590,6 +631,8 @@ contains + strxe = stress_idx%end + intxb = internalEnergies_idx%beg + intxe = internalEnergies_idx%end ++ xibeg = xi_idx%beg ++ xiend = xi_idx%end + ! ================================================================== + + #ifdef MFC_MPI +diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp +index a5dffdb4..5da4c74e 100644 +--- a/src/post_process/m_mpi_proxy.fpp ++++ b/src/post_process/m_mpi_proxy.fpp +@@ -141,6 +141,38 @@ contains + + end subroutine s_initialize_mpi_proxy_module + ++ subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root) ++ ++#ifdef MFC_MPI ++ ++ implicit none ++ integer, intent(in) :: counts ! Array of vector lengths for each process ++ real(kind(0d0)), intent(in), dimension(counts) :: my_vector ! Input vector on each process ++ integer, intent(in) :: root ! Rank of the root process ++ real(kind(0d0)), allocatable, intent(out) :: gathered_vector(:) ! Gathered vector on the root process ++ ++ integer :: i, offset, ierr ++ integer, allocatable :: recounts(:), displs(:) ++ ++ allocate (recounts(num_procs)) ++ ++ call MPI_GATHER(counts, 1, MPI_INTEGER, recounts, 1, MPI_INTEGER, root, & ++ MPI_COMM_WORLD, ierr) ++ ++ allocate (displs(size(recounts))) ++ ++ displs(1) = 0 ++ ++ do i = 2, size(recounts) ++ displs(i) = displs(i - 1) + recounts(i - 1) ++ end do ++ ++ allocate (gathered_vector(sum(recounts))) ++ call MPI_GATHERV(my_vector, counts, MPI_DOUBLE_PRECISION, gathered_vector, recounts, displs, MPI_DOUBLE_PRECISION, & ++ root, MPI_COMM_WORLD, ierr) ++#endif ++ end subroutine s_mpi_gather_data ++ + !> Since only processor with rank 0 is in charge of reading + !! and checking the consistency of the user provided inputs, + !! these are not available to the remaining processors. This +@@ -164,11 +196,11 @@ contains + + #:for VAR in [ 'cyl_coord', 'mpp_lim', 'mixture_err', & + & 'alt_soundspeed', 'hypoelasticity', 'parallel_io', 'rho_wrt', & +- & 'E_wrt', 'pres_wrt', 'gamma_wrt', & ++ & 'E_wrt', 'pres_wrt', 'gamma_wrt', 'sim_data', & + & 'heat_ratio_wrt', 'pi_inf_wrt', 'pres_inf_wrt', 'cons_vars_wrt', & + & 'prim_vars_wrt', 'c_wrt', 'qm_wrt','schlieren_wrt', 'bubbles', 'qbmm', & + & 'polytropic', 'polydisperse', 'file_per_process', 'relax', 'cf_wrt', & +- & 'adv_n', 'ib' ] ++ & 'adv_n', 'ib', 'hyperelasticity' ] + call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) + #:endfor + +diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 +index ed1003ff..60d3d094 100644 +--- a/src/post_process/m_start_up.f90 ++++ b/src/post_process/m_start_up.f90 +@@ -74,7 +74,8 @@ contains + parallel_io, rhoref, pref, bubbles, qbmm, sigR, & + R0ref, nb, polytropic, thermal, Ca, Web, Re_inv, & + polydisperse, poly_sigma, file_per_process, relax, & +- relax_model, cf_wrt, sigma, adv_n, ib ++ relax_model, cf_wrt, sigma, adv_n, ib, sim_data, & ++ hyperelasticity + + ! Inquiring the status of the post_process.inp file + file_loc = 'post_process.inp' +@@ -148,9 +149,9 @@ contains + (t_step_stop - t_step_start)/t_step_save + 1, & + t_step + end if +- + ! Populating the grid and conservative variables + call s_read_data_files(t_step) ++ + ! Populating the buffer regions of the grid variables + if (buff_size > 0) then + call s_populate_grid_variables_buffer_regions() +@@ -163,6 +164,7 @@ contains + + ! Converting the conservative variables to the primitive ones + call s_convert_conservative_to_primitive_variables(q_cons_vf, q_prim_vf) ++ + end subroutine s_perform_time_step + + subroutine s_save_data(t_step, varname, pres, c, H) +@@ -176,6 +178,16 @@ contains + ! Opening a new formatted database file + call s_open_formatted_database_file(t_step) + ++ if (sim_data .and. proc_rank == 0) then ++ call s_open_intf_data_file() ++ call s_open_energy_data_file() ++ end if ++ ++ if (sim_data) then ++ call s_write_intf_data_file(q_prim_vf) ++ call s_write_energy_data_file(q_prim_vf, q_cons_vf) ++ end if ++ + ! Adding the grid to the formatted database file + call s_write_grid_to_formatted_database_file(t_step) + +@@ -304,22 +316,34 @@ contains + + end if + ! ---------------------------------------------------------------------- +- + ! Adding the elastic shear stresses to the formatted database file ----- +- if (hypoelasticity) then ++ if (elasticity) then + do i = 1, stress_idx%end - stress_idx%beg + 1 + if (prim_vars_wrt) then + q_sf = q_prim_vf(i - 1 + stress_idx%beg)%sf( & + -offset_x%beg:m + offset_x%end, & + -offset_y%beg:n + offset_y%end, & + -offset_z%beg:p + offset_z%end) +- + write (varname, '(A,I0)') 'tau', i + call s_write_variable_to_formatted_database_file(varname, t_step) + end if + varname(:) = ' ' + end do + end if ++ if (hyperelasticity) then ++ do i = 1, xiend - xibeg + 1 ++ if (prim_vars_wrt) then ++ q_sf = q_prim_vf(i - 1 + xibeg)%sf( & ++ -offset_x%beg:m + offset_x%end, & ++ -offset_y%beg:n + offset_y%end, & ++ -offset_z%beg:p + offset_z%end) ++ write (varname, '(A,I0)') 'xi', i ++ call s_write_variable_to_formatted_database_file(varname, t_step) ++ end if ++ varname(:) = ' ' ++ end do ++ end if ++ + ! ---------------------------------------------------------------------- + + ! Adding the pressure to the formatted database file ------------------- +@@ -625,8 +649,19 @@ contains + end if + end if + ++! if (proc_rank == 0 .and. sim_data) then ++! close (211) ++! close (251) ++! end if ++ ++ if (sim_data .and. proc_rank == 0) then ++ call s_close_intf_data_file() ++ call s_close_energy_data_file() ++ end if ++ + ! Closing the formatted database file + call s_close_formatted_database_file() ++ + end subroutine s_save_data + + subroutine s_initialize_modules +@@ -682,6 +717,11 @@ contains + ! Disassociate pointers for serial and parallel I/O + s_read_data_files => null() + ++! if (sim_data .and. proc_rank == 0) then ++! call s_close_intf_data_file() ++! call s_close_energy_data_file() ++! end if ++ + ! Deallocation procedures for the modules + call s_finalize_data_output_module() + call s_finalize_derived_variables_module() +diff --git a/src/post_process/p_main.fpp b/src/post_process/p_main.fpp +index c780ce9a..ede32ed7 100644 +--- a/src/post_process/p_main.fpp ++++ b/src/post_process/p_main.fpp +@@ -39,6 +39,7 @@ program p_main + + ! Time-Marching Loop ======================================================= + do ++ + call s_perform_time_step(t_step) + + call s_save_data(t_step, varname, pres, c, H) +diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp +index 7d6ee960..394f560b 100644 +--- a/src/pre_process/include/2dHardcodedIC.fpp ++++ b/src/pre_process/include/2dHardcodedIC.fpp +@@ -2,8 +2,7 @@ + + real(kind(0d0)) :: eps + real(kind(0d0)) :: r, rmax, gam, umax, p0 +- +- real(kind(0d0)) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph ++ real(kind(0d0)) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph + + eps = 1e-9 + +@@ -12,6 +11,7 @@ + #:def Hardcoded2D() + + select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case ++ + case (200) + if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1d0/3d0)) then + ! Volume Fractions +@@ -68,7 +68,7 @@ + + q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(E_idx)%sf(i, j, 0)**(1d0/gam) + +- case (204) ! Rayleigh-Taylor instability ++ case (204) ! Rayleigh-taylor problem + rhoH = 3 + rhoL = 1 + pRef = 1e5 +@@ -100,11 +100,42 @@ + q_prim_vf(E_idx)%sf(i, j, 0) = pInt + rhoL*9.81*(intH - y_cc(j)) + end if + ++ case (205) ! 2D lung wave interaction problem ++ h = 0.0 !non dim origin y ++ lam = 1.0 !non dim lambda ++ amp = patch_icpp(patch_id)%a2 !to be changed later! !non dim amplitude ++ ++ intH = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h ++ ++ if (y_cc(j) > intH) then ++ q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) ++ q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) ++ q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres ++ q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) ++ q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) ++ end if ++ ++ case (206) ! 2D lung wave interaction problem - horizontal domain ++ h = 0.0 !non dim origin y ++ lam = 1.0 !non dim lambda ++ amp = patch_icpp(patch_id)%a2 ++ ++ intL = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h ++ ++ if (x_cc(i) > intL) then !this is the liquid ++ q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) ++ q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) ++ q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres ++ q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) ++ q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) ++ end if ++ + case default + if (proc_rank == 0) then + call s_int_to_str(patch_id, iStr) + call s_mpi_abort("Invalid hcid specified for patch "//trim(iStr)) + end if ++ + end select + + #:enddef +diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp +index 3d9a4e2f..4088fcc2 100644 +--- a/src/pre_process/include/3dHardcodedIC.fpp ++++ b/src/pre_process/include/3dHardcodedIC.fpp +@@ -42,7 +42,20 @@ + pInt = pref + rhoH*9.81*(1.2 - intH) + q_prim_vf(E_idx)%sf(i, j, k) = pInt + rhoL*9.81*(intH - y_cc(j)) + end if +- ++ ++ case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|) ++ h = 0.0 ++ lam = 1.0 ++ amp = patch_icpp(patch_id)%a2 ++ intH = amp*ABS((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h) ++ if (x_cc(i) > intH) then ++ q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1) ++ q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2) ++ q_prim_vf(E_idx)%sf(i, j, k) = patch_icpp(1)%pres ++ q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1) ++ q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2) ++ end if ++ + ! Put your variable assignments here + case default + call s_int_to_str(patch_id, iStr) +diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 +index 9ff468a3..4a49c46a 100644 +--- a/src/pre_process/m_assign_variables.f90 ++++ b/src/pre_process/m_assign_variables.f90 +@@ -276,6 +276,8 @@ contains + real(kind(0d0)) :: orig_qv + real(kind(0d0)) :: muR, muV + real(kind(0d0)) :: R3bar ++ real(kind(0d0)) :: rcoord, theta, phi, xi_sph ++ real(kind(0d0)), dimension(3) :: xi_cart + + real(kind(0d0)), dimension(int(E_idx - mom_idx%beg)) :: vel !< velocity + real(kind(0d0)) :: pres !< pressure +@@ -448,7 +450,7 @@ contains + end do + + ! Elastic Shear Stress +- if (hypoelasticity) then ++ if (elasticity) then + do i = 1, (stress_idx%end - stress_idx%beg) + 1 + q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = & + (eta*patch_icpp(patch_id)%tau_e(i) & +@@ -456,6 +458,32 @@ contains + end do + end if + ++ ! Elastic Shear Stress ++ if (hyperelasticity) then ++ ++ if (pre_stress) then ! pre stressed initial condition in spatial domain ++ rcoord = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2)) ++ theta = atan2(y_cc(k), x_cc(j)) ++ phi = atan2(sqrt(x_cc(j)**2 + y_cc(k)**2), z_cc(l)) ++ !spherical coord, assuming Rmax=1 ++ xi_sph = (rcoord**3 - R0ref**3 + 1d0)**(1d0/3d0) ++ xi_cart(1) = xi_sph*sin(phi)*cos(theta) ++ xi_cart(2) = xi_sph*sin(phi)*sin(theta) ++ xi_cart(3) = xi_sph*cos(phi) ++ else ++ xi_cart(1) = x_cc(j) ++ xi_cart(2) = y_cc(k) ++ xi_cart(3) = z_cc(l) ++ end if ++ ++ ! assigning the reference map to the q_prim vector field ++ do i = 1, num_dims ++ q_prim_vf(i + xibeg - 1)%sf(j, k, l) = eta*xi_cart(i) + & ++ (1d0 - eta)*orig_prim_vf(i + xibeg - 1) ++ end do ++ ++ end if ++ + if (mpp_lim .and. bubbles) then + !adjust volume fractions, according to modeled gas void fraction + alf_sum%sf = 0d0 +diff --git a/src/pre_process/m_check_patches.fpp b/src/pre_process/m_check_patches.fpp +index 4579f5bd..bda4418e 100644 +--- a/src/pre_process/m_check_patches.fpp ++++ b/src/pre_process/m_check_patches.fpp +@@ -119,7 +119,8 @@ contains + patch_icpp(i)%geometry == 9 .or. & + patch_icpp(i)%geometry == 10 .or. & + patch_icpp(i)%geometry == 11 .or. & +- patch_icpp(i)%geometry == 12)) then ++ patch_icpp(i)%geometry == 12 .or. & ++ patch_icpp(i)%geometry == 14)) then + call s_check_supported_patch_smoothing(i) + else + call s_check_unsupported_patch_smoothing(i) +diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp +index 94d5d8fb..c0049095 100644 +--- a/src/pre_process/m_data_output.fpp ++++ b/src/pre_process/m_data_output.fpp +@@ -638,6 +638,7 @@ contains + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & + MPI_DOUBLE_PRECISION, status, ierr) + end do ++ + end if + + call MPI_FILE_CLOSE(ifile, ierr) +diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp +index 57dcda37..78e8c293 100644 +--- a/src/pre_process/m_global_parameters.fpp ++++ b/src/pre_process/m_global_parameters.fpp +@@ -20,11 +20,11 @@ module m_global_parameters + implicit none + + ! Logistics ================================================================ +- integer :: num_procs !< Number of processors +- character(LEN=path_len) :: case_dir !< Case folder location +- logical :: old_grid !< Use existing grid data +- logical :: old_ic !< Use existing IC data +- integer :: t_step_old, t_step_start !< Existing IC/grid folder ++ integer :: num_procs !< Number of processors ++ character(LEN=path_len) :: case_dir !< Case folder location ++ logical :: old_grid !< Use existing grid data ++ logical :: old_ic, non_axis_sym !< Use existing IC data ++ integer :: t_step_old, t_step_start !< Existing IC/grid folder + ! ========================================================================== + + ! Computational Domain Parameters ========================================== +@@ -72,16 +72,21 @@ module m_global_parameters + ! ========================================================================== + + ! Simulation Algorithm Parameters ========================================== +- integer :: model_eqns !< Multicomponent flow model +- logical :: relax !< activate phase change +- integer :: relax_model !< Relax Model +- real(kind(0d0)) :: palpha_eps !< trigger parameter for the p relaxation procedure, phase change model +- real(kind(0d0)) :: ptgalpha_eps !< trigger parameter for the pTg relaxation procedure, phase change model +- integer :: num_fluids !< Number of different fluids present in the flow +- logical :: mpp_lim !< Alpha limiter +- integer :: sys_size !< Number of unknowns in the system of equations +- integer :: weno_order !< Order of accuracy for the WENO reconstruction +- logical :: hypoelasticity !< activate hypoelasticity ++ integer :: model_eqns !< Multicomponent flow model ++ logical :: relax !< activate phase change ++ integer :: relax_model !< Relax Model ++ real(kind(0d0)) :: palpha_eps !< trigger parameter for the p relaxation procedure, phase change model ++ real(kind(0d0)) :: ptgalpha_eps !< trigger parameter for the pTg relaxation procedure, phase change model ++ integer :: num_fluids !< Number of different fluids present in the flow ++ logical :: mpp_lim !< Alpha limiter ++ integer :: sys_size !< Number of unknowns in the system of equations ++ integer :: weno_order !< Order of accuracy for the WENO reconstruction ++ logical :: hypoelasticity !< activate hypoelasticity ++ logical :: hyperelasticity !< activate hyperelasticity ++ logical :: elasticity !< elasticity modeling, true for hyper or hypo ++ integer :: b_size !< Number of components in the b tensor ++ integer :: tensor_size !< Number of components in the nonsymmetric tensor ++ logical :: pre_stress !< activate pre_stressed domain + + ! Annotations of the structure, i.e. the organization, of the state vectors + type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. +@@ -95,6 +100,7 @@ module m_global_parameters + integer :: gamma_idx !< Index of specific heat ratio func. eqn. + integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. + type(int_bounds_info) :: stress_idx !< Indexes of elastic shear stress eqns. ++ type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. + integer :: c_idx !< Index of the color function + + type(int_bounds_info) :: bc_x, bc_y, bc_z !< +@@ -216,6 +222,7 @@ module m_global_parameters + integer :: intxb, intxe + integer :: bubxb, bubxe + integer :: strxb, strxe ++ integer :: xibeg, xiend + !> @} + + integer, allocatable, dimension(:, :, :) :: logic_grid +@@ -278,6 +285,9 @@ contains + weno_order = dflt_int + + hypoelasticity = .false. ++ hyperelasticity = .false. ++ elasticity = .false. ++ pre_stress = .false. + + bc_x%beg = dflt_int; bc_x%end = dflt_int + bc_y%beg = dflt_int; bc_y%end = dflt_int +@@ -339,6 +349,18 @@ contains + patch_icpp(i)%qv = 0d0 + patch_icpp(i)%qvp = 0d0 + patch_icpp(i)%tau_e = 0d0 ++ patch_icpp(i)%a2 = dflt_real ++ patch_icpp(i)%a3 = dflt_real ++ patch_icpp(i)%a4 = dflt_real ++ patch_icpp(i)%a5 = dflt_real ++ patch_icpp(i)%a6 = dflt_real ++ patch_icpp(i)%a8 = dflt_real ++ patch_icpp(i)%a9 = dflt_real ++ patch_icpp(i)%a10 = dflt_real ++ patch_icpp(i)%a11 = dflt_real ++ patch_icpp(i)%a12 = dflt_real ++ patch_icpp(i)%non_axis_sym = .false. ++ + !should get all of r0's and v0's + patch_icpp(i)%r0 = dflt_real + patch_icpp(i)%v0 = dflt_real +@@ -574,13 +596,24 @@ contains + end if + end if + +- if (hypoelasticity) then ++ if (hypoelasticity .or. hyperelasticity) then ++ elasticity = .true. + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end + end if + ++ if (hyperelasticity) then ++ ! number of entries in the symmetric btensor plus the jacobian ++ b_size = (num_dims*(num_dims + 1))/2 + 1 ++ tensor_size = num_dims**2 + 1 ++ xi_idx%beg = sys_size + 1 ++ xi_idx%end = sys_size + num_dims ++ ! adding three more equations for the \xi field and the elastic energy ++ sys_size = xi_idx%end + 1 ++ end if ++ + if (.not. f_is_default(sigma)) then + c_idx = sys_size + 1 + sys_size = c_idx +@@ -605,6 +638,24 @@ contains + internalEnergies_idx%end = adv_idx%end + num_fluids + sys_size = internalEnergies_idx%end + ++ if (hypoelasticity .or. hyperelasticity) then ++ elasticity = .true. ++ stress_idx%beg = sys_size + 1 ++ stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ++ ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D ++ sys_size = stress_idx%end ++ end if ++ ++ if (hyperelasticity) then ++ ! number of entries in the symmetric btensor plus the jacobian ++ b_size = (num_dims*(num_dims + 1))/2 + 1 ++ tensor_size = num_dims**2 + 1 ++ xi_idx%beg = sys_size + 1 ++ xi_idx%end = sys_size + num_dims ++ ! adding three more equations for the \xi field and the elastic energy ++ sys_size = xi_idx%end + 1 ++ end if ++ + if (.not. f_is_default(sigma)) then + c_idx = sys_size + 1 + sys_size = c_idx +@@ -681,6 +732,8 @@ contains + strxe = stress_idx%end + intxb = internalEnergies_idx%beg + intxe = internalEnergies_idx%end ++ xibeg = xi_idx%beg ++ xiend = xi_idx%end + + ! ================================================================== + +diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp +index 5d58d46e..869194b5 100644 +--- a/src/pre_process/m_initial_condition.fpp ++++ b/src/pre_process/m_initial_condition.fpp +@@ -238,6 +238,10 @@ contains + elseif (patch_icpp(i)%geometry == 7) then + call s_2D_analytical(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) ++ + ! Spiral patch + elseif (patch_icpp(i)%geometry == 17) then + call s_spiral(i, patch_id_fp, q_prim_vf) +@@ -311,8 +315,7 @@ contains + if (instability_wave) call s_superposition_instability_wave() + + ! Converting the primitive variables to the conservative ones +- call s_convert_primitive_to_conservative_variables(q_prim_vf, & +- q_cons_vf) ++ call s_convert_primitive_to_conservative_variables(q_prim_vf, q_cons_vf) + + if (qbmm .and. .not. polytropic) then + !Initialize pb and mv +diff --git a/src/pre_process/m_mpi_proxy.fpp b/src/pre_process/m_mpi_proxy.fpp +index 257f7fb3..6b04bf0f 100644 +--- a/src/pre_process/m_mpi_proxy.fpp ++++ b/src/pre_process/m_mpi_proxy.fpp +@@ -55,7 +55,7 @@ contains + & 'cyl_coord','mpp_lim','hypoelasticity', 'relax', & + & 'parallel_io', 'perturb_flow', 'vel_profile', 'instability_wave',& + & 'perturb_sph', 'bubbles', 'polytropic', 'polydisperse', 'qbmm', & +- & 'file_per_process', 'adv_n', 'ib' ] ++ & 'file_per_process', 'adv_n', 'ib', 'hyperelasticity','pre_stress'] + call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) + #:endfor + call MPI_BCAST(fluid_rho(1), num_fluids_max, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) +@@ -76,6 +76,7 @@ contains + #:endfor + + call MPI_BCAST(patch_icpp(i)%smoothen, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) ++ call MPI_BCAST(patch_icpp(i)%non_axis_sym, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(patch_icpp(i)%alter_patch(0), num_patches_max, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) + + #:for VAR in [ 'x_centroid', 'y_centroid', 'z_centroid', & +@@ -86,6 +87,10 @@ contains + call MPI_BCAST(patch_icpp(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + #:endfor + ++ #:for VAR in [ 'a2', 'a3', 'a4', 'a5', 'a6', 'a7', 'a8', 'a9', 'a10', 'a11', 'a12'] ++ call MPI_BCAST(patch_icpp(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) ++ #:endfor ++ + call MPI_BCAST(patch_icpp(i)%model%filepath, len(patch_icpp(i)%model%filepath), MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr) + + #:for VAR in [ 'model%translate', 'model%scale', 'model%rotate', & +diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp +index 708ada19..d14d2273 100644 +--- a/src/pre_process/m_patches.fpp ++++ b/src/pre_process/m_patches.fpp +@@ -70,7 +70,8 @@ module m_patches + !! 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(kind(0d0)) :: cart_y, cart_z ++ real(kind(0d0)) :: r_cyl, theta_cyl, x_cart, y_cart, z_cart ++ real(kind(0d0)) :: cart_x, cart_y, cart_z + real(kind(0d0)) :: sph_phi !< + !! Variables to be used to hold cell locations in Cartesian coordinates if + !! 3D simulation is using cylindrical coordinates +@@ -794,7 +795,7 @@ contains + ((y_cc(j) - y_centroid)/b)**2) & + - 1d0))*(-0.5d0) + 0.5d0 + end if +- ++ print *, "a :", a, "b :", b + if ((((x_cc(i) - x_centroid)/a)**2 + & + ((y_cc(j) - y_centroid)/b)**2 <= 1d0 & + .and. & +@@ -1421,128 +1422,240 @@ contains + !! @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, 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, intent(IN) :: patch_id ++ integer, intent(INOUT), dimension(0:m, 0:n, 0:p) :: patch_id_fp ++ type(scalar_field), dimension(1:sys_size) :: q_prim_vf ++ ++ real(kind(0d0)) :: r, x_p, P2, P3, P4, P5, P6, P7, P8, P9, P10, P11, P12, eps, phi ++ real(kind(0d0)) :: a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 ++ real(kind(0d0)) :: radius, x_centroid, y_centroid, z_centroid, eta, smooth_coeff ++ logical :: non_axis_sym + + integer :: i, j, k !< generic loop iterators +- real(kind(0d0)) :: radius, epsilon, beta +- complex(kind(0d0)) :: cmplx_i = (0d0, 1d0) +- complex(kind(0d0)) :: H + + ! Transferring the patch's centroid and radius 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 ++ smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id ++ smooth_coeff = patch_icpp(patch_id)%smooth_coeff + radius = patch_icpp(patch_id)%radius +- epsilon = patch_icpp(patch_id)%epsilon +- beta = patch_icpp(patch_id)%beta ++ a2 = patch_icpp(patch_id)%a2 ++ a3 = patch_icpp(patch_id)%a3 ++ a4 = patch_icpp(patch_id)%a4 ++ a5 = patch_icpp(patch_id)%a5 ++ a6 = patch_icpp(patch_id)%a6 ++ a7 = patch_icpp(patch_id)%a7 ++ a8 = patch_icpp(patch_id)%a8 ++ a9 = patch_icpp(patch_id)%a9 ++ a10 = patch_icpp(patch_id)%a10 ++ a11 = patch_icpp(patch_id)%a11 ++ a12 = patch_icpp(patch_id)%a12 ++ non_axis_sym = 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 = 1d0 ++ eps = 1.d-32 + + ! 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. +- do k = 0, p ++ if (p > 0 .and. .not. non_axis_sym) 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 = dsqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) + eps ++ if (x_cc(i) - x_centroid <= 0) then ++ x_p = -dabs(x_cc(i) - x_centroid + eps)/r ++ else ++ x_p = dabs(x_cc(i) - x_centroid + eps)/r ++ end if ++ ++ P2 = unassociated_legendre(x_p, 2) ++ P3 = unassociated_legendre(x_p, 3) ++ P4 = unassociated_legendre(x_p, 4) ++ P5 = unassociated_legendre(x_p, 5) ++ P6 = unassociated_legendre(x_p, 6) ++ P7 = unassociated_legendre(x_p, 7) ++ if ((x_cc(i) - x_centroid >= 0 & ++ .and. & ++ r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7 <= 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 = tanh(smooth_coeff/min(dx, dy, dz)* & ++ ((r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7) & ++ - radius))*(-0.5d0) + 0.5d0 ++ end if ++ ++ call s_assign_patch_primitive_variables(patch_id, i, j, k, & ++ eta, 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 (grid_geometry == 3) then +- call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) ++ if (non_axis_sym) then ++ phi = atan(((y_cc(j) - y_centroid) + eps)/((x_cc(i) - x_centroid) + eps)) ++ r = dsqrt((x_cc(i) - x_centroid)**2d0 + (y_cc(j) - y_centroid)**2d0) + eps ++ x_p = (eps)/r ++ P2 = spherical_harmonic_func(x_p, phi, 2, 2) ++ P3 = spherical_harmonic_func(x_p, phi, 3, 3) ++ P4 = spherical_harmonic_func(x_p, phi, 4, 4) ++ P5 = spherical_harmonic_func(x_p, phi, 5, 5) ++ P6 = spherical_harmonic_func(x_p, phi, 6, 6) ++ P7 = spherical_harmonic_func(x_p, phi, 7, 7) ++ P8 = spherical_harmonic_func(x_p, phi, 8, 8) ++ P9 = spherical_harmonic_func(x_p, phi, 9, 9) ++ ! P10 = spherical_harmonic_func(x_p, phi, 10, 10) ++ ! P11 = spherical_harmonic_func(x_p, phi, 11, 11) ++ ! P12 = spherical_harmonic_func(x_p, phi, 12, 12) + else +- cart_y = y_cc(j) +- cart_z = z_cc(k) ++ r = dsqrt((x_cc(i) - x_centroid)**2d0 + (y_cc(j) - y_centroid)**2d0) + eps ++ x_p = dabs(x_cc(i) - x_centroid + eps)/r ++ P2 = unassociated_legendre(x_p, 2) ++ P3 = unassociated_legendre(x_p, 3) ++ P4 = unassociated_legendre(x_p, 4) ++ P5 = unassociated_legendre(x_p, 5) ++ P6 = unassociated_legendre(x_p, 6) ++ P7 = unassociated_legendre(x_p, 7) ++ P8 = unassociated_legendre(x_p, 8) ++ P9 = unassociated_legendre(x_p, 9) + end if + +- 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)))) & ++ if (x_cc(i) - x_centroid >= 0 & ++ .and. & ++ r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7 - a8*P8 - a9*P9 <= 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, q_prim_vf, patch_id_fp) + +- call s_convert_cylindrical_to_spherical_coord(x_cc(i), y_cc(j)) +- +- if (epsilon == 1d0) then +- if (beta == 0d0) then +- H = 5d-1*sqrt(3d0/pi)*cos(sph_phi) +- elseif (beta == 1d0) then +- H = -5d-1*sqrt(3d0/(2d0*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi) +- end if +- elseif (epsilon == 2d0) then +- if (beta == 0d0) then +- H = 25d-2*sqrt(5d0/pi)*(3d0*cos(sph_phi)**2 - 1d0) +- elseif (beta == 1d0) then +- H = -5d-1*sqrt(15d0/(2d0*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)*cos(sph_phi) +- elseif (beta == 2d0) then +- H = 25d-2*sqrt(15d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))*sin(sph_phi)**2 +- end if +- elseif (epsilon == 3d0) then +- if (beta == 0d0) then +- H = 25d-2*sqrt(7d0/pi)*(5d0*cos(sph_phi)**3d0 - 3d0*cos(sph_phi)) +- elseif (beta == 1d0) then +- H = -125d-3*sqrt(21d0/pi)*exp(cmplx_i*z_cc(k))*sin(sph_phi)* & +- (5d0*cos(sph_phi)**2 - 1d0) +- elseif (beta == 2d0) then +- H = 25d-2*sqrt(105d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & +- sin(sph_phi)**2*cos(sph_phi) +- elseif (beta == 3d0) then +- H = -125d-3*sqrt(35d0/pi)*exp(3d0*cmplx_i*z_cc(k))*sin(sph_phi)**3d0 +- end if +- elseif (epsilon == 4d0) then +- if (beta == 0d0) then +- H = 3d0/16d0*sqrt(1d0/pi)*(35d0*cos(sph_phi)**4d0 - & +- 3d1*cos(sph_phi)**2 + 3d0) +- elseif (beta == 1d0) then +- H = -3d0/8d0*sqrt(5d0/pi)*exp(cmplx_i*z_cc(k))* & +- sin(sph_phi)*(7d0*cos(sph_phi)**3d0 - 3d0*cos(sph_phi)) +- elseif (beta == 2d0) then +- H = 3d0/8d0*sqrt(5d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & +- sin(sph_phi)**2*(7d0*cos(sph_phi)**2 - 1d0) +- elseif (beta == 3d0) then +- H = -3d0/8d0*sqrt(35d0/pi)*exp(3d0*cmplx_i*z_cc(k))* & +- sin(sph_phi)**3d0*cos(sph_phi) +- elseif (beta == 4d0) then +- H = 3d0/16d0*sqrt(35d0/(2d0*pi))*exp(4d0*cmplx_i*z_cc(k))* & +- sin(sph_phi)**4d0 +- end if +- elseif (epsilon == 5d0) then +- if (beta == 0d0) then +- H = 1d0/16d0*sqrt(11d0/pi)*(63d0*cos(sph_phi)**5d0 - & +- 7d1*cos(sph_phi)**3d0 + 15d0*cos(sph_phi)) +- elseif (beta == 1d0) then +- H = -1d0/16d0*sqrt(165d0/(2d0*pi))*exp(cmplx_i*z_cc(k))* & +- sin(sph_phi)*(21d0*cos(sph_phi)**4d0 - 14d0*cos(sph_phi)**2 + 1d0) +- elseif (beta == 2d0) then +- H = 125d-3*sqrt(1155d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & +- sin(sph_phi)**2*(3d0*cos(sph_phi)**3d0 - cos(sph_phi)) +- elseif (beta == 3d0) then +- H = -1d0/32d0*sqrt(385d0/pi)*exp(3d0*cmplx_i*z_cc(k))* & +- sin(sph_phi)**3d0*(9d0*cos(sph_phi)**2 - 1d0) +- elseif (beta == 4d0) then +- H = 3d0/16d0*sqrt(385d0/(2d0*pi))*exp(4d0*cmplx_i*z_cc(k))* & +- sin(sph_phi)**4d0*cos(sph_phi) +- elseif (beta == 5d0) then +- H = -3d0/32d0*sqrt(77d0/pi)*exp(5d0*cmplx_i*z_cc(k))* & +- sin(sph_phi)**5d0 +- end if +- end if +- +- q_prim_vf(adv_idx%beg)%sf(i, j, k) = 1d0 - abs(real(H, kind(0d0))) ++ elseif (x_cc(i) - x_centroid < 0 & ++ .and. & ++ r - a2*P2 + a3*P3 - a4*P4 + a5*P5 - a6*P6 + a7*P7 - a8*P8 + a9*P9 <= 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, q_prim_vf, patch_id_fp) + + end if +- + end do + end do +- end do ++ end if + + end subroutine s_spherical_harmonic + ++ !! This function generates the unassociated legendre poynomials with input ++ ! mode number and evaluates them at input x ++ ++ recursive function unassociated_legendre(x, l) result(P) ++ integer, intent(in) :: l ++ real(kind(0d0)), intent(in) :: x ++ real(kind(0d0)) :: P ++ ++ if (l == 0) then ++ P = 1d0 ++ else if (l == 1) then ++ P = x ++ else ++ P = ((2*l - 1)*x*unassociated_legendre(x, l - 1) - (l - 1)*unassociated_legendre(x, l - 2))/l ++ end if ++ ++ end function unassociated_legendre ++ ++ !! This function generated the spherical harmonic function valu, Y, ++ !based on inputs of x, phi, l and m ++ ++ recursive function spherical_harmonic_func(x, phi, l, m) result(Y) ++ integer, intent(in) :: l, m ++ real(kind(0d0)), intent(in) :: x, phi ++ real(kind(0d0)) :: Y, prefactor, pi ++ ++ pi = acos(-1d0) ++ prefactor = sqrt((2*l + 1)/(4*pi)*factorial(l - m)/factorial(l + m)); ++ if (m == 0) then ++ Y = prefactor*associated_legendre(x, l, m); ++ elseif (m > 0) then ++ Y = (-1d0)**m*sqrt(2d0)*prefactor*associated_legendre(x, l, m)*cos(m*phi); ++ end if ++ end function spherical_harmonic_func ++ ++ !! This function generates the associated legendre polynomials evaluated ++ !at x with inputs l and m ++ ++ recursive function associated_legendre(x, l, m) result(P) ++ integer, intent(in) :: l, m ++ real(kind(0d0)), intent(in) :: x ++ real(kind(0d0)) :: P ++ ++ if (m <= 0 .and. l <= 0) then ++ P = 1; ++ elseif (l == 1 .and. m <= 0) then ++ P = x; ++ elseif (l == 1 .and. m == 1) then ++ P = -(1 - x**2)**(1/2); ++ elseif (m == l) then ++ P = (-1)**l*double_factorial(2*l - 1)*(1 - x**2)**(l/2); ++ elseif (m == l - 1) then ++ P = x*(2*l - 1)*associated_legendre(x, l - 1, l - 1); ++ else ++ P = ((2*l - 1)*x*associated_legendre(x, l - 1, m) - (l + m - 1)*associated_legendre(x, l - 2, m))/(l - m); ++ end if ++ ++ end function associated_legendre ++ ++ !! This function calculates the double factorial value of an integer ++ ++ recursive function double_factorial(n) result(R) ++ integer, intent(in) :: n ++ integer, parameter :: int64_kind = selected_int_kind(18) ! 18 bytes for 64-bit integer ++ integer(kind=int64_kind) :: R ++ ++ if (n <= 0) then ++ R = 1 ++ else if (n == 1) then ++ R = 1 ++ else ++ R = n*double_factorial(n - 2) ++ end if ++ ++ end function double_factorial ++ ++ !! The following function calculates the factorial value of an integer ++ ++ recursive function factorial(n) result(R) ++ integer, intent(in) :: n ++ integer, parameter :: int64_kind = selected_int_kind(18) ! 18 bytes for 64-bit integer ++ integer(kind=int64_kind) :: R ++ ++ if (n == 0) then ++ R = 1 ++ else ++ R = n*factorial(n - 1) ++ end if ++ ++ end function factorial ++ + !> 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 +@@ -2110,7 +2223,7 @@ contains + + end subroutine s_convert_cylindrical_to_spherical_coord + +- !> Archimedes spiral function ++ !> Archimedes spiral funcreal(kind(0d0)) :: theta_cc, r, x_p, P2, P3, P4, P5, P6, P7tion + !! @param myth Angle + !! @param offset Thickness + !! @param a Starting position +diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp +index 546de9c5..6db827ca 100644 +--- a/src/pre_process/m_start_up.fpp ++++ b/src/pre_process/m_start_up.fpp +@@ -140,7 +140,7 @@ contains + sigR, sigV, dist_type, rhoRV, R0_type, & + file_per_process, relax, relax_model, & + palpha_eps, ptgalpha_eps, ib, num_ibs, patch_ib, & +- sigma, adv_n ++ sigma, adv_n, hyperelasticity, pre_stress + + ! Inquiring the status of the pre_process.inp file + file_loc = 'pre_process.inp' +diff --git a/src/simulation/m_boundary_conditions.fpp b/src/simulation/m_boundary_conditions.fpp +index ca77632d..2b9eee16 100644 +--- a/src/simulation/m_boundary_conditions.fpp ++++ b/src/simulation/m_boundary_conditions.fpp +@@ -357,6 +357,12 @@ contains + q_prim_vf(i)%sf(-j, k, l) = & + q_prim_vf(i)%sf(j - 1, k, l) + end do ++ ++ if(hyperelasticity) then ++ q_prim_vf(xibeg)%sf(-j, k, l) = & ++ -q_prim_vf(xibeg)%sf(j - 1, k, l) ++ end if ++ + end do + end do + end do +@@ -401,6 +407,11 @@ contains + q_prim_vf(i)%sf(m - (j - 1), k, l) + end do + ++ if(hyperelasticity) then ++ q_prim_vf(xibeg)%sf(m + j, k, l) = & ++ -q_prim_vf(xibeg)%sf(m - (j - 1), k, l) ++ end if ++ + end do + end do + end do +@@ -448,6 +459,11 @@ contains + q_prim_vf(i)%sf(l, -j, k) = & + q_prim_vf(i)%sf(l, j - 1, k) + end do ++ ++ if(hyperelasticity) then ++ q_prim_vf(xibeg + 1)%sf(l, -j, k) = & ++ -q_prim_vf(xibeg + 1)%sf(l, j - 1, k) ++ end if + end do + end do + end do +@@ -490,6 +506,11 @@ contains + q_prim_vf(i)%sf(l, n + j, k) = & + q_prim_vf(i)%sf(l, n - (j - 1), k) + end do ++ ++ if(hyperelasticity) then ++ q_prim_vf(xibeg + 1)%sf(l, n + j, k) = & ++ -q_prim_vf(xibeg + 1)%sf(l, n - (j - 1), k) ++ end if + end do + end do + end do +@@ -537,6 +558,11 @@ contains + q_prim_vf(i)%sf(k, l, -j) = & + q_prim_vf(i)%sf(k, l, j - 1) + end do ++ ++ if(hyperelasticity) then ++ q_prim_vf(xiend)%sf(k, l, -j) = & ++ -q_prim_vf(xiend)%sf(k, l, j - 1) ++ end if + end do + end do + end do +@@ -579,6 +605,11 @@ contains + q_prim_vf(i)%sf(k, l, p + j) = & + q_prim_vf(i)%sf(k, l, p - (j - 1)) + end do ++ ++ if(hyperelasticity) then ++ q_prim_vf(xiend)%sf(k, l, p + j) = & ++ -q_prim_vf(xiend)%sf(k, l, p - (j - 1)) ++ end if + end do + end do + end do +diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp +index d9513675..c3523ec9 100644 +--- a/src/simulation/m_checker.fpp ++++ b/src/simulation/m_checker.fpp +@@ -31,6 +31,7 @@ contains + call s_check_inputs_model_eqns + if (acoustic_source) call s_check_inputs_acoustic_src + if (hypoelasticity) call s_check_inputs_hypoelasticity ++ if (hyperelasticity) call s_check_inputs_hyperelasticity + if (bubbles) call s_check_inputs_bubbles + if (adap_dt) call s_check_inputs_adapt_dt + if (alt_soundspeed) call s_check_inputs_alt_soundspeed +@@ -369,10 +370,20 @@ contains + !> Checks constraints on hypoelasticity parameters + subroutine s_check_inputs_hypoelasticity + if (riemann_solver /= 1) then +- call s_mpi_abort('hypoelasticity requires HLL Riemann solver '// & +- '(riemann_solver = 1). Exiting ...') ++ call s_mpi_abort('hypoelasticity requires HLL '// & ++ '(riemann_solver = 1) Riemann solver. '// & ++ 'Exiting ...') ++ end if ++ end subroutine s_check_inputs_hypoelasticity ++ ++ !> Checks constraints on hyperelasticity parameters ++ subroutine s_check_inputs_hyperelasticity ++ if (riemann_solver /= 2) then ++ call s_mpi_abort('hyperelasticity requires HLLC '// & ++ '(riemann_solver = 2) Riemann solver. '// & ++ 'Exiting ...') + end if +- end subroutine ++ end subroutine s_check_inputs_hyperelasticity + + !> Checks constraints on bubble parameters + subroutine s_check_inputs_bubbles +diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp +index 875f0a90..93637a1b 100644 +--- a/src/simulation/m_data_output.fpp ++++ b/src/simulation/m_data_output.fpp +@@ -1,4 +1,4 @@ +-!> ++ + !! @file m_data_output.f90 + !! @brief Contains module m_data_output + +@@ -37,13 +37,16 @@ module m_data_output + private; + public :: s_initialize_data_output_module, & + s_open_run_time_information_file, & ++ s_open_com_files, & + s_open_probe_files, & + s_write_run_time_information, & + s_write_data_files, & + s_write_serial_data_files, & + s_write_parallel_data_files, & ++ s_write_com_files, & + s_write_probe_files, & + s_close_run_time_information_file, & ++ s_close_com_files, & + s_close_probe_files, & + s_finalize_data_output_module + +@@ -63,11 +66,12 @@ module m_data_output + + type(scalar_field), & + dimension(sys_size), & +- intent(inout) :: q_prim_vf ++ intent(inOUT) :: q_prim_vf + + integer, intent(in) :: t_step + +- end subroutine s_write_abstract_data_files ++ end subroutine s_write_abstract_data_files ! ------------------- ++ + end interface ! ======================================================== + #ifdef CRAY_ACC_WAR + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), icfl_sf) +@@ -80,6 +84,8 @@ module m_data_output + real(kind(0d0)), allocatable, dimension(:, :, :) :: vcfl_sf !< VCFL stability criterion + real(kind(0d0)), allocatable, dimension(:, :, :) :: ccfl_sf !< CCFL stability criterion + real(kind(0d0)), allocatable, dimension(:, :, :) :: Rc_sf !< Rc stability criterion ++ real(kind(0d0)), public, allocatable, dimension(:, :) :: c_mass ++ + !$acc declare create(icfl_sf, vcfl_sf, ccfl_sf, Rc_sf) + #endif + +@@ -169,6 +175,44 @@ contains + + end subroutine s_open_run_time_information_file + ++ !> This opens a formatted data file where the root processor ++ !! can write out the CoM information ++ subroutine s_open_com_files() ! ---------------------------------------- ++ character(len=path_len + 3*name_len) :: file_path !< ++ !! Relative path to the CoM file in the case directory ++ integer :: i !< Generic loop iterator ++ do i = 1, num_fluids ++ ! Generating the relative path to the CoM data file ++ write (file_path, '(A,I0,A)') '/fluid', i, '_com.dat' ++ file_path = trim(case_dir)//trim(file_path) ++ ! Creating the formatted data file and setting up its ++ ! structure ++ open (i + 120, file=trim(file_path), & ++ form='formatted', & ++ position='append', & ++ status='unknown') ++ if (n == 0) then ++ write (i + 120, '(A)') '=== Non-Dimensional Time '// & ++ '=== Total Mass '// & ++ '=== x-loc '// & ++ '=== Total Volume ===' ++ elseif (p == 0) then ++ write (i + 120, '(A)') '=== Non-Dimensional Time '// & ++ '=== Total Mass '// & ++ '=== x-loc '// & ++ '=== y-loc '// & ++ '=== Total Volume ===' ++ else ++ write (i + 120, '(A)') '=== Non-Dimensional Time '// & ++ '=== Total Mass '// & ++ '=== x-loc '// & ++ '=== y-loc '// & ++ '=== z-loc '// & ++ '=== Total Volume ===' ++ end if ++ end do ++ end subroutine s_open_com_files ! -------------------------------------- ++ + !> This opens a formatted data file where the root processor + !! can write out flow probe information + subroutine s_open_probe_files +@@ -189,12 +233,12 @@ contains + FORM='formatted', & + STATUS='unknown') + ! POSITION = 'append', & +- !WRITE(i+30,'(A,I0,A)') 'Probe ',i, ' located at:' +- !WRITE(i+30,'(A,F10.6)') 'x = ',probe(i)%x +- !WRITE(i+30,'(A,F10.6)') 'y = ',probe(i)%y +- !WRITE(i+30,'(A,F10.6)') 'z = ',probe(i)%z +- !WRITE(i+30, *) +- !WRITE(i+30,'(A)') '=== Non-Dimensional Time ' // & ++ !write(i+30,'(A,I0,A)') 'Probe ',i, ' located at:' ++ !write(i+30,'(A,F10.6)') 'x = ',probe(i)%x ++ !write(i+30,'(A,F10.6)') 'y = ',probe(i)%y ++ !write(i+30,'(A,F10.6)') 'z = ',probe(i)%z ++ !write(i+30, *) ++ !write(i+30,'(A)') '=== Non-Dimensional Time ' // & + ! '=== Density ' // & + ! '=== Velocity ' // & + ! '=== Pressure ' // & +@@ -227,8 +271,8 @@ contains + !! @param t_step Current time step + subroutine s_write_run_time_information(q_prim_vf, t_step) + +- type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf +- integer, intent(IN) :: t_step ++ type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf ++ integer, intent(in) :: t_step + + real(kind(0d0)), dimension(num_fluids) :: alpha_rho !< Cell-avg. partial density + real(kind(0d0)) :: rho !< Cell-avg. density +@@ -250,7 +294,6 @@ contains + + real(kind(0d0)) :: blkmod1, blkmod2 !< + !! Fluid bulk modulus for Woods mixture sound speed +- + integer :: i, j, k, l, q !< Generic loop iterators + + integer :: Nfq +@@ -262,7 +305,6 @@ contains + do l = 0, p + do k = 0, n + do j = 0, m +- + do i = 1, num_fluids + alpha_rho(i) = q_prim_vf(i)%sf(j, k, l) + alpha(i) = q_prim_vf(E_idx + i)%sf(j, k, l) +@@ -292,6 +334,14 @@ contains + ! Compute mixture sound speed + call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c) + ++ if (c /= c) then ++ print *, 'crashed at processor: ', proc_rank, ', at j :: ', j, ', k :: ', k, ' l :: ', l ++ print *, 'alpha1 ::', alpha(1), 'and alpha2 ::', alpha(2), ' alpha3 :: ', alpha(3) ++ print *, 'alpha_rho1 ::', alpha_rho(1), ', alpha_rho2 ::', alpha_rho(2), ' alpha_rho3 :: ', alpha_rho(3) ++ print *, 'E :: ', E, ', pres :: ', pres, ', rho :: ', rho ++ call s_mpi_abort('Exiting ...') ++ end if ++ + if (grid_geometry == 3) then + if (k == 0) then + fltr_dtheta = 2d0*pi*y_cb(0)/3d0 +@@ -369,7 +419,7 @@ contains + end do + end do + end do +- ! END: Computing Stability Criteria at Current Time-step =========== ++ ! end: Computing Stability Criteria at Current Time-step =========== + + ! Determining local stability criteria extrema at current time-step + +@@ -430,6 +480,7 @@ contains + t_step, t_step*dt, icfl_max_glb, & + vcfl_max_glb, & + Rc_min_glb ++ + else + write (1, '(13X,I8,14X,F10.6,13X,F9.6)') & + t_step, t_step*dt, icfl_max_glb +@@ -840,11 +891,11 @@ contains + + integer :: ifile, ierr, data_size + integer, dimension(MPI_STATUS_SIZE) :: status +- integer(KIND=MPI_OFFSET_KIND) :: disp +- integer(KIND=MPI_OFFSET_KIND) :: m_MOK, n_MOK, p_MOK +- integer(KIND=MPI_OFFSET_KIND) :: WP_MOK, var_MOK, str_MOK +- integer(KIND=MPI_OFFSET_KIND) :: NVARS_MOK +- integer(KIND=MPI_OFFSET_KIND) :: MOK ++ integer(kind=MPI_OFFSET_kind) :: disp ++ integer(kind=MPI_OFFSET_kind) :: m_MOK, n_MOK, p_MOK ++ integer(kind=MPI_OFFSET_kind) :: WP_MOK, var_MOK, str_MOK ++ integer(kind=MPI_OFFSET_kind) :: NVARS_MOK ++ integer(kind=MPI_OFFSET_kind) :: MOK + + character(LEN=path_len + 2*name_len) :: file_loc + logical :: file_exist, dir_check +@@ -876,7 +927,6 @@ contains + call DelayFileAccess(proc_rank) + + ! Initialize MPI data I/O +- + call s_initialize_mpi_data(q_cons_vf) + + ! Open the file to write all flow variables +@@ -1009,6 +1059,57 @@ contains + + end subroutine s_write_parallel_data_files + ++ !> This writes a formatted data file where the root processor ++ !! can write out the CoM information ++ !! @param t_step Current time-step ++ !! @param q_com Center of mass information ++ !! @param moments Higher moment information ++ subroutine s_write_com_files(t_step, c_mass) ! ------------------- ++ ++ integer, intent(in) :: t_step ++ real(kind(0d0)), dimension(num_fluids, 5), intent(in) :: c_mass ++ integer :: i, j !< Generic loop iterator ++ real(kind(0d0)) :: nondim_time !< Non-dimensional time ++ ++ ! Non-dimensional time calculation ++ if (t_step_old /= dflt_int) then ++ nondim_time = real(t_step + t_step_old, kind(0d0))*dt ++ else ++ nondim_time = real(t_step, kind(0d0))*dt ++ end if ++ ++ if (proc_rank == 0) then ++ if (n == 0) then ! 1D simulation ++ do i = 1, num_fluids ! Loop through fluids ++ write (i + 120, '(6X,4F24.12)') & ++ nondim_time, & ++ c_mass(i, 1), & ++ c_mass(i, 2), & ++ c_mass(i, 5) ++ end do ++ elseif (p == 0) then ! 2D simulation ++ do i = 1, num_fluids ! Loop through fluids ++ write (i + 120, '(6X,5F24.12)') & ++ nondim_time, & ++ c_mass(i, 1), & ++ c_mass(i, 2), & ++ c_mass(i, 3), & ++ c_mass(i, 5) ++ end do ++ else ! 3D simulation ++ do i = 1, num_fluids ! Loop through fluids ++ write (i + 120, '(6X,6F24.12)') & ++ nondim_time, & ++ c_mass(i, 1), & ++ c_mass(i, 2), & ++ c_mass(i, 3), & ++ c_mass(i, 4), & ++ c_mass(i, 5) ++ end do ++ end if ++ end if ++ end subroutine s_write_com_files ! ------------------------------------- ++ + !> This writes a formatted data file for the flow probe information + !! @param t_step Current time-step + !! @param q_cons_vf Conservative variables +@@ -1057,7 +1158,7 @@ contains + real(kind(0d0)) :: nondim_time !< Non-dimensional time + + real(kind(0d0)) :: tmp !< +- !! Temporary variable to store quantity for mpi_allreduce ++ !! Temporary variable to store quantity for mpi_allreduce + + real(kind(0d0)) :: blkmod1, blkmod2 !< + !! Fluid bulk modulus for Woods mixture sound speed +@@ -1118,7 +1219,7 @@ contains + l = 0 + + ! Computing/Sharing necessary state variables +- if (hypoelasticity) then ++ if (elasticity) then + call s_convert_to_mixture_variables(q_cons_vf, j - 2, k, l, & + rho, gamma, pi_inf, qv, & + Re, G, fluid_pp(:)%G) +@@ -1132,7 +1233,8 @@ contains + + dyn_p = 0.5d0*rho*dot_product(vel, vel) + +- if (hypoelasticity) then ++ if (elasticity) then ++ + call s_compute_pressure( & + q_cons_vf(1)%sf(j - 2, k, l), & + q_cons_vf(alf_idx)%sf(j - 2, k, l), & +@@ -1148,7 +1250,7 @@ contains + + if (model_eqns == 4) then + lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 +- else if (hypoelasticity) then ++ else if (elasticity) then + tau_e(1) = q_cons_vf(stress_idx%end)%sf(j - 2, k, l)/rho + end if + +@@ -1232,7 +1334,7 @@ contains + + dyn_p = 0.5d0*rho*dot_product(vel, vel) + +- if (hypoelasticity) then ++ if (elasticity) then + call s_compute_pressure( & + q_cons_vf(1)%sf(j - 2, k - 2, l), & + q_cons_vf(alf_idx)%sf(j - 2, k - 2, l), & +@@ -1247,7 +1349,7 @@ contains + + if (model_eqns == 4) then + lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 +- else if (hypoelasticity) then ++ else if (elasticity) then + do s = 1, 3 + tau_e(s) = q_cons_vf(s)%sf(j - 2, k - 2, l)/rho + end do +@@ -1274,15 +1376,13 @@ contains + R(:) = nR(:)/nbub + Rdot(:) = nRdot(:)/nbub + end if +- + ! Compute mixture sound speed + call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & + ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) + +- accel = accel_mag(j - 2, k - 2, l) + end if + end if +- else ! 3D simulation ++ else ! 3D + if ((probe(i)%x >= x_cb(-1)) .and. (probe(i)%x <= x_cb(m))) then + if ((probe(i)%y >= y_cb(-1)) .and. (probe(i)%y <= y_cb(n))) then + if ((probe(i)%z >= z_cb(-1)) .and. (probe(i)%z <= z_cb(p))) then +@@ -1315,7 +1415,7 @@ contains + + dyn_p = 0.5d0*rho*dot_product(vel, vel) + +- if (hypoelasticity) then ++ if (elasticity) then + call s_compute_pressure( & + q_cons_vf(1)%sf(j - 2, k - 2, l - 2), & + q_cons_vf(alf_idx)%sf(j - 2, k - 2, l - 2), & +@@ -1337,7 +1437,6 @@ contains + end if + end if + end if +- + if (num_procs > 1) then + #:for VAR in ['rho','pres','gamma','pi_inf','qv','c','accel'] + tmp = ${VAR}$ +@@ -1363,14 +1462,13 @@ contains + end if + end if + +- if (hypoelasticity) then ++ if (elasticity) then + do s = 1, (num_dims*(num_dims + 1))/2 + tmp = tau_e(s) + call s_mpi_allreduce_sum(tmp, tau_e(s)) + end do + end if + end if +- + if (proc_rank == 0) then + if (n == 0) then + if (bubbles .and. (num_fluids <= 2)) then +@@ -1457,7 +1555,7 @@ contains + nRdot(1), & + R(1), & + Rdot(1) +- else if (hypoelasticity) then ++ else if (elasticity) then + write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,'// & + 'F24.8,F24.8,F24.8)') & + nondim_time, & +@@ -1474,6 +1572,7 @@ contains + rho, & + vel(1), & + pres ++ print *, 'time =', nondim_time, 'rho =', rho, 'pres =', pres + end if + else + write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,'// & +@@ -1659,6 +1758,16 @@ contains + + end subroutine s_close_run_time_information_file + ++ !> Closes communication files ++ subroutine s_close_com_files() ! --------------------------------------- ++ ++ integer :: i !< Generic loop iterator ++ do i = 1, num_fluids ++ close (i + 120) ++ end do ++ ++ end subroutine s_close_com_files ! ------------------------------------- ++ + !> Closes probe files + subroutine s_close_probe_files + +@@ -1679,6 +1788,8 @@ contains + + integer :: i !< Generic loop iterator + ++ allocate (c_mass(1:num_fluids, 1:5)) ++ + ! Allocating/initializing ICFL, VCFL, CCFL and Rc stability criteria + @:ALLOCATE_GLOBAL(icfl_sf(0:m, 0:n, 0:p)) + icfl_max = 0d0 +@@ -1718,6 +1829,8 @@ contains + + integer :: i !< Generic loop iterator + ++ deallocate (c_mass) ++ + ! Deallocating the ICFL, VCFL, CCFL, and Rc stability criteria + @:DEALLOCATE_GLOBAL(icfl_sf) + if (any(Re_size > 0)) then +diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 +index 4cbe11ab..8f01d478 100644 +--- a/src/simulation/m_derived_variables.f90 ++++ b/src/simulation/m_derived_variables.f90 +@@ -20,6 +20,8 @@ module m_derived_variables + + use m_time_steppers !< Time-stepping algorithms + ++ use m_compile_specific ++ + use m_helper + ! ========================================================================== + +@@ -90,8 +92,8 @@ contains + ! Opening and writing header of flow probe files + if (proc_rank == 0) then + call s_open_probe_files() ++ call s_open_com_files() + end if +- + ! Computing centered finite difference coefficients + call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & + fd_number, fd_order) +@@ -100,12 +102,10 @@ contains + call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & + fd_number, fd_order) + end if +- + if (p > 0) then + call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & + fd_number, fd_order) + end if +- + end if + + end subroutine s_initialize_derived_variables +@@ -115,7 +115,6 @@ contains + subroutine s_compute_derived_variables(t_step) + + integer, intent(in) :: t_step +- + integer :: i, j, k !< Generic loop iterators + + if (probe_wrt) then +@@ -124,7 +123,6 @@ contains + q_prim_ts(2)%vf, & + q_prim_ts(3)%vf, & + x_accel) +- + if (n > 0) then + call s_derive_acceleration_component(2, q_prim_ts(0)%vf, & + q_prim_ts(1)%vf, & +@@ -132,7 +130,6 @@ contains + q_prim_ts(3)%vf, & + y_accel) + end if +- + if (p > 0) then + call s_derive_acceleration_component(3, q_prim_ts(0)%vf, & + q_prim_ts(1)%vf, & +@@ -140,7 +137,6 @@ contains + q_prim_ts(3)%vf, & + z_accel) + end if +- + do k = 0, p + do j = 0, n + do i = 0, m +@@ -157,8 +153,10 @@ contains + end do + end do + end do ++ call s_derive_center_of_mass(q_prim_ts(3)%vf, c_mass) + + call s_write_probe_files(t_step, q_cons_ts(1)%vf, accel_mag) ++ call s_write_com_files(t_step, c_mass) + end if + + end subroutine s_compute_derived_variables +@@ -194,7 +192,6 @@ contains + do l = 0, p + do k = 0, n + do j = 0, m +- + q_sf(j, k, l) = (11d0*q_prim_vf0(mom_idx%beg)%sf(j, k, l) & + - 18d0*q_prim_vf1(mom_idx%beg)%sf(j, k, l) & + + 9d0*q_prim_vf2(mom_idx%beg)%sf(j, k, l) & +@@ -234,18 +231,15 @@ contains + end do + end do + end do +- + ! Computing the acceleration component in the y-coordinate direction + elseif (i == 2) then + do l = 0, p + do k = 0, n + do j = 0, m +- + q_sf(j, k, l) = (11d0*q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l) & + - 18d0*q_prim_vf1(mom_idx%beg + 1)%sf(j, k, l) & + + 9d0*q_prim_vf2(mom_idx%beg + 1)%sf(j, k, l) & + - 2d0*q_prim_vf3(mom_idx%beg + 1)%sf(j, k, l))/(6d0*dt) +- + do r = -fd_number, fd_number + if (p == 0) then ! 2D simulation + q_sf(j, k, l) = q_sf(j, k, l) & +@@ -316,11 +310,154 @@ contains + + end subroutine s_derive_acceleration_component + ++ !> This subroutine is used together with the volume fraction ++ !! model and when called upon, it computes the location of ++ !! of the center of mass for each fluid from the inputted ++ !! primitive variables, q_prim_vf. The computed location ++ !! is then written to a formatted data file by the root process. ++ !! @param q_prim_vf Primitive variables ++ !! @param c_m Mass,x-location,y-location,z-location ++ subroutine s_derive_center_of_mass(q_vf, c_m) ++ type(scalar_field), dimension(sys_size), intent(IN) :: q_vf ++ real(kind(0d0)), dimension(1:num_fluids, 1:5), intent(INOUT) :: c_m ++ integer :: i, j, k, l !< Generic loop iterators ++ real(kind(0d0)) :: tmp, tmp_out !< Temporary variable to store quantity for mpi_allreduce ++ real(kind(0d0)) :: dV !< Discrete cell volume ++ ++ do i = 1, num_fluids ++ do j = 1, 5 ++ c_m(i, j) = 0.0d0 ++ end do ++ end do ++ ++ if (n == 0) then !1D simulation ++ do i = 1, num_fluids !Loop over individual fluids ++ do l = 0, p !Loop over grid ++ do k = 0, n ++ do j = 0, m ++ dV = dx(j) ++ ! Mass ++ c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV ++ ! x-location weighted ++ c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) ++ ! Volume fraction ++ c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 1)%sf(j, k, l)*dV ++ end do ++ end do ++ end do ++ end do ++ elseif (p == 0) then !2D simulation ++ do i = 1, num_fluids !Loop over individual fluids ++ do l = 0, p !Loop over grid ++ do k = 0, n ++ do j = 0, m ++ dV = dx(j)*dy(k) ++ ! Mass ++ c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV ++ ! x-location weighted ++ c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) ++ ! y-location weighted ++ c_m(i, 3) = c_m(i, 3) + q_vf(i)%sf(j, k, l)*dV*y_cc(k) ++ ! Volume fraction ++ c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 1)%sf(j, k, l)*dV ++ end do ++ end do ++ end do ++ end do ++ else !3D simulation ++ do i = 1, num_fluids !Loop over individual fluids ++ do l = 0, p !Loop over grid ++ do k = 0, n ++ do j = 0, m ++ dV = dx(j)*dy(k)*dz(l) ++ ! Mass ++ c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV ++ ! x-location weighted ++ c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) ++ ! y-location weighted ++ c_m(i, 3) = c_m(i, 3) + q_vf(i)%sf(j, k, l)*dV*y_cc(k) ++ ! z-location weighted ++ c_m(i, 4) = c_m(i, 4) + q_vf(i)%sf(j, k, l)*dV*z_cc(l) ++ ! Volume fraction ++ c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 1)%sf(j, k, l)*dV ++ end do ++ end do ++ end do ++ end do ++ end if ++ if (n == 0) then !1D simulation ++ do i = 1, num_fluids !Loop over individual fluids ++ ! Sum all components across all processors using MPI_ALLREDUCE ++ if (num_procs > 1) then ++ tmp = c_m(i, 1) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 1) = tmp_out ++ tmp = c_m(i, 2) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 2) = tmp_out ++ tmp = c_m(i, 5) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 5) = tmp_out ++ end if ++ ! Compute quotients ++ c_m(i, 2) = c_m(i, 2)/c_m(i, 1) ++ end do ++ elseif (p == 0) then !2D simulation ++ do i = 1, num_fluids !Loop over individual fluids ++ ! Sum all components across all processors using MPI_ALLREDUCE ++ if (num_procs > 1) then ++ tmp = c_m(i, 1) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 1) = tmp_out ++ tmp = c_m(i, 2) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 2) = tmp_out ++ tmp = c_m(i, 3) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 3) = tmp_out ++ tmp = c_m(i, 5) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 5) = tmp_out ++ end if ++ ! Compute quotients ++ c_m(i, 2) = c_m(i, 2)/c_m(i, 1) ++ c_m(i, 3) = c_m(i, 3)/c_m(i, 1) ++ end do ++ else !3D simulation ++ do i = 1, num_fluids !Loop over individual fluids ++ ! Sum all components across all processors using MPI_ALLREDUCE ++ if (num_procs > 1) then ++ tmp = c_m(i, 1) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 1) = tmp_out ++ tmp = c_m(i, 2) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 2) = tmp_out ++ tmp = c_m(i, 3) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 3) = tmp_out ++ tmp = c_m(i, 4) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 4) = tmp_out ++ tmp = c_m(i, 5) ++ call s_mpi_allreduce_sum(tmp, tmp_out) ++ c_m(i, 5) = tmp_out ++ end if ++ ! Compute quotients ++ c_m(i, 2) = c_m(i, 2)/c_m(i, 1) ++ c_m(i, 3) = c_m(i, 3)/c_m(i, 1) ++ c_m(i, 4) = c_m(i, 4)/c_m(i, 1) ++ end do ++ end if ++ ++ end subroutine s_derive_center_of_mass ! ---------------------------------- ++ + !> Deallocation procedures for the module + subroutine s_finalize_derived_variables_module + + ! Closing CoM and flow probe files + if (proc_rank == 0) then ++ call s_close_com_files() + if (probe_wrt) then + call s_close_probe_files() + end if +diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp +index a703eb5c..539d3b56 100644 +--- a/src/simulation/m_global_parameters.fpp ++++ b/src/simulation/m_global_parameters.fpp +@@ -144,9 +144,12 @@ module m_global_parameters + integer :: wave_speeds !< Wave speeds estimation method + integer :: avg_state !< Average state evaluation method + logical :: alt_soundspeed !< Alternate mixture sound speed +- logical :: null_weights !< Null undesired WENO weights +- logical :: mixture_err !< Mixture properties correction +- logical :: hypoelasticity !< hypoelasticity modeling ++ logical :: null_weights !< Null undesired WENO weights ++ logical :: mixture_err !< Mixture properties correction ++ logical :: hypoelasticity !< hypoelasticity modeling ++ logical :: hyperelasticity !< hyperelasticity modeling ++ integer :: hyper_model !< hyperelasticity solver algorithm ++ logical :: elasticity !< elasticity modeling, true for hyper or hypo + logical :: cu_tensor + + logical :: bodyForces +@@ -166,7 +169,7 @@ module m_global_parameters + !$acc declare create(num_dims, weno_polyn, weno_order, num_fluids, wenojs, mapped_weno, wenoz, teno) + #:endif + +- !$acc declare create(mpp_lim, model_eqns, mixture_err, alt_soundspeed, avg_state, mp_weno, weno_eps, teno_CT, hypoelasticity, low_Mach) ++ !$acc declare create(mpp_lim, model_eqns, mixture_err, alt_soundspeed, avg_state, mp_weno, weno_eps, teno_CT, hypoelasticity, hyperelasticity, elasticity, low_Mach) + + logical :: relax !< activate phase change + integer :: relax_model !< Relaxation model +@@ -182,6 +185,8 @@ module m_global_parameters + type(int_bounds_info) :: bc_x, bc_y, bc_z + !> @} + type(bounds_info) :: x_domain, y_domain, z_domain ++ real(kind(0d0)) :: x_a, y_a, z_a ++ real(kind(0d0)) :: x_b, y_b, z_b + + logical :: parallel_io !< Format of the data files + logical :: file_per_process !< shared file or not when using parallel io +@@ -208,19 +213,22 @@ module m_global_parameters + !> @name Annotations of the structure of the state and flux vectors in terms of the + !! size and the configuration of the system of equations to which they belong + !> @{ +- integer :: sys_size !< Number of unknowns in system of eqns. ++ integer :: sys_size !< Number of unknowns in system of eqns. + type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. + type(int_bounds_info) :: mom_idx !< Indexes of first & last momentum eqns. +- integer :: E_idx !< Index of energy equation +- integer :: n_idx !< Index of number density ++ integer :: E_idx !< Index of energy equation ++ integer :: n_idx !< Index of number density + type(int_bounds_info) :: adv_idx !< Indexes of first & last advection eqns. + type(int_bounds_info) :: internalEnergies_idx !< Indexes of first & last internal energy eqns. +- type(bub_bounds_info) :: bub_idx !< Indexes of first & last bubble variable eqns. +- integer :: alf_idx !< Index of void fraction +- integer :: gamma_idx !< Index of specific heat ratio func. eqn. +- integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. ++ type(bub_bounds_info) :: bub_idx !< Indexes of first & last bubble variable eqns. ++ integer :: alf_idx !< Index of void fraction ++ integer :: gamma_idx !< Index of specific heat ratio func. eqn. ++ integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. + type(int_bounds_info) :: stress_idx !< Indexes of first and last shear stress eqns. +- integer :: c_idx ! Index of the color function ++ type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. ++ integer :: b_size !< Number of elements in the symmetric b tensor, plus one ++ integer :: tensor_size !< Number of elements in the full tensor plus one ++ integer :: c_idx !< Index of the color function + !> @} + + !$acc declare create(bub_idx) +@@ -273,7 +281,7 @@ module m_global_parameters + + integer :: startx, starty, startz + +- !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx) ++ !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx,b_size, tensor_size, xi_idx) + + ! END: Simulation Algorithm Parameters ===================================== + +@@ -299,6 +307,7 @@ module m_global_parameters + !! The finite-difference number is given by MAX(1, fd_order/2). Essentially, + !! it is a measure of the half-size of the finite-difference stencil for the + !! selected order of accuracy. ++ !$acc declare create(fd_order,fd_number) + + logical :: probe_wrt + logical :: integral_wrt +@@ -435,7 +444,9 @@ module m_global_parameters + integer :: intxb, intxe + integer :: bubxb, bubxe + integer :: strxb, strxe ++ integer :: xibeg, xiend + !$acc declare create(momxb, momxe, advxb, advxe, contxb, contxe, intxb, intxe, bubxb, bubxe, strxb, strxe) ++!$acc declare create(xibeg,xiend) + + #ifdef CRAY_ACC_WAR + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps) +@@ -515,6 +526,9 @@ contains + palpha_eps = dflt_real + ptgalpha_eps = dflt_real + hypoelasticity = .false. ++ hyperelasticity = .false. ++ elasticity = .false. ++ hyper_model = dflt_int + weno_flat = .true. + riemann_flat = .true. + rdma_mpi = .false. +@@ -828,13 +842,26 @@ contains + end if + end if + +- if (hypoelasticity) then ++ if (hypoelasticity .or. hyperelasticity) then ++ elasticity = .true. + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end + end if + ++ if (hyperelasticity) then ++ ! number of entries in the symmetric btensor plus the jacobian ++ b_size = (num_dims*(num_dims + 1))/2 + 1 ++ ! storing the jacobian in the last entry ++ tensor_size = num_dims**2 + 1 ++ xi_idx%beg = sys_size + 1 ++ xi_idx%end = sys_size + num_dims ++ ! adding three more equations for the \xi field and the elastic energy ++ sys_size = xi_idx%end + 1 ++ hyper_model = 1 ++ end if ++ + if (.not. f_is_default(sigma)) then + c_idx = sys_size + 1 + sys_size = c_idx +@@ -853,6 +880,25 @@ contains + internalEnergies_idx%end = adv_idx%end + num_fluids + sys_size = internalEnergies_idx%end + ++ if (hypoelasticity .or. hyperelasticity) then ++ elasticity = .true. ++ stress_idx%beg = sys_size + 1 ++ stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ++ ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D ++ sys_size = stress_idx%end ++ end if ++ ++ if (hyperelasticity) then ++ ! number of entries in the symmetric btensor plus the jacobian ++ b_size = (num_dims*(num_dims + 1))/2 + 1 ++ ! storing the jacobian in the last entry ++ tensor_size = num_dims**2 + 1 ++ xi_idx%beg = sys_size + 1 ++ xi_idx%end = sys_size + num_dims ++ ! adding three more equations for the \xi field and the elastic energy ++ sys_size = xi_idx%end + 1 ++ end if ++ + if (.not. f_is_default(sigma)) then + c_idx = sys_size + 1 + sys_size = c_idx +@@ -989,12 +1035,18 @@ contains + ! the next one + if (any(Re_size > 0)) then + buff_size = 2*weno_polyn + 2 +-! else if (hypoelasticity) then !TODO: check if necessary ++! else if (elasticity) then !TODO: check if necessary + ! buff_size = 2*weno_polyn + 2 + else + buff_size = weno_polyn + 2 + end if + ++ if (elasticity) then ++ fd_order = 4 ++ fd_number = max(1, fd_order/2) ++ !buff_size = buff_size + fd_number ++ end if ++ + ! Configuring Coordinate Direction Indexes ========================= + if (bubbles) then + ix%beg = -buff_size; iy%beg = 0; iz%beg = 0 +@@ -1024,7 +1076,8 @@ contains + if (p > 0) then + startz = -buff_size + end if +- ++ ++ !$acc update device(fd_order,fd_number) + !$acc update device(startx, starty, startz) + + if (cyl_coord .neqv. .true.) then ! Cartesian grid +@@ -1047,19 +1100,23 @@ contains + strxe = stress_idx%end + intxb = internalEnergies_idx%beg + intxe = internalEnergies_idx%end ++ xibeg = xi_idx%beg ++ xiend = xi_idx%end + +- !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe) ++ !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe, b_size, xibeg, xiend, tensor_size) + !$acc update device(m, n, p) + + !$acc update device(alt_soundspeed, acoustic_source, num_source) +- !$acc update device(dt, sys_size, buff_size, pref, rhoref, gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim, bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids, model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord, mp_weno, weno_eps, teno_CT, low_Mach) ++ !$acc update device(dt, sys_size, buff_size, pref, rhoref, gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim, bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids, model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord, mp_weno, weno_eps, teno_CT, hyperelasticity, elasticity, xi_idx, low_Mach) + + #:if not MFC_CASE_OPTIMIZATION + !$acc update device(wenojs, mapped_weno, wenoz, teno) + #:endif + + !$acc enter data copyin(nb, R0ref, Ca, Web, Re_inv, weight, R0, V0, bubbles, polytropic, polydisperse, qbmm, R0_type, ptil, bubble_model, thermal, poly_sigma) +- !$acc enter data copyin(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v, k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN , mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam) ++ ++ !$acc enter data copyin(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v, k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN, mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam) ++ + !$acc enter data copyin(dir_idx, dir_flg, dir_idx_tau) + + !$acc enter data copyin(relax, relax_model, palpha_eps,ptgalpha_eps) +diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp +new file mode 100644 +index 00000000..9d8b6a4f +--- /dev/null ++++ b/src/simulation/m_hyperelastic.fpp +@@ -0,0 +1,364 @@ ++!> ++!! @file m_hyperelastic.f90 ++!! @brief Contains module m_hyperelastic ++ ++#:include 'macros.fpp' ++ ++!> @brief This module consists of subroutines used in the calculation ++!! of the cauchy tensor ++ ++module m_hyperelastic ++ ++ ! Dependencies ============================================================= ++ ++ use m_derived_types !< Definitions of the derived types ++ ++ use m_global_parameters !< Definitions of the global parameters ++ ++ use m_variables_conversion !< State variables type conversion procedures ++ ++ use m_helper ++ ++ ! ========================================================================== ++ ++ implicit none ++ ++ private; public :: s_hyperelastic_rmt_stress_update, & ++ s_initialize_hyperelastic_module, & ++ s_finalize_hyperelastic_module ++ ++ !> @name Abstract interface for creating function pointers ++ !> @{ ++ abstract interface ++ ++ !> @name Abstract subroutine for the infinite relaxation solver ++ !> @{ ++ subroutine s_abstract_hyperelastic_solver(btensor, q_prim_vf, G, j, k, l) ++ !$acc routine seq ++ import :: scalar_field, sys_size, b_size ++ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf ++ type(scalar_field), dimension(b_size), intent(inout) :: btensor ++ real(kind(0d0)), intent(in) :: G ++ integer, intent(in) :: j, k, l ++ ++ end subroutine s_abstract_hyperelastic_solver ++ !> @} ++ ++ end interface ++ !> @} ++ ++ procedure(s_abstract_hyperelastic_solver), & ++ pointer :: s_compute_cauchy_solver => null() ++ ++ !! The btensor at the cell-interior Gaussian quadrature points. ++ !! These tensor is needed to be calculated once and make the code DRY. ++ type(vector_field) :: btensor !< ++ !$acc declare create(btensor) ++ ++#ifdef CRAY_ACC_WAR ++ @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), allocatable, dimension(:, :), fd_coeff_x, fd_coeff_y, fd_coeff_z) ++ !$acc declare link(fd_coeff_x,fd_coeff_y,fd_coeff_z) ++ ++#else ++ ++ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_x ++ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_y ++ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_z ++ !$acc declare create(fd_coeff_x,fd_coeff_y,fd_coeff_z) ++ real(kind(0d0)), allocatable, dimension(:) :: Gs ++ !$acc declare create(Gs) ++#endif ++ ++contains ++ ++ !> The following subroutine handles the calculation of the btensor. ++ !! The calculation of the btensor takes qprimvf. ++ !! @param q_prim_vf Primitive variables ++ !! @param btensor is the output ++ !! calculate the grad_xi, grad_xi is a nxn tensor ++ !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor ++ !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor ++ !! btensor is symmetric, save the data space ++ subroutine s_initialize_hyperelastic_module() ++ integer :: i !< generic iterator ++ ++ @:ALLOCATE(btensor%vf(1:b_size)) ++ do i = 1, b_size ++ @:ALLOCATE(btensor%vf(i)%sf(0:m, 0:n, 0:p)) ++ end do ++ @:ACC_SETUP_VFs(btensor) ++ ++ @:ALLOCATE(Gs(1:num_fluids)) ++ !$acc loop seq ++ do i = 1, num_fluids ++ Gs(i) = fluid_pp(i)%G ++ end do ++ !$acc update device(Gs) ++ ++ ! Associating procedural pointer to the subroutine that will be ++ ! utilized to calculate the solution of a given Riemann problem ++ if (hyper_model == 1) then ++ s_compute_cauchy_solver => s_neoHookean_cauchy_solver ++ elseif (riemann_solver == 2) then ++ s_compute_cauchy_solver => s_Mooney_Rivlin_cauchy_solver ++ end if ++ ++ @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) ++ if (n > 0) then ++ @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) ++ end if ++ if (p > 0) then ++ @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) ++ end if ++ ++ ! Computing centered finite difference coefficients ++ call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & ++ fd_number, fd_order) ++ !$acc update device(fd_coeff_x) ++ if (n > 0) then ++ call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & ++ fd_number, fd_order) ++ !$acc update device(fd_coeff_y) ++ end if ++ if (p > 0) then ++ call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & ++ fd_number, fd_order) ++ !$acc update device(fd_coeff_z) ++ end if ++ ++ end subroutine s_initialize_hyperelastic_module ++ ++ !> The following subroutine handles the calculation of the btensor. ++ !! The calculation of the btensor takes qprimvf. ++ !! @param q_prim_vf Primitive variables ++ !! @param btensor is the output ++ !! calculate the grad_xi, grad_xi is a nxn tensor ++ !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor ++ !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor ++ !! btensor is symmetric, save the data space ++ subroutine s_hyperelastic_rmt_stress_update(q_cons_vf,q_prim_vf) ++ ++ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf ++ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf ++ ++ real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb ++ real(kind(0d0)), dimension(num_fluids) :: alpha_K, alpha_rho_K ++ real(kind(0d0)), dimension(2) :: Re_K ++ real(kind(0d0)) :: rho_K, gamma_K, pi_inf_K, qv_K ++ real(kind(0d0)) :: G_K ++ integer :: j, k, l, i, r ++ ++ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,Re_K, tensora, tensorb) ++ do l = 0, p-2 ++ do k = 0, n-2 ++ do j = 2, m-2 ++ !$acc loop seq ++ do i = 1, num_fluids ++ alpha_rho_K(i) = q_cons_vf(i)%sf(j, k, l) ++ alpha_K(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) ++ end do ++ ! If in simulation, use acc mixture subroutines ++ call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & ++ alpha_rho_K, Re_K, j, k, l, G_K, Gs) ++ rho_K = max(rho_K, sgm_eps) ++ if ( G_K .le. verysmall ) G_K = 0d0 ++ ++ if ( G_K .gt. 20d0 ) then ++ !$acc loop seq ++ do i = 1, tensor_size ++ tensora(i) = 0d0 ++ end do ++ ! STEP 1: computing the grad_xi tensor using finite differences ++ ! grad_xi definition / organization ++ ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx ++ ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy ++ ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz ++ !$acc loop seq ++ do r = -fd_number, fd_number ++ ! derivatives in the x-direction ++ tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) ++ tensora(2) = tensora(2) + q_prim_vf(xibeg+1)%sf(j + r, k, l)*fd_coeff_x(r, j) ++ tensora(3) = tensora(3) + q_prim_vf(xiend)%sf(j + r, k, l)*fd_coeff_x(r, j) ++ ! derivatives in the y-direction ++ tensora(4) = tensora(4) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) ++ tensora(5) = tensora(5) + q_prim_vf(xibeg+1)%sf(j, k + r, l)*fd_coeff_y(r, k) ++ tensora(6) = tensora(6) + q_prim_vf(xiend)%sf(j, k + r, l)*fd_coeff_y(r, k) ++ ! derivatives in the z-direction ++ tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_z(r, l) ++ tensora(8) = tensora(8) + q_prim_vf(xibeg+1)%sf(j, k, l + r)*fd_coeff_z(r, l) ++ tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_z(r, l) ++ end do ++ ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse ++ tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) ++ tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) ++ tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) ++ tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) ++ tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) ++ tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) ++ tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) ++ tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) ++ tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) ++ ++ ! STEP 2b: computing the determinant of the grad_xi tensor ++ tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & ++ - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & ++ + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) ++ ++ if (tensorb(tensor_size) > 0d0) then ++ ! STEP 2c: computing the inverse of grad_xi tensor = F ++ ! tensorb is the adjoint, tensora becomes F ++ !$acc loop seq ++ do i = 1, tensor_size - 1 ++ tensora(i) = tensorb(i)/tensorb(tensor_size) ++ end do ++ ++ ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) ++ tensorb(tensor_size) = 1d0/tensorb(tensor_size) ++ ++ ! STEP 3: computing F tranpose F ++ tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 ++ tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 ++ tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 ++ tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) ++ tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) ++ tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) ++ ! STEP 4: update the btensor, this is consistent with Riemann solvers ++ ! \tau_xx ++ btensor%vf(1)%sf(j, k, l) = tensorb(1) ++ ! \tau_xy ++ btensor%vf(2)%sf(j, k, l) = tensorb(2) ++ ! \tau_yy ++ btensor%vf(3)%sf(j, k, l) = tensorb(5) ++ ! \tau_xz ++ btensor%vf(4)%sf(j, k, l) = tensorb(3) ++ ! \tau_yz ++ btensor%vf(5)%sf(j, k, l) = tensorb(6) ++ ! \tau_zz ++ btensor%vf(6)%sf(j, k, l) = tensorb(9) ++ ! store the determinant at the last entry of the btensor ++ btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) ++ ! STEP 5a: updating the Cauchy stress primitive scalar field ++ call s_compute_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) ++ ! STEP 5b: updating the pressure field ++ q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & ++ G_K*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma_K ++ ! STEP 5c: updating the Cauchy stress conservative scalar field ++ !$acc loop seq ++ do i = 1, b_size - 1 ++ q_cons_vf(strxb + i - 1)%sf(j, k, l) = & ++ rho_K*q_prim_vf(strxb + i - 1)%sf(j, k, l) ++ end do ++ end if ++ end if ++ end do ++ end do ++ end do ++ !$acc end parallel loop ++ end subroutine s_hyperelastic_rmt_stress_update ++ ++ !> The following subroutine handles the calculation of the btensor. ++ !! The calculation of the btensor takes qprimvf. ++ !! @param q_prim_vf Primitive variables ++ !! @param btensor is the output ++ !! calculate the grad_xi, grad_xi is a nxn tensor ++ !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor ++ !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor ++ !! btensor is symmetric, save the data space ++ subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) ++ !$acc routine seq ++ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf ++ type(scalar_field), dimension(b_size), intent(inout) :: btensor ++ real(kind(0d0)), intent(in) :: G ++ integer, intent(in) :: j, k, l ++ ++ real(kind(0d0)) :: trace ++ real(kind(0d0)) :: f13 = 1d0/3d0 ++ integer :: i !< Generic loop iterators ++ ++ !TODO Make this 1D and 2D capable ++ ! tensor is the symmetric tensor & calculate the trace of the tensor ++ trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) ++ ++ ! calculate the deviatoric of the tensor ++ btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace ++ btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace ++ btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace ++ ++ ! dividing by the jacobian for neo-Hookean model ++ ! setting the tensor to the stresses for riemann solver ++ !$acc loop seq ++ do i = 1, b_size - 1 ++ q_prim_vf(strxb + i - 1)%sf(j, k, l) = & ++ G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) ++ end do ++ ! compute the invariant without the elastic modulus ++ q_prim_vf(xiend + 1)%sf(j, k, l) = & ++ 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) ++ ++ end subroutine s_neoHookean_cauchy_solver ++ ++ !> The following subroutine handles the calculation of the btensor. ++ !! The calculation of the btensor takes qprimvf. ++ !! @param q_prim_vf Primitive variables ++ !! @param btensor is the output ++ !! calculate the grad_xi, grad_xi is a nxn tensor ++ !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor ++ !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor ++ !! btensor is symmetric, save the data space ++ subroutine s_Mooney_Rivlin_cauchy_solver(btensor, q_prim_vf, G, j, k, l) ++ !$acc routine seq ++ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf ++ type(scalar_field), dimension(b_size), intent(inout) :: btensor ++ real(kind(0d0)), intent(in) :: G ++ integer, intent(in) :: j, k, l ++ ++ real(kind(0d0)) :: trace ++ real(kind(0d0)) :: f13 = 1d0/3d0 ++ integer :: i !< Generic loop iterators ++ ++ !TODO Make this 1D and 2D capable ++ ! tensor is the symmetric tensor & calculate the trace of the tensor ++ trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) ++ ++ ! calculate the deviatoric of the tensor ++ btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace ++ btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace ++ btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace ++ ++ ! dividing by the jacobian for neo-Hookean model ++ ! setting the tensor to the stresses for riemann solver ++ !$acc loop seq ++ do i = 1, b_size - 1 ++ q_prim_vf(strxb + i - 1)%sf(j, k, l) = & ++ G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) ++ end do ++ ! compute the invariant without the elastic modulus ++ q_prim_vf(xiend + 1)%sf(j, k, l) = & ++ 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) ++ ++ end subroutine s_Mooney_Rivlin_cauchy_solver ++ ++ ++ subroutine s_finalize_hyperelastic_module() ++ ++ integer :: i !< iterator ++ ++ ! Disassociating procedural pointer to the subroutine which was ++ ! utilized to calculate the solution of a given Riemann problem ++ s_compute_cauchy_solver => null() ++ ++ ! Deallocating memory ++ do i = 1, b_size ++ @:DEALLOCATE_GLOBAL(btensor%vf(i)%sf) ++ end do ++ @:DEALLOCATE_GLOBAL(fd_coeff_x) ++ if (n > 0) then ++ @:DEALLOCATE_GLOBAL(fd_coeff_y) ++ if (p > 0) then ++ @:DEALLOCATE_GLOBAL(fd_coeff_z) ++ end if ++ end if ++ ++ end subroutine s_finalize_hyperelastic_module ++ ++end module m_hyperelastic +diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp +index e3bb7ec0..7f3d54c3 100644 +--- a/src/simulation/m_hypoelastic.fpp ++++ b/src/simulation/m_hypoelastic.fpp +@@ -13,13 +13,16 @@ module m_hypoelastic + + use m_global_parameters !< Definitions of the global parameters + +- use m_mpi_proxy !< Message passing interface (MPI) module proxy ++! use m_mpi_proxy !< Message passing interface (MPI) module proxy ++ ++ use m_helper + + ! ========================================================================== + + implicit none + + private; public :: s_initialize_hypoelastic_module, & ++ s_finalize_hypoelastic_module, & + s_compute_hypoelastic_rhs + + #ifdef CRAY_ACC_WAR +@@ -33,6 +36,10 @@ module m_hypoelastic + + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), rho_K_field, G_K_field) + !$acc declare link(rho_K_field, G_K_field) ++ ++ @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), allocatable, dimension(:, :), fd_coeff_x, fd_coeff_y, fd_coeff_z) ++ !$acc declare link(fd_coeff_x,fd_coeff_y,fd_coeff_z) ++ + #else + real(kind(0d0)), allocatable, dimension(:) :: Gs + !$acc declare create(Gs) +@@ -45,13 +52,17 @@ module m_hypoelastic + real(kind(0d0)), allocatable, dimension(:, :, :) :: rho_K_field, G_K_field + !$acc declare create(rho_K_field, G_K_field) + ++ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_x ++ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_y ++ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_z ++ !$acc declare create(fd_coeff_x,fd_coeff_y,fd_coeff_z) + #endif + + contains + + subroutine s_initialize_hypoelastic_module + +- integer :: i ++ integer :: i, k, r + + @:ALLOCATE_GLOBAL(Gs(1:num_fluids)) + @:ALLOCATE_GLOBAL(rho_K_field(0:m,0:n,0:p), G_K_field(0:m,0:n,0:p)) +@@ -69,6 +80,29 @@ contains + end do + !$acc update device(Gs) + ++ @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) ++ if (n > 0) then ++ @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) ++ end if ++ if (p > 0) then ++ @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) ++ end if ++ ++ ! Computing centered finite difference coefficients ++ call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & ++ fd_number, fd_order) ++ !$acc update device(fd_coeff_x) ++ if (n > 0) then ++ call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & ++ fd_number, fd_order) ++ !$acc update device(fd_coeff_y) ++ end if ++ if (p > 0) then ++ call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & ++ fd_number, fd_order) ++ !$acc update device(fd_coeff_z) ++ end if ++ + end subroutine s_initialize_hypoelastic_module + + !> The purpose of this procedure is to compute the source terms +@@ -84,7 +118,7 @@ contains + + real(kind(0d0)) :: rho_K, G_K + +- integer :: i, k, l, q !< Loop variables ++ integer :: i, k, l, q, r !< Loop variables + integer :: ndirs !< Number of coordinate directions + + ndirs = 1; if (n > 0) ndirs = 2; if (p > 0) ndirs = 3 +@@ -97,82 +131,91 @@ contains + do q = 0, p + do l = 0, n + do k = 0, m +- du_dx(k, l, q) = & +- (q_prim_vf(momxb)%sf(k - 2, l, q) & +- - 8d0*q_prim_vf(momxb)%sf(k - 1, l, q) & +- + 8d0*q_prim_vf(momxb)%sf(k + 1, l, q) & +- - q_prim_vf(momxb)%sf(k + 2, l, q)) & +- /(12d0*dx(k)) ++ du_dx(k, l, q) = 0d0; + end do + end do + end do ++ !$acc end parallel loop ++ ++ !$acc parallel loop collapse(3) gang vector default(present) ++ do q = 0, p ++ do l = 0, n ++ do k = 0, m ++ !$acc loop seq ++ do r = -fd_number, fd_number ++ du_dx(k, l, q) = du_dx(k, l, q) & ++ + q_prim_vf(momxb)%sf(k + r, l, q)*fd_coeff_x(r, k) ++ end do ++ ++ end do ++ end do ++ end do ++ !$acc end parallel loop + + if (ndirs > 1) then + !$acc parallel loop collapse(3) gang vector default(present) + do q = 0, p +- do l = 0, n +- do k = 0, m +- du_dy(k, l, q) = & +- (q_prim_vf(momxb)%sf(k, l - 2, q) & +- - 8d0*q_prim_vf(momxb)%sf(k, l - 1, q) & +- + 8d0*q_prim_vf(momxb)%sf(k, l + 1, q) & +- - q_prim_vf(momxb)%sf(k, l + 2, q)) & +- /(12d0*dy(l)) +- dv_dx(k, l, q) = & +- (q_prim_vf(momxb + 1)%sf(k - 2, l, q) & +- - 8d0*q_prim_vf(momxb + 1)%sf(k - 1, l, q) & +- + 8d0*q_prim_vf(momxb + 1)%sf(k + 1, l, q) & +- - q_prim_vf(momxb + 1)%sf(k + 2, l, q)) & +- /(12d0*dx(k)) +- dv_dy(k, l, q) = & +- (q_prim_vf(momxb + 1)%sf(k, l - 2, q) & +- - 8d0*q_prim_vf(momxb + 1)%sf(k, l - 1, q) & +- + 8d0*q_prim_vf(momxb + 1)%sf(k, l + 1, q) & +- - q_prim_vf(momxb + 1)%sf(k, l + 2, q)) & +- /(12d0*dy(l)) +- end do ++ do l = 0, n ++ do k = 0, m ++ du_dy(k, l, q) = 0d0; dv_dx(k, l, q) = 0d0; dv_dy(k, l, q) = 0d0; + end do ++ end do ++ end do ++ !$acc end parallel loop ++ ++ !$acc parallel loop collapse(3) gang vector default(present) ++ do q = 0, p ++ do l = 0, n ++ do k = 0, m ++ !$acc loop seq ++ do r = -fd_number, fd_number ++ du_dy(k, l, q) = du_dy(k, l, q) & ++ + q_prim_vf(momxb)%sf(k, l + r, q)*fd_coeff_y(r, l) ++ dv_dx(k, l, q) = dv_dx(k, l, q) & ++ + q_prim_vf(momxb + 1)%sf(k + r, l, q)*fd_coeff_x(r, k) ++ dv_dy(k, l, q) = dv_dy(k, l, q) & ++ + q_prim_vf(momxb + 1)%sf(k, l + r, q)*fd_coeff_y(r, l) ++ end do ++ end do ++ end do + end do ++ !$acc end parallel loop + + ! 3D + if (ndirs == 3) then ++ + !$acc parallel loop collapse(3) gang vector default(present) + do q = 0, p +- do l = 0, n +- do k = 0, m +- du_dz(k, l, q) = & +- (q_prim_vf(momxb)%sf(k, l, q - 2) & +- - 8d0*q_prim_vf(momxb)%sf(k, l, q - 1) & +- + 8d0*q_prim_vf(momxb)%sf(k, l, q + 1) & +- - q_prim_vf(momxb)%sf(k, l, q + 2)) & +- /(12d0*dz(q)) +- dv_dz(k, l, q) = & +- (q_prim_vf(momxb + 1)%sf(k, l, q - 2) & +- - 8d0*q_prim_vf(momxb + 1)%sf(k, l, q - 1) & +- + 8d0*q_prim_vf(momxb + 1)%sf(k, l, q + 1) & +- - q_prim_vf(momxb + 1)%sf(k, l, q + 2)) & +- /(12d0*dz(q)) +- dw_dx(k, l, q) = & +- (q_prim_vf(momxe)%sf(k - 2, l, q) & +- - 8d0*q_prim_vf(momxe)%sf(k - 1, l, q) & +- + 8d0*q_prim_vf(momxe)%sf(k + 1, l, q) & +- - q_prim_vf(momxe)%sf(k + 2, l, q)) & +- /(12d0*dx(k)) +- dw_dy(k, l, q) = & +- (q_prim_vf(momxe)%sf(k, l - 2, q) & +- - 8d0*q_prim_vf(momxe)%sf(k, l - 1, q) & +- + 8d0*q_prim_vf(momxe)%sf(k, l + 1, q) & +- - q_prim_vf(momxe)%sf(k, l + 2, q)) & +- /(12d0*dy(l)) +- dw_dz(k, l, q) = & +- (q_prim_vf(momxe)%sf(k, l, q - 2) & +- - 8d0*q_prim_vf(momxe)%sf(k, l, q - 1) & +- + 8d0*q_prim_vf(momxe)%sf(k, l, q + 1) & +- - q_prim_vf(momxe)%sf(k, l, q + 2)) & +- /(12d0*dz(q)) +- end do ++ do l = 0, n ++ do k = 0, m ++ du_dz(k, l, q) = 0d0; dv_dz(k, l, q) = 0d0; dw_dx(k, l, q) = 0d0; ++ dw_dy(k, l, q) = 0d0; dw_dz(k, l, q) = 0d0; + end do ++ end do ++ end do ++ !$acc end parallel loop ++ ++ !$acc parallel loop collapse(3) gang vector default(present) ++ do q = 0, p ++ do l = 0, n ++ do k = 0, m ++ !$acc loop seq ++ do r = -fd_number, fd_number ++ du_dz(k, l, q) = du_dz(k, l, q) & ++ + q_prim_vf(momxb)%sf(k, l, q + r)*fd_coeff_z(r, q) ++ dv_dz(k, l, q) = dv_dz(k, l, q) & ++ + q_prim_vf(momxb + 1)%sf(k, l, q + r)*fd_coeff_z(r, q) ++ dw_dx(k, l, q) = dw_dx(k, l, q) & ++ + q_prim_vf(momxe)%sf(k + r, l, q)*fd_coeff_x(r, k) ++ dw_dy(k, l, q) = dw_dy(k, l, q) & ++ + q_prim_vf(momxe)%sf(k, l + r, q)*fd_coeff_y(r, l) ++ dw_dz(k, l, q) = dw_dz(k, l, q) & ++ + q_prim_vf(momxe)%sf(k, l, q + r)*fd_coeff_z(r, q) ++ end do ++ end do ++ end do + end do ++ !$acc end parallel loop + end if + end if + +@@ -189,7 +232,7 @@ contains + G_K_field(k, l, q) = G_K + + !TODO: take this out if not needed +- if (G_K < 1000) then ++ if (G_K < verysmall) then + G_K_field(k, l, q) = 0 + end if + end do +@@ -314,4 +357,21 @@ contains + + end subroutine s_compute_hypoelastic_rhs + ++ subroutine s_finalize_hypoelastic_module() ! -------------------- ++ ++ @:DEALLOCATE_GLOBAL(Gs) ++ @:DEALLOCATE_GLOBAL(rho_K_field, G_K_field) ++ @:DEALLOCATE_GLOBAL(du_dx) ++ @:DEALLOCATE_GLOBAL(fd_coeff_x) ++ if (n > 0) then ++ @:DEALLOCATE_GLOBAL(du_dy,dv_dx,dv_dy) ++ @:DEALLOCATE_GLOBAL(fd_coeff_y) ++ if (p > 0) then ++ @:DEALLOCATE_GLOBAL(du_dz, dv_dz, dw_dx, dw_dy, dw_dz) ++ @:DEALLOCATE_GLOBAL(fd_coeff_z) ++ end if ++ end if ++ ++ end subroutine s_finalize_hypoelastic_module ++ + end module m_hypoelastic +diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp +index a0fa5972..01c34581 100644 +--- a/src/simulation/m_ibm.fpp ++++ b/src/simulation/m_ibm.fpp +@@ -208,7 +208,7 @@ contains + + if (model_eqns /= 4) then + ! If in simulation, use acc mixture subroutines +- if (hypoelasticity) then ++ if (elasticity) then + call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv_K, alpha_IP, & + alpha_rho_IP, Re_K, j, k, l, G_K, Gs) + else if (bubbles) then +diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp +index 26700d16..513d5bec 100644 +--- a/src/simulation/m_mpi_proxy.fpp ++++ b/src/simulation/m_mpi_proxy.fpp +@@ -173,7 +173,40 @@ contains + !! available to the other processors. Then, the purpose of + !! this subroutine is to distribute the user inputs to the + !! remaining processors in the communicator. +- subroutine s_mpi_bcast_user_inputs ++ ++ subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root) ++ ++#ifdef MFC_MPI ++ ++ implicit none ++ integer, intent(in) :: counts ! Array of vector lengths for each process ++ real(kind(0d0)), intent(in), dimension(counts) :: my_vector ! Input vector on each process ++ integer, intent(in) :: root ! Rank of the root process ++ real(kind(0d0)), allocatable, intent(out) :: gathered_vector(:) ! Gathered vector on the root process ++ ++ integer :: i, offset, ierr ++ integer, allocatable :: recounts(:), displs(:) ++ ++ allocate (recounts(num_procs)) ++ ++ call MPI_GATHER(counts, 1, MPI_INTEGER, recounts, 1, MPI_INTEGER, root, & ++ MPI_COMM_WORLD, ierr) ++ ++ allocate (displs(size(recounts))) ++ ++ displs(1) = 0 ++ ++ do i = 2, size(recounts) ++ displs(i) = displs(i - 1) + recounts(i - 1) ++ end do ++ ++ allocate (gathered_vector(sum(recounts))) ++ call MPI_GATHERV(my_vector, counts, MPI_DOUBLE_PRECISION, gathered_vector, recounts, displs, MPI_DOUBLE_PRECISION, & ++ root, MPI_COMM_WORLD, ierr) ++#endif ++ end subroutine s_mpi_gather_data ++ ++ subroutine s_mpi_bcast_user_inputs() ! --------------------------------- + + #ifdef MFC_MPI + +@@ -202,7 +235,8 @@ contains + & 'parallel_io', 'hypoelasticity', 'bubbles', 'polytropic', & + & 'polydisperse', 'qbmm', 'acoustic_source', 'probe_wrt', 'integral_wrt', & + & 'prim_vars_wrt', 'weno_avg', 'file_per_process', 'relax', & +- & 'adv_n', 'adap_dt', 'ib', 'bodyForces', 'bf_x', 'bf_y', 'bf_z' ] ++ & 'adv_n', 'adap_dt', 'ib', 'bodyForces', 'bf_x', 'bf_y', 'bf_z', & ++ & 'hyperelasticity' ] + call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) + #:endfor + +@@ -212,7 +246,8 @@ contains + & 'bc_y%vb1','bc_y%vb2','bc_y%vb3','bc_y%ve1','bc_y%ve2','bc_y%ve3', & + & 'bc_z%vb1','bc_z%vb2','bc_z%vb3','bc_z%ve1','bc_z%ve2','bc_z%ve3', & + & 'x_domain%beg', 'x_domain%end', 'y_domain%beg', 'y_domain%end', & +- & 'z_domain%beg', 'z_domain%end'] ++ & 'z_domain%beg', 'z_domain%end', 'x_a', 'x_b', 'y_a', 'y_b', 'z_a', & ++ & 'z_b'] + call MPI_BCAST(${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + #:endfor + +diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp +index c2056b42..72bb1c87 100644 +--- a/src/simulation/m_rhs.fpp ++++ b/src/simulation/m_rhs.fpp +@@ -39,6 +39,8 @@ module m_rhs + + use m_hypoelastic + ++ use m_hyperelastic ++ + use m_acoustic_src + + use m_viscous +@@ -615,7 +617,6 @@ contains + if (riemann_solver /= 1) then + do l = adv_idx%beg + 1, adv_idx%end + flux_src_n(i)%vf(l)%sf => flux_src_n(i)%vf(adv_idx%beg)%sf +- + !$acc enter data attach(flux_src_n(i)%vf(l)%sf) + end do + end if +@@ -623,7 +624,6 @@ contains + do l = 1, sys_size + flux_n(i)%vf(l)%sf => flux_n(1)%vf(l)%sf + flux_src_n(i)%vf(l)%sf => flux_src_n(1)%vf(l)%sf +- + !$acc enter data attach(flux_n(i)%vf(l)%sf,flux_src_n(i)%vf(l)%sf) + end do + end if +@@ -778,7 +778,7 @@ contains + end do + end do + end if +- ++ !print *, "I got here A" + call nvtxStartRange("RHS-CONVERT") + call s_convert_conservative_to_primitive_variables( & + q_cons_qp%vf, & +@@ -786,10 +786,16 @@ contains + gm_alpha_qp%vf, & + ix, iy, iz) + call nvtxEndRange ++ !print *, "I got here B" + + call nvtxStartRange("RHS-MPI") + call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) + call nvtxEndRange ++ !print *, "I got here c" ++ ++ call nvtxStartRange("RHS-ELASTIC") ++ if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_qp%vf,q_prim_qp%vf) ++ call nvtxEndRange + + if (t_step == t_step_stop) return + ! ================================================================== +@@ -897,10 +903,8 @@ contains + end if + ix%end = m; iy%end = n; iz%end = p + ! =============================================================== +- call nvtxStartRange("RHS_riemann_solver") +- + ! Computing Riemann Solver Flux and Source Flux ================= +- ++ call nvtxStartRange("RHS_riemann_solver") + call s_riemann_solver(qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, & + dqR_prim_dx_n(id)%vf, & + dqR_prim_dy_n(id)%vf, & +@@ -917,9 +921,10 @@ contains + flux_gsrc_n(id)%vf, & + id, ix, iy, iz) + call nvtxEndRange ++ !print *, "I got here e" + +- ! Additional physics and source terms ============================== +- ++ ! =============================================================== ++ ! Additional physics and source terms =========================== + ! RHS addition for advection source + call nvtxStartRange("RHS_advection_source") + call s_compute_advection_source_term(id, & +@@ -935,6 +940,7 @@ contains + q_prim_qp%vf, & + rhs_vf) + call nvtxEndRange ++ !print *, "I got here f" + + ! RHS additions for viscosity + call nvtxStartRange("RHS_add_phys") +@@ -1006,6 +1012,7 @@ contains + rhs_vf) + call nvtxEndRange + ! END: Additional pphysics and source terms ============================ ++ !print *, "I got here g" + + if (run_time_info .or. probe_wrt .or. ib) then + +@@ -1033,6 +1040,7 @@ contains + time_avg = 0d0 + end if + ! ================================================================== ++ !print *, "I got here h" + + call nvtxEndRange + end subroutine s_compute_rhs +diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp +index bfca7142..16b20b02 100644 +--- a/src/simulation/m_riemann_solvers.fpp ++++ b/src/simulation/m_riemann_solvers.fpp +@@ -162,14 +162,14 @@ module m_riemann_solvers + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsx_vf, flux_src_rsx_vf) + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsy_vf, flux_src_rsy_vf) + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsz_vf, flux_src_rsz_vf) +- !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & +- !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) ++ !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & ++ !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) + #else + real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsx_vf, flux_src_rsx_vf + real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsy_vf, flux_src_rsy_vf + real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsz_vf, flux_src_rsz_vf +- !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & +- !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) ++ !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & ++ !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf) + #endif + !> @} + +@@ -313,6 +313,7 @@ contains + real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R + real(kind(0d0)) :: G_L, G_R + real(kind(0d0)), dimension(2) :: Re_L, Re_R ++ real(kind(0d0)), dimension(3) :: xi_field_L, xi_field_R + + real(kind(0d0)) :: rho_avg + real(kind(0d0)), dimension(num_dims) :: vel_avg +@@ -356,8 +357,7 @@ contains + #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] + + if (norm_dir == ${NORM_DIR}$) then +- !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, & +- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S) ++ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, xi_field_L, xi_field_R) + do l = is3%beg, is3%end + do k = is2%beg, is2%end + do j = is1%beg, is1%end +@@ -440,31 +440,24 @@ contains + !$acc loop seq + do i = 1, 2 + Re_L(i) = dflt_real +- + if (Re_size(i) > 0) Re_L(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_L(i) = alpha_L(Re_idx(i, q))/Res(i, q) & + + Re_L(i) + end do +- + Re_L(i) = 1d0/max(Re_L(i), sgm_eps) +- + end do + + !$acc loop seq + do i = 1, 2 + Re_R(i) = dflt_real +- + if (Re_size(i) > 0) Re_R(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_R(i) = alpha_R(Re_idx(i, q))/Res(i, q) & + + Re_R(i) + end do +- + Re_R(i) = 1d0/max(Re_R(i), sgm_eps) + end do + end if +@@ -472,26 +465,17 @@ contains + E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L + E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R + +- H_L = (E_L + pres_L)/rho_L +- H_R = (E_R + pres_R)/rho_R +- ++ ! elastic energy update + if (hypoelasticity) then +- !$acc loop seq +- do i = 1, strxe - strxb + 1 +- tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) +- tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) +- end do +- +- G_L = 0d0 +- G_R = 0d0 +- ++ G_L = 0d0; G_R = 0d0 + !$acc loop seq + do i = 1, num_fluids + G_L = G_L + alpha_L(i)*Gs(i) + G_R = G_R + alpha_R(i)*Gs(i) + end do +- + do i = 1, strxe - strxb + 1 ++ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + ! Elastic contribution to energy if G large enough + !TODO take out if statement if stable without + if ((G_L > 1000) .and. (G_R > 1000)) then +@@ -506,19 +490,57 @@ contains + end do + end if + ++ ! elastic energy update ++ !if ( hyperelasticity ) then ++ ! G_L = 0d0 ++ ! G_R = 0d0 ++ ! ++ ! !$acc loop seq ++ ! do i = 1, num_fluids ++ ! G_L = G_L + alpha_L(i)*Gs(i) ++ ! G_R = G_R + alpha_R(i)*Gs(i) ++ ! end do ++ ! ! Elastic contribution to energy if G large enough ++ ! if ((G_L > 1d-3) .and. (G_R > 1d-3)) then ++ ! E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) ++ ! E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) ++ ! !$acc loop seq ++ ! do i = 1, b_size-1 ++ ! tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ ! tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ++ ! end do ++ ! !$acc loop seq ++ ! do i = 1, b_size-1 ++ ! tau_e_L(i) = 0d0 ++ ! tau_e_R(i) = 0d0 ++ ! end do ++ ! !$acc loop seq ++ ! do i = 1, num_dims ++ ! xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) ++ ! xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) ++ ! end do ++ ! end if ++ !end if ++ ++ ! Enthalpy with elastic energy ++ H_L = (E_L + pres_L)/rho_L ++ H_R = (E_R + pres_R)/rho_R ++ + @:compute_average_state() + + call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & +- vel_L_rms, c_L) ++ vel_L_rms, c_L, Gs) + + call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & +- vel_R_rms, c_R) ++ vel_R_rms, c_R, Gs) + + !> The computation of c_avg does not require all the variables, and therefore the non '_avg' + ! variables are placeholders to call the subroutine. + + call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & +- vel_avg_rms, c_avg) ++ vel_avg_rms, c_avg, Gs) ++ ++ !SGR added Gs to all of the above speed of sound clacs + + if (any(Re_size > 0)) then + !$acc loop seq +@@ -541,6 +563,11 @@ contains + , vel_L(dir_idx(1)) + sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + & + tau_e_L(dir_idx_tau(1)))/rho_L)) ++ else if (hyperelasticity) then ++ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L) & ++ , vel_R(dir_idx(1)) - sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R)) ++ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R) & ++ , vel_L(dir_idx(1)) + sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L)) + else + s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) + s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) +@@ -716,6 +743,18 @@ contains + /(s_M - s_P) + end do + ++ ! Xi field ++ !if ( hyperelasticity ) then ++ ! do i = 1, num_dims ++ ! flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & ++ ! (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & ++ ! - s_P*rho_L*vel_L(dir_idx(1))*xi_field_L(i) & ++ ! + s_M*s_P*(rho_L*xi_field_L(i) & ++ ! - rho_R*xi_field_R(i))) & ++ ! /(s_M - s_P) ++ ! end do ++ !end if ++ + ! Div(U)? + !$acc loop seq + do i = 1, num_dims +@@ -822,7 +861,6 @@ contains + + real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf + type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf +- + type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf + + type(scalar_field), & +@@ -862,6 +900,11 @@ contains + real(kind(0d0)) :: s_L, s_R, s_M, s_P, s_S + real(kind(0d0)) :: xi_L, xi_R !< Left and right wave speeds functions + real(kind(0d0)) :: xi_M, xi_P ++ real(kind(0d0)) :: xi_MP, xi_PP ++ ++ real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R ++ real(kind(0d0)), dimension(num_dims) :: xi_field_L, xi_field_R ++ real(kind(0d0)) :: G_L, G_R + + real(kind(0d0)) :: nbub_L, nbub_R + real(kind(0d0)), dimension(nb) :: R0_L, R0_R +@@ -880,9 +923,10 @@ contains + real(kind(0d0)) :: vel_L_rms, vel_R_rms, vel_avg_rms + real(kind(0d0)) :: vel_L_tmp, vel_R_tmp + real(kind(0d0)) :: blkmod1, blkmod2 +- real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star ++ real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star, vel_K_Star + real(kind(0d0)) :: pres_SL, pres_SR, Ms_L, Ms_R + real(kind(0d0)) :: start, finish ++ real(kind(0d0)) :: flux_ene_e + real(kind(0d0)) :: zcoef, pcorr !< low Mach number correction + integer :: i, j, k, l, q !< Generic loop iterators + integer :: idx1, idxi +@@ -909,15 +953,16 @@ contains + flux_gsrc_vf, & + norm_dir, ix, iy, iz) + ++ idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 ++ + #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] + + if (norm_dir == ${NORM_DIR}$) then ++ ++ ! 6-EQUATION MODEL WITH HLLC + if (model_eqns == 3) then + !ME3 +- +- !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & +- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R) +- ++ !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R, flux_ene_e, xi_field_L, xi_field_R) + do l = is3%beg, is3%end + do k = is2%beg, is2%end + do j = is1%beg, is1%end +@@ -994,39 +1039,85 @@ contains + !$acc loop seq + do i = 1, 2 + Re_L(i) = dflt_real +- + if (Re_size(i) > 0) Re_L(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + + Re_L(i) + end do +- + Re_L(i) = 1d0/max(Re_L(i), sgm_eps) +- + end do + + !$acc loop seq + do i = 1, 2 + Re_R(i) = dflt_real +- + if (Re_size(i) > 0) Re_R(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + + Re_R(i) + end do +- + Re_R(i) = 1d0/max(Re_R(i), sgm_eps) + end do + end if + + E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L +- + E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R + ++ ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY ++ if (hypoelasticity) then ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ++ end do ++ G_L = 0d0; G_R = 0d0 ++ !$acc loop seq ++ do i = 1, num_fluids ++ G_L = G_L + alpha_L(i)*Gs(i) ++ G_R = G_R + alpha_R(i)*Gs(i) ++ end do ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ ! Elastic contribution to energy if G large enough ++ if ((G_L > verysmall) .and. (G_R > verysmall)) then ++ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) ++ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) ++ ! Additional terms in 2D and 3D ++ if ((i == 2) .or. (i == 4) .or. (i == 5)) then ++ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) ++ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) ++ end if ++ end if ++ end do ++ end if ++ ++ ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY ++ if (hyperelasticity) then ++ !$acc loop seq ++ do i = 1, num_dims ++ xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) ++ xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) ++ end do ++ G_L = 0d0; G_R = 0d0; ++ !$acc loop seq ++ do i = 1, num_fluids ++ ! Mixture left and right shear modulus ++ G_L = G_L + alpha_L(i)*Gs(i) ++ G_R = G_R + alpha_R(i)*Gs(i) ++ end do ++ ! Elastic contribution to energy if G large enough ++ if ( G_L > verysmall .and. G_R > verysmall ) then ++ E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) ++ E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) ++ end if ++ !$acc loop seq ++ do i = 1, b_size - 1 ++ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ++ end do ++ end if ++ + H_L = (E_L + pres_L)/rho_L + H_R = (E_R + pres_R)/rho_R + +@@ -1034,13 +1125,10 @@ contains + + call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & + vel_L_rms, c_L) +- + call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & + vel_R_rms, c_R) +- + !> The computation of c_avg does not require all the variables, and therefore the non '_avg' + ! variables are placeholders to call the subroutine. +- + call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & + vel_avg_rms, c_avg) + +@@ -1051,222 +1139,226 @@ contains + end do + end if + ++ ! COMPUTING THE DIRECT WAVE SPEEDS + if (wave_speeds == 1) then +- s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) +- s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) ++ if (elasticity) then ++ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & ++ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & ++ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) ++ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & ++ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & ++ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) ++ s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & ++ tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & ++ rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & ++ rho_R*(s_R - vel_R(idx1))) ++ else ++ s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) ++ s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) ++ s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & ++ (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & ++ /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) + +- s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & +- (s_L - vel_L(dir_idx(1))) - & +- rho_R*vel_R(dir_idx(1))* & +- (s_R - vel_R(dir_idx(1)))) & +- /(rho_L*(s_L - vel_L(dir_idx(1))) - & +- rho_R*(s_R - vel_R(dir_idx(1)))) ++ end if + elseif (wave_speeds == 2) then + pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & + (vel_L(dir_idx(1)) - & + vel_R(dir_idx(1)))) +- + pres_SR = pres_SL +- + Ms_L = max(1d0, sqrt(1d0 + ((5d-1 + gamma_L)/(1d0 + gamma_L))* & + (pres_SL/pres_L - 1d0)*pres_L/ & + ((pres_L + pi_inf_L/(1d0 + gamma_L))))) + Ms_R = max(1d0, sqrt(1d0 + ((5d-1 + gamma_R)/(1d0 + gamma_R))* & + (pres_SR/pres_R - 1d0)*pres_R/ & + ((pres_R + pi_inf_R/(1d0 + gamma_R))))) +- + s_L = vel_L(dir_idx(1)) - c_L*Ms_L + s_R = vel_R(dir_idx(1)) + c_R*Ms_R +- + s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & + (pres_L - pres_R)/ & + (rho_avg*c_avg)) + end if + +- if (s_L >= 0d0) then +- p_Star = pres_L ! Only useful to recalculate the radial momentum geometric source flux +- !$acc loop seq +- do i = 1, num_fluids +- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)*s_S ++ ! follows Einfeldt et al. ++ ! s_M/P = min/max(0.,s_L/R) ++ s_M = min(0d0, s_L); s_P = max(0d0, s_R) + +- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)*vel_L(dir_idx(1)) ++ ! goes with q_star_L/R = xi_L/R * (variable) ++ ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) ) ++ xi_L = (s_L - vel_L(idx1))/(s_L - s_S) ++ xi_R = (s_R - vel_R(idx1))/(s_R - s_S) + +- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & +- (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & +- (gammas(i)*pres_L + pi_infs(i)) + & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & +- qvs(i))*vel_L(dir_idx(1)) +- end do +- !$acc loop seq +- do i = 1, num_dims +- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & +- rho_L*vel_L(dir_idx(1))*vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*pres_L ++ ! goes with numerical star velocity in x/y/z directions ++ ! xi_P/M = 0.5 +/m sgn(0.5,s_star) ++ xi_M = (5d-1 + sign(5d-1, s_S)) ++ xi_P = (5d-1 - sign(5d-1, s_S)) + +- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & +- dir_flg(dir_idx(i))*(s_S - vel_L(dir_idx(i))) +- ! Compute the star velocities for the non-conservative terms +- end do +- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_L + pres_L)*vel_L(dir_idx(1)) ++ ! goes with the numerical velocity in x/y/z directions ++ ! xi_P/M (pressure) = min/max(0. sgn(1,sL/sR)) ++ xi_MP = -min(0d0, sign(1d0, s_L)) ++ xi_PP = max(0d0, sign(1d0, s_R)) + +- if (.not. f_is_default(sigma)) then +- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, c_idx)*s_S +- end if ++ ! COMPUTING FLUXES ++ ! MASS FLUX. ++ !$acc loop seq ++ do i = 1, contxe ++ flux_rs${XYZ}$_vf(j, k, l, i) = & ++ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & ++ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) ++ end do + +- ! Compute right solution state +- else if (s_R <= 0d0) then +- p_Star = pres_R +- ! Only useful to recalculate the radial momentum geometric source flux +- !$acc loop seq +- do i = 1, num_fluids +- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)*s_S ++ ! MOMENTUM FLUX. ++ ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) ++ !$acc loop seq ++ do i = 1, num_dims ++ !idxi = dir_idx(i) ++ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & ++ xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & ++ (1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & ++ xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & ++ (1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) ++ end do + +- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)*vel_R(dir_idx(1)) ++ ! ENERGY FLUX. ++ ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) ++ flux_rs${XYZ}$_vf(j, k, l, E_idx) = & ++ xi_M*(vel_L(idx1)*(E_L + pres_L) + & ++ s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & ++ + xi_P*(vel_R(idx1)*(E_R + pres_R) + & ++ s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) ++ ++ ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux ++ if (elasticity) then ++ flux_ene_e = 0d0; ++ !$acc loop seq ++ do i = 1, num_dims ++ ! MOMENTUM ELASTIC FLUX. ++ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & ++ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) & ++ - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) ++ ! ENERGY ELASTIC FLUX. ++ flux_ene_e = flux_ene_e - & ++ xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & ++ s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & ++ xi_P*(vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & ++ s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) ++ end do ++ flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e ++ end if + +- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & +- (qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)* & +- (gammas(i)*pres_R + pi_infs(i)) + & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)* & +- qvs(i))*vel_R(dir_idx(1)) +- end do +- !$acc loop seq +- do i = 1, num_dims +- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & +- rho_R*vel_R(dir_idx(1))*vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*pres_R ++ ! VOLUME FRACTION FLUX. ++ !$acc loop seq ++ do i = advxb, advxe ++ flux_rs${XYZ}$_vf(j, k, l, i) = & ++ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*s_S + & ++ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*s_S ++ end do + +- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & +- dir_flg(dir_idx(i))*(s_S - vel_R(dir_idx(i))) +- ! Compute the star velocities for the non-conservative terms +- end do +- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_R + pres_R)*vel_R(dir_idx(1)) ++ ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. ++ !$acc loop seq ++ do i = 1, num_dims ++ !idxi = dir_idx(i) ++ vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = & ++ xi_M*(vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_MP*(xi_L - 1) + 1) - vel_L(dir_idx(i)))) + & ++ xi_P*(vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(dir_idx(i)))) ++ end do + +- if (.not. f_is_default(sigma)) then +- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx)*s_S +- end if ++ ! INTERNAL ENERGIES ADVECTION FLUX. ++ ! K-th pressure and velocity in preparation for the internal energy flux ++ vel_K_Star = vel_L(idx1)*(1d0 - xi_MP) + xi_MP*vel_R(idx1) + & ++ xi_MP*xi_PP*(s_S - vel_R(idx1)) ++ !$acc loop seq ++ do i = 1, num_fluids ++ p_K_Star = xi_M*(xi_MP*((pres_L + pi_infs(i)/(1d0 + gammas(i)))* & ++ xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - pres_L) + pres_L) + & ++ xi_P*(xi_PP*((pres_R + pi_infs(i)/(1d0 + gammas(i)))* & ++ xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - pres_R) + pres_R) ++ ++ flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & ++ (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & ++ (gammas(i)*p_K_Star + pi_infs(i)) + & ++ qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & ++ qvs(i))*vel_K_Star ++ end do + +- ! Compute left star solution state +- else if (s_S >= 0d0) then +- xi_L = (s_L - vel_L(dir_idx(1)))/(s_L - s_S) +- rho_Star = rho_L*xi_L +- E_Star = xi_L*(E_L + (s_S - vel_L(dir_idx(1)))* & +- (rho_L*s_S + pres_L/(s_L - vel_L(dir_idx(1))))) +- p_Star = rho_L*(s_L - vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1))) + pres_L +- !$acc loop seq +- do i = 1, num_fluids +- p_K_Star = (pres_L + pi_infs(i)/(1d0 + gammas(i)))* & +- xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) ++ flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) + +- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)*s_S ++ ! HYPOELASTIC STRESS EVOLUTION FLUX. ++ if (hypoelasticity) then ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & ++ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & ++ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) ++ end do ++ end if + +- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)*xi_L*s_S ++ ! REFERENCE MAP FLUX. ++ if (hyperelasticity) then ++ !$acc loop seq ++ do i = 1, num_dims ++ flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & ++ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*xi_field_L(i) & ++ - rho_L*vel_L(idx1)*xi_field_L(i)) + & ++ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*xi_field_R(i) & ++ - rho_R*vel_R(idx1)*xi_field_R(i)) ++ end do ++ end if + +- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & +- (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & +- (gammas(i)*p_K_Star + pi_infs(i)) + & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & +- qvs(i))*s_S +- end do +- !$acc loop seq +- do i = 1, num_dims +- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & +- rho_Star*s_S*(s_S*dir_flg(dir_idx(i)) + vel_L(dir_idx(i))* & +- (1d0 - dir_flg(dir_idx(i)))) + dir_flg(dir_idx(i))*p_Star ++ ! SURFACE TENSION FLUX. need to check ++ if (.not. f_is_default(sigma)) then ++ flux_rs${XYZ}$_vf(j, k, l, c_idx) = & ++ (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & ++ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S ++ end if + +- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & +- dir_flg(dir_idx(i))*(s_S*xi_L - vel_L(dir_idx(i))) +- ! Compute the star velocities for the non-conservative terms +- end do +- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_Star + p_Star)*s_S ++ ! correction pressure for the cylindrical terms ++ p_Star = xi_M*(pres_L + xi_MP*rho_L*(s_L - & ++ vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1)))) + & ++ xi_P*(pres_R + xi_PP*rho_R*(s_R - & ++ vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1)))) + +- if (.not. f_is_default(sigma)) then +- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, c_idx)*s_S ++ ! Geometrical source flux for cylindrical coordinates ++ #:if (NORM_DIR == 2) ++ if (cyl_coord) then ++ !Substituting the advective flux into the inviscid geometrical source flux ++ !$acc loop seq ++ do i = 1, E_idx ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) ++ end do ++ !$acc loop seq ++ do i = intxb, intxe ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) ++ end do ++ ! Recalculating the radial momentum geometric source flux ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star ++ ! Geometrical source of the void fraction(s) is zero ++ !$acc loop seq ++ do i = advxb, advxe ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 ++ end do + end if ++ #:endif ++ #:if (NORM_DIR == 3) ++ if (grid_geometry == 3) then ++ !$acc loop seq ++ do i = 1, sys_size ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 ++ end do ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star + +- ! Compute right star solution state +- else +- xi_R = (s_R - vel_R(dir_idx(1)))/(s_R - s_S) +- +- rho_Star = rho_R*xi_R +- +- E_Star = xi_R*(E_R + (s_S - vel_R(dir_idx(1)))* & +- (rho_R*s_S + pres_R/(s_R - vel_R(dir_idx(1))))) +- +- p_Star = rho_R*(s_R - vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1))) + pres_R +- !$acc loop seq +- do i = 1, num_fluids +- p_K_Star = (pres_R + pi_infs(i)/(1d0 + gammas(i)))* & +- xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) +- +- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)*s_S +- +- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)*xi_R*s_S +- +- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & +- (qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)* & +- (gammas(i)*p_K_Star + pi_infs(i)) + & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)* & +- qvs(i))*s_S +- end do +- !$acc loop seq +- do i = 1, num_dims +- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = rho_Star*s_S* & +- (s_S*dir_flg(dir_idx(i)) + vel_R(dir_idx(i))*(1d0 - dir_flg(dir_idx(i)))) + & +- dir_flg(dir_idx(i))*p_Star +- +- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & +- dir_flg(dir_idx(i))*(s_S*xi_R - vel_R(dir_idx(i))) +- ! Compute the star velocities for the non-conservative terms +- end do +- +- if (.not. f_is_default(sigma)) then +- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx)*s_S ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) + end if +- +- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_Star + p_Star)*s_S +- +- end if +- +- flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) +- +- ! Geometrical source flux for cylindrical coordinates +- if (cyl_coord .and. norm_dir == 2) then +- ! Substituting the advective flux into the inviscid geometrical source flux +- !$acc loop seq +- do i = 1, E_idx +- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) +- end do +- !$acc loop seq +- do i = intxb, intxe +- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) +- end do +- ! Recalculating the radial momentum geometric source flux (subtracting the pressure part) +- flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & +- flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star +- ! Geometrical source of the void fraction(s) is zero +- !$acc loop seq +- do i = advxb, advxe +- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 +- end do +- end if ++ #:endif + + end do + end do + end do ++ + elseif (model_eqns == 4) then + !ME4 +- !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, & +- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) ++ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) + do l = is3%beg, is3%end + do k = is2%beg, is2%end + do j = is1%beg, is1%end +@@ -1632,11 +1724,11 @@ contains + end if + + E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms +- + E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + + H_L = (E_L + pres_L)/rho_L + H_R = (E_R + pres_R)/rho_R ++ + if (avg_state == 2) then + !$acc loop seq + do i = 1, nb +@@ -1749,13 +1841,11 @@ contains + + call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & + vel_L_rms, c_L) +- + call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & + vel_R_rms, c_R) + + !> The computation of c_avg does not require all the variables, and therefore the non '_avg' + ! variables are placeholders to call the subroutine. +- + call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & + vel_avg_rms, c_avg) + +@@ -1861,7 +1951,6 @@ contains + + ! Energy flux. + ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) +- + flux_rs${XYZ}$_vf(j, k, l, E_idx) = & + xi_M*(vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) + & + s_M*(xi_L*(E_L + (s_S - vel_L(dir_idx(1)))* & +@@ -1874,7 +1963,6 @@ contains + + (s_M/s_L)*(s_P/s_R)*pcorr*s_S + + ! Volume fraction flux +- + !$acc loop seq + do i = advxb, advxe + flux_rs${XYZ}$_vf(j, k, l, i) = & +@@ -1980,8 +2068,10 @@ contains + end do + !$acc end parallel loop + else ++ ! 5-EQUATION MODEL WITH HLLC, INTERFACE CAPTURING ONLY + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & +- !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp) copyin(is1,is2,is3) ++ !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, & ++ !$acc tau_e_L, tau_e_R, xi_field_L, xi_field_R, vel_L_tmp, vel_R_tmp) copyin(is1,is2,is3) + do l = is3%beg, is3%end + do k = is2%beg, is2%end + do j = is1%beg, is1%end +@@ -2064,39 +2154,85 @@ contains + !$acc loop seq + do i = 1, 2 + Re_L(i) = dflt_real +- + if (Re_size(i) > 0) Re_L(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + + Re_L(i) + end do +- + Re_L(i) = 1d0/max(Re_L(i), sgm_eps) +- + end do + + !$acc loop seq + do i = 1, 2 + Re_R(i) = dflt_real +- + if (Re_size(i) > 0) Re_R(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + + Re_R(i) + end do +- + Re_R(i) = 1d0/max(Re_R(i), sgm_eps) + end do + end if + + E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L +- + E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R + ++ ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY ++ if (hypoelasticity) then ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ++ end do ++ G_L = 0d0; G_R = 0d0 ++ !$acc loop seq ++ do i = 1, num_fluids ++ G_L = G_L + alpha_L(i)*Gs(i) ++ G_R = G_R + alpha_R(i)*Gs(i) ++ end do ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ ! Elastic contribution to energy if G large enough ++ if ((G_L > verysmall) .and. (G_R > verysmall)) then ++ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) ++ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) ++ ! Additional terms in 2D and 3D ++ if ((i == 2) .or. (i == 4) .or. (i == 5)) then ++ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) ++ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) ++ end if ++ end if ++ end do ++ end if ++ ++ ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY ++ if (hyperelasticity) then ++ !$acc loop seq ++ do i = 1, num_dims ++ xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) ++ xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) ++ end do ++ G_L = 0d0; G_R = 0d0; ++ !$acc loop seq ++ do i = 1, num_fluids ++ ! Mixture left and right shear modulus ++ G_L = G_L + alpha_L(i)*Gs(i) ++ G_R = G_R + alpha_R(i)*Gs(i) ++ end do ++ ! Elastic contribution to energy if G large enough ++ if ( G_L > verysmall .and. G_R > verysmall ) then ++ E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) ++ E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) ++ end if ++ !$acc loop seq ++ do i = 1, b_size - 1 ++ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ++ end do ++ end if ++ + H_L = (E_L + pres_L)/rho_L + H_R = (E_R + pres_R)/rho_R + +@@ -2110,7 +2246,6 @@ contains + + !> The computation of c_avg does not require all the variables, and therefore the non '_avg' + ! variables are placeholders to call the subroutine. +- + call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & + vel_avg_rms, c_avg) + +@@ -2126,16 +2261,25 @@ contains + end if + + if (wave_speeds == 1) then +- s_L = min(vel_L(idx1) - c_L, vel_R(idx1) - c_R) +- s_R = max(vel_R(idx1) + c_R, vel_L(idx1) + c_L) +- +- s_S = (pres_R - pres_L + rho_L*vel_L(idx1)* & +- (s_L - vel_L(idx1)) - & +- rho_R*vel_R(idx1)* & +- (s_R - vel_R(idx1))) & +- /(rho_L*(s_L - vel_L(idx1)) - & +- rho_R*(s_R - vel_R(idx1))) ++ if (elasticity) then ++ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & ++ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & ++ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) ++ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & ++ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & ++ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) ++ s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & ++ tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & ++ rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & ++ rho_R*(s_R - vel_R(idx1))) ++ else ++ s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) ++ s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) ++ s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & ++ (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & ++ /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) + ++ end if + elseif (wave_speeds == 2) then + pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & + (vel_L(idx1) - & +@@ -2172,6 +2316,8 @@ contains + xi_M = (5d-1 + sign(5d-1, s_S)) + xi_P = (5d-1 - sign(5d-1, s_S)) + ++ ! COMPUTING THE HLLC FLUXES ++ ! MASS FLUX. + if (low_Mach == 1) then + @:compute_low_Mach_correction() + else +@@ -2181,15 +2327,13 @@ contains + !$acc loop seq + do i = 1, contxe + flux_rs${XYZ}$_vf(j, k, l, i) = & +- xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & +- *(vel_L(idx1) + s_M*(xi_L - 1d0)) & +- + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & +- *(vel_R(idx1) + s_P*(xi_R - 1d0)) ++ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & ++ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) + end do + +- ! Momentum flux. +- ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w) +- !$acc loop seq ++ ! MOMENTUM FLUX. ++ ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) ++ !$acc loop seq + do i = 1, num_dims + idxi = dir_idx(i) + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & +@@ -2206,32 +2350,68 @@ contains + vel_R(idxi)) - vel_R(idxi))) + & + dir_flg(idxi)*(pres_R)) & + + (s_M/s_L)*(s_P/s_R)*dir_flg(idxi)*pcorr ++ ++ !idxi = dir_idx(i) ++ !flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & ++ ! xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & ++ !(1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & ++ ! xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & ++ !(1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) & ++ ! + (s_M/s_L)*(s_P/s_R)*dir_flg(dir_idx(i))*pcorr + end do + +- ! Energy flux. +- ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) ++ ! ENERGY FLUX. ++ ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) + flux_rs${XYZ}$_vf(j, k, l, E_idx) = & + xi_M*(vel_L(idx1)*(E_L + pres_L) + & +- s_M*(xi_L*(E_L + (s_S - vel_L(idx1))* & +- (rho_L*s_S + pres_L/ & +- (s_L - vel_L(idx1)))) - E_L)) & ++ s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & + + xi_P*(vel_R(idx1)*(E_R + pres_R) + & +- s_P*(xi_R*(E_R + (s_S - vel_R(idx1))* & +- (rho_R*s_S + pres_R/ & +- (s_R - vel_R(idx1)))) - E_R)) & ++ s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) & + + (s_M/s_L)*(s_P/s_R)*pcorr*s_S + +- ! Volume fraction flux ++ ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux ++ if (elasticity) then ++ flux_ene_e = 0d0; ++ !$acc loop seq ++ do i = 1, num_dims ++ ! MOMENTUM ELASTIC FLUX. ++ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & ++ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) & ++ - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) ++ ! ENERGY ELASTIC FLUX. ++ flux_ene_e = flux_ene_e - & ++ xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & ++ s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & ++ xi_P*(vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & ++ s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) ++ end do ++ flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e ++ end if ++ ++ ! HYPOELASTIC STRESS EVOLUTION FLUX. ++ if (hypoelasticity) then ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & ++ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & ++ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) ++ end do ++ end if ++ ++ ! VOLUME FRACTION FLUX. + !$acc loop seq + do i = advxb, advxe +- flux_rs${XYZ}$_vf(j, k, l, i) = & +- xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & +- *(vel_L(idx1) + s_M*(xi_L - 1d0)) & +- + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & +- *(vel_R(idx1) + s_P*(xi_R - 1d0)) ++ flux_rs${XYZ}$_vf(j, k, l, i) = & ++ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & ++ *(vel_L(idx1) + s_M*(xi_L - 1d0)) & ++ + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & ++ *(vel_R(idx1) + s_P*(xi_R - 1d0)) ++ !flux_rs${XYZ}$_vf(j, k, l, i) = & ++ ! xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & ++ ! xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) + end do + +- ! Source for volume fraction advection equation ++ ! VOLUME FRACTION SOURCE FLUX. + !$acc loop seq + do i = 1, num_dims + idxi = dir_idx(i) +@@ -2242,14 +2422,20 @@ contains + + xi_P*(vel_R(idxi) + & + dir_flg(idxi)* & + s_P*(xi_R - 1d0)) +- +- !if ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0d0 ++ !xi_M*(vel_L(idxi) + dir_flg(idxi)*s_M*(xi_L - 1d0)) + & ++ !xi_P*(vel_R(idxi) + dir_flg(idxi)*s_P*(xi_R - 1d0)) + end do + + flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) + +- ! Geometrical source flux for cylindrical coordinates ++ ! SURFACE TENSION FLUX. need to check ++ !if (.not. f_is_default(sigma)) then ++ ! flux_rs${XYZ}$_vf(j, k, l, c_idx) = & ++ ! (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & ++ ! xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S ++ !end if + ++ ! Geometrical source flux for cylindrical coordinates + #:if (NORM_DIR == 2) + if (cyl_coord) then + !Substituting the advective flux into the inviscid geometrical source flux +@@ -2544,7 +2730,7 @@ contains + + !$acc update device(is1, is2, is3) + +- if (hypoelasticity) then ++ if (elasticity) then + if (norm_dir == 1) then + dir_idx_tau = (/1, 2, 4/) + else if (norm_dir == 2) then +diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp +index 5e1c6f6e..10158e8e 100644 +--- a/src/simulation/m_start_up.fpp ++++ b/src/simulation/m_start_up.fpp +@@ -46,9 +46,10 @@ module m_start_up + + use m_derived_variables !< Procedures used to compute quantities derived + !! from the conservative and primitive variables +- + use m_hypoelastic + ++ use m_hyperelastic ++ + use m_phase_change !< Phase-change module + + use m_viscous +@@ -139,6 +140,7 @@ contains + teno_CT, mp_weno, weno_avg, & + riemann_solver, low_Mach, wave_speeds, avg_state, & + bc_x, bc_y, bc_z, & ++ x_a, y_a, z_a, x_b, y_b, z_b, & + x_domain, y_domain, z_domain, & + hypoelasticity, & + ib, num_ibs, patch_ib, & +@@ -146,8 +148,8 @@ contains + fd_order, probe, num_probes, t_step_old, & + alt_soundspeed, mixture_err, weno_Re_flux, & + null_weights, precision, parallel_io, cyl_coord, & +- rhoref, pref, bubbles, bubble_model, & +- R0ref, & ++ rhoref, pref, bubbles, bubble_model, & ++ + #:if not MFC_CASE_OPTIMIZATION + nb, mapped_weno, wenoz, teno, weno_order, num_fluids, & + #:endif +@@ -161,7 +163,7 @@ contains + R0_type, file_per_process, sigma, & + pi_fac, adv_n, adap_dt, bf_x, bf_y, bf_z, & + k_x, k_y, k_z, w_x, w_y, w_z, p_x, p_y, p_z, & +- g_x, g_y, g_z ++ g_x, g_y, g_z, hyperelasticity, R0ref + + ! Checking that an input file has been provided by the user. If it + ! has, then the input file is read in, otherwise, simulation exits. +@@ -359,7 +361,7 @@ contains + end if + end do + +- if ((bubbles .eqv. .true.) .or. (hypoelasticity .eqv. .true.)) then ++ if ((bubbles .eqv. .true.) .or. (elasticity .eqv. .true.)) then + ! Read pb and mv for non-polytropic qbmm + if (qbmm .and. .not. polytropic) then + do i = 1, nb +@@ -589,7 +591,7 @@ contains + NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) + + ! Read the data for each variable +- if (bubbles .or. hypoelasticity) then ++ if ( bubbles .or. elasticity ) then + + do i = 1, sys_size!adv_idx%end + var_MOK = int(i, MPI_OFFSET_KIND) +@@ -614,6 +616,7 @@ contains + MPI_DOUBLE_PRECISION, status, ierr) + end do + end if ++ + + call s_mpi_barrier() + +@@ -679,9 +682,9 @@ contains + NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) + + ! Read the data for each variable +- if (bubbles .or. hypoelasticity) then ++ if ( bubbles .or. elasticity ) then + +- do i = 1, sys_size!adv_idx%end ++ do i = 1, sys_size !adv_idx%end + var_MOK = int(i, MPI_OFFSET_KIND) + ! Initial displacement to skip at beginning of file + disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) +@@ -1120,7 +1123,7 @@ contains + ! Time-stepping loop controls + if ((mytime + dt) >= finaltime) dt = finaltime - mytime + t_step = t_step + 1 +- ++ + end subroutine s_perform_time_step + + subroutine s_save_performance_metrics(t_step, time_avg, time_final, io_time_avg, io_time_final, proc_time, io_proc_time, file_exists, start, finish, nt) +@@ -1272,7 +1275,6 @@ contains + call acc_present_dump() + #endif + +- if (hypoelasticity) call s_initialize_hypoelastic_module() + if (relax) call s_initialize_phasechange_module() + call s_initialize_data_output_module() + call s_initialize_derived_variables_module() +@@ -1312,9 +1314,11 @@ contains + #endif + + call s_initialize_cbc_module() +- + call s_initialize_derived_variables() + ++ if (hypoelasticity) call s_initialize_hypoelastic_module() ++ if (hyperelasticity) call s_initialize_hyperelastic_module() ++ + end subroutine s_initialize_modules + + subroutine s_initialize_mpi_domain +@@ -1395,6 +1399,7 @@ contains + do i = 1, sys_size + !$acc update device(q_cons_ts(1)%vf(i)%sf) + end do ++ + if (qbmm .and. .not. polytropic) then + !$acc update device(pb_ts(1)%sf, mv_ts(1)%sf) + end if +@@ -1410,7 +1415,6 @@ contains + !$acc update device(bc_y%vb1, bc_y%vb2, bc_y%vb3, bc_y%ve1, bc_y%ve2, bc_y%ve3) + !$acc update device(bc_z%vb1, bc_z%vb2, bc_z%vb3, bc_z%ve1, bc_z%ve2, bc_z%ve3) + +- + !$acc update device(relax, relax_model) + if (relax) then + !$acc update device(palpha_eps, ptgalpha_eps) +@@ -1428,6 +1432,8 @@ contains + s_write_data_files => null() + + call s_finalize_time_steppers_module() ++ if (hypoelasticity) call s_finalize_hypoelastic_module() ++ if (hyperelasticity) call s_finalize_hyperelastic_module() + call s_finalize_derived_variables_module() + call s_finalize_data_output_module() + call s_finalize_rhs_module() +diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp +index 2e9ca8fe..b5faba05 100644 +--- a/src/simulation/m_surface_tension.fpp ++++ b/src/simulation/m_surface_tension.fpp +@@ -1,7 +1,7 @@ + #:include 'macros.fpp' + #:include 'inline_capillary.fpp' + +-!> @brief This module is used to compute source terms for hypoelastic model ++!> @brief This module is used to compute source terms for surface tension model + module m_surface_tension + + ! Dependencies ============================================================= +diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp +index d34c1fc0..b940bdc8 100644 +--- a/src/simulation/m_time_steppers.fpp ++++ b/src/simulation/m_time_steppers.fpp +@@ -25,6 +25,8 @@ module m_time_steppers + + use m_ibm + ++ use m_hyperelastic ++ + use m_mpi_proxy !< Message passing interface (MPI) module proxy + + use m_boundary_conditions +@@ -181,8 +183,7 @@ contains + end if + end if + +- if (hypoelasticity) then +- ++ if (elasticity) then + do i = stress_idx%beg, stress_idx%end + @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & + iy_t%beg:iy_t%end, & +@@ -191,6 +192,15 @@ contains + end do + end if + ++ if (hyperelasticity) then ++ do i = xibeg, xiend + 1 ++ @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & ++ iy_t%beg:iy_t%end, & ++ iz_t%beg:iz_t%end)) ++ @:ACC_SETUP_SFs(q_prim_vf(i)) ++ end do ++ end if ++ + if (model_eqns == 3) then + do i = internalEnergies_idx%beg, internalEnergies_idx%end + @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & +@@ -812,6 +822,10 @@ contains + call s_pressure_relaxation_procedure(q_cons_ts(1)%vf) + end if + ++ call nvtxStartRange("RHS-ELASTIC") ++ if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_ts(1)%vf, q_prim_vf) ++ call nvtxEndRange ++ + if (adv_n) call s_comp_alpha_from_n(q_cons_ts(1)%vf) + + if (ib) then +@@ -829,7 +843,6 @@ contains + time = time + (finish - start) + end if + ! ================================================================== +- + end subroutine s_3rd_order_tvd_rk + + !> Strang splitting scheme with 3rd order TVD RK time-stepping algorithm for +@@ -959,6 +972,7 @@ contains + end if + + end subroutine s_time_step_cycling ++ + !> Module deallocation and/or disassociation procedures + subroutine s_finalize_time_steppers_module + +@@ -993,12 +1007,18 @@ contains + @:DEALLOCATE(q_prim_vf(i)%sf) + end do + +- if (hypoelasticity) then ++ if (elasticity) then + do i = stress_idx%beg, stress_idx%end + @:DEALLOCATE(q_prim_vf(i)%sf) + end do + end if + ++ if (hyperelasticity) then ++ do i = xibeg, xiend + 1 ++ @:DEALLOCATE(q_prim_vf(i)%sf) ++ end do ++ end if ++ + if (bubbles) then + do i = bub_idx%beg, bub_idx%end + @:DEALLOCATE(q_prim_vf(i)%sf) +diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp +index 0019779e..5bdf4b84 100644 +--- a/src/simulation/m_viscous.fpp ++++ b/src/simulation/m_viscous.fpp +@@ -12,8 +12,6 @@ module m_viscous + use m_global_parameters !< Definitions of the global parameters + + use m_weno +- +- use m_helper + ! ========================================================================== + + private; public s_get_viscous, & +diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp +index 3f0e885c..8f24a5fe 100644 +--- a/src/simulation/p_main.fpp ++++ b/src/simulation/p_main.fpp +@@ -36,7 +36,6 @@ program p_main + + !Initialize MPI + call s_initialize_mpi_domain() +- + !Initialize Modules + call s_initialize_modules() + +diff --git a/submit_gpu.sh b/submit_gpu.sh +new file mode 100755 +index 00000000..2c77cc92 +--- /dev/null ++++ b/submit_gpu.sh +@@ -0,0 +1,49 @@ ++#!/bin/bash ++ ++### A100s ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwex_pre -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta ++ ++### A40s ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwex_pre -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# test -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 03:00:00 -# test_sim -t simulation -a bciv-delta-gpu -c delta ++ ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# bwex_post -t post_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# test_post -t post_process -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 02:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta ++ ++./mfc.sh run tests/6FC6A809/case.py -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta ++./mfc.sh run tests/6FC6A809/case.py -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta ++ +diff --git a/submit_hyper.sh b/submit_hyper.sh +new file mode 100755 +index 00000000..ba197a99 +--- /dev/null ++++ b/submit_hyper.sh +@@ -0,0 +1,7 @@ ++#!/bin/bash ++ ++./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar ++./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta ++ ++ +diff --git a/submit_pc.sh b/submit_pc.sh +new file mode 100755 +index 00000000..e45b98db +--- /dev/null ++++ b/submit_pc.sh +@@ -0,0 +1,9 @@ ++#!/bin/bash ++ ++#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar ++#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar ++#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta ++ ++./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t pre_process -c delta ++./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t simulation -c delta ++ +diff --git a/submit_test.sh b/submit_test.sh +new file mode 100755 +index 00000000..69b80bbe +--- /dev/null ++++ b/submit_test.sh +@@ -0,0 +1,52 @@ ++#!/bin/bash ++ ++#./mfc.sh run ./examples/3D_phasechange_bubble/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ++#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t simulation -c delta ++#./mfc.sh run ./examples/3D_phasechange_bubble/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++ ++#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ++#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta ++#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++ ++#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ++#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c delta ++#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++ ++#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 00:10:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 04:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.3/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 01:00:00 -# pre_bubingel -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# sim_bubingel -t simulation -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# pre_bubinwater -t pre_process -a bciv-delta-gpu -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# sim_bubinwater -t simulation -a bciv-delta-gpu -c delta ++ ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta ++#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta ++./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++ ++ ++#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar ++#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 02:00:00 -# test1 -t simulation -c oscar ++#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar ++ ++ ++#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/finalruns/elcom/bubliq/25wv/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/finalruns/elcom/bubliq/75wv/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta ++ +diff --git a/toolchain/bootstrap/docker.sh b/toolchain/bootstrap/docker.sh +index 73e61372..60e34d92 100644 +--- a/toolchain/bootstrap/docker.sh ++++ b/toolchain/bootstrap/docker.sh +@@ -30,4 +30,4 @@ if (($?)); then + error "Error running Docker container with $@." + + exit 1 +-fi +\ No newline at end of file ++fi +diff --git a/toolchain/bootstrap/modules.sh b/toolchain/bootstrap/modules.sh +index 097dca13..b437157f 100644 +--- a/toolchain/bootstrap/modules.sh ++++ b/toolchain/bootstrap/modules.sh +@@ -23,8 +23,9 @@ if [ -v $u_c ]; then + log "$C""ACCESS$W: Bridges2 (b) | Expanse (e) | Delta (d)" + log "$Y""Gatech$W: Phoenix (p)" + log "$R""Caltech$W: Richardson (r)" ++ log "$BR""Brown$W: Oscar (o)" + log "$B""DoD$W: Carpenter (c) | Nautilus (n)" +- log_n "($G""a$W/$G""f$W/$G""s$W/$G""w$W/$C""b$W/$C""e$CR/$C""d$CR/$Y""p$CR/$R""r$CR/$B""c$CR/$B""n$CR): " ++ log_n "($G""a$W/$G""f$W/$G""s$W/$G""w$W/$C""b$W/$C""e$CR/$C""d$CR/$Y""p$CR/$R""r$CR/$B""c$CR/$B""n$CR/$BR""o"$CR"): " + read u_c + log + fi +diff --git a/toolchain/mfc/bench.py b/toolchain/mfc/bench.py +index 52792f26..98e34309 100644 +--- a/toolchain/mfc/bench.py ++++ b/toolchain/mfc/bench.py +@@ -16,7 +16,6 @@ class BenchCase: + path: str + args: typing.List[str] + +- + def bench(targets = None): + if targets is None: + targets = ARG("targets") +diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py +index b39507d3..4658d6b6 100644 +--- a/toolchain/mfc/run/case_dicts.py ++++ b/toolchain/mfc/run/case_dicts.py +@@ -19,6 +19,7 @@ class ParamType(Enum): + + COMMON = { + 'hypoelasticity': ParamType.LOG, ++ 'hyperelasticity': ParamType.LOG, + 'cyl_coord': ParamType.LOG, + 'pref': ParamType.REAL, + 'p': ParamType.INT, +@@ -47,6 +48,7 @@ COMMON = { + 'relax_model': ParamType.INT, + 'sigma': ParamType.REAL, + 'adv_n': ParamType.LOG, ++ 'hyperelasticity': ParamType.LOG, + } + + PRE_PROCESS = COMMON.copy() +@@ -75,6 +77,7 @@ PRE_PROCESS.update({ + 'pi_fac': ParamType.REAL, + 'ib': ParamType.LOG, + 'num_ibs': ParamType.INT, ++ 'pre_stress': ParamType.LOG, + }) + + for ib_id in range(1, 10+1): +@@ -112,9 +115,11 @@ for p_id in range(1, 10+1): + ("smooth_patch_id", ParamType.INT), ("hcid", ParamType.INT)]: + PRE_PROCESS[f"patch_icpp({p_id})%{attribute}"] = ty + +- for real_attr in ["radius", "radii", "epsilon", "beta", "normal", "alpha_rho", +- "smooth_coeff", "rho", "vel", "alpha", "gamma", ++ for real_attr in ["radius", "radii", "epsilon", "beta", "normal", "alpha_rho", "a2", ++ "a3", "a4", "a5", "a6", "a7","a8", "a9", "a10", "a11", "a12", 'non_axis_sym', ++ "normal", "smooth_coeff", "rho", "vel", "pres", "alpha", "gamma", + "pi_inf", "r0", "v0", "p0", "m0", "cv", "qv", "qvp", "cf_val"]: ++ + PRE_PROCESS[f"patch_icpp({p_id})%{real_attr}"] = ParamType.REAL + PRE_PROCESS[f"patch_icpp({p_id})%pres"] = ParamType.REAL.analytic() + +@@ -279,7 +284,6 @@ for f_id in range(1,10+1): + SIMULATION[f"integral({int_id})%{cmp}min"] = ParamType.REAL + SIMULATION[f"integral({int_id})%{cmp}max"] = ParamType.REAL + +- + # Removed: 'fourier_modes%beg', 'fourier_modes%end', 'chem_wrt' + # Feel free to return them if they are needed once more. + POST_PROCESS = COMMON.copy() +@@ -314,6 +318,7 @@ POST_PROCESS.update({ + 'qbmm': ParamType.LOG, + 'qm_wrt': ParamType.LOG, + 'cf_wrt': ParamType.LOG, ++ 'sim_data': ParamType.LOG, + 'ib': ParamType.LOG + }) + +diff --git a/toolchain/modules b/toolchain/modules +index 178d9966..bc0566a3 100644 +--- a/toolchain/modules ++++ b/toolchain/modules +@@ -60,6 +60,12 @@ d-cpu gcc/11.4.0 openmpi + d-gpu nvhpc/22.11 openmpi+cuda/4.1.5+cuda cmake + d-gpu CC=nvc CXX=nvc++ FC=nvfortran + ++o Brown Oscar ++o-all python ++o-cpu hpcx-mpi ++o-gpu nvhpc cuda/12.3.0 cmake/3.26.3 ++o-gpu CC=nvc CXX=nvc++ FC=nvfortran ++ + c DoD Carpenter + c-all python/3.12.1 + c-cpu compiler-rt/2024.2.0 ifort/2024.2.0 icc/2023.1.0 mpi/latest cmake/3.28.1-intel-2023.0.0 +@@ -70,3 +76,4 @@ n-all slurm + n-cpu penguin/openmpi/4.1.5/gcc-8.5.0 + n-gpu penguin/openmpi/4.1.5/nvhpc-22.3 nvidia/nvhpc/22.3 cuda/cuda-11.6 + n-gpu CC=nvc CXX=nvc++ FC=nvfortran ++ +diff --git a/toolchain/templates/oscar.mako b/toolchain/templates/oscar.mako +new file mode 100644 +index 00000000..158a217c +--- /dev/null ++++ b/toolchain/templates/oscar.mako +@@ -0,0 +1,56 @@ ++#!/usr/bin/env bash ++ ++<%namespace name="helpers" file="helpers.mako"/> ++ ++% if engine == 'batch': ++#SBATCH --nodes=${nodes} ++#SBATCH --ntasks-per-node=${tasks_per_node} ++#SBATCH --cpus-per-task=1 ++#SBATCH --job-name="${name}" ++#SBATCH --time=${walltime} ++% if partition: ++#SBATCH --partition=${partition} ++% endif ++% if account: ++#SBATCH --account="${account}" ++% endif ++% if gpu: ++#SBATCH --gpus-per-node=${tasks_per_node} ++#SBATCH --mem=64G ++#SBATCH --gpu-bind=closest ++% endif ++#SBATCH --output="${name}.out" ++#SBATCH --error="${name}.err" ++#SBATCH --export=ALL ++% if email: ++#SBATCH --mail-user=${email} ++#SBATCH --mail-type="BEGIN, END, FAIL" ++% endif ++% endif ++ ++${helpers.template_prologue()} ++ ++ok ":) Loading modules:\n" ++cd "${MFC_ROOTDIR}" ++. ./mfc.sh load -c o -m ${'g' if gpu else 'c'} ++cd - > /dev/null ++echo ++ ++% for target in targets: ++ ${helpers.run_prologue(target)} ++ ++ % if not mpi: ++ (set -x; ${profiler} "${target.get_install_binpath(case)}") ++ % else: ++ (set -x; ${profiler} \ ++ mpirun -np ${nodes*tasks_per_node} \ ++ ${' '.join([f"'{x}'" for x in ARG('--') ])} \ ++ "${target.get_install_binpath(case)}") ++ % endif ++ ++ ${helpers.run_epilogue(target)} ++ ++ echo ++% endfor ++ ++${helpers.template_epilogue()} +diff --git a/toolchain/util.sh b/toolchain/util.sh +index c67c9cad..fddbe22a 100644 +--- a/toolchain/util.sh ++++ b/toolchain/util.sh +@@ -1,10 +1,10 @@ + #!/bin/bash + + if [ -t 1 ]; then +- RED="\x1B[31m"; CYAN="\x1B[36m"; GREEN="\x1B[32m" ++ RED="\x1B[31m"; CYAN="\x1B[36m"; GREEN="\x1B[32m"; BROWN="\x1B[38;5;58m" + YELLOW="\x1B[33m"; MAGENTA="\x1B[35m"; BLUE="\x1B[34m"; COLOR_RESET="\033[m" + +- R=$RED; C=$CYAN; G=$GREEN ++ R=$RED; C=$CYAN; G=$GREEN; BR=$BROWN + Y=$YELLOW; M=$MAGENTA; B=$BLUE; CR=$COLOR_RESET; W=$CR + fi + diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index 8fc4523f82..8f24a5fea6 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -55,7 +55,7 @@ program p_main ! Time-stepping Loop ======================================================= do - if (t_step > t_step_stop) then + if (t_step == t_step_stop) then call s_save_performance_metrics(t_step, time_avg, time_final, io_time_avg, & io_time_final, proc_time, io_proc_time, file_exists, start, finish, nt) exit @@ -64,7 +64,7 @@ program p_main call s_perform_time_step(t_step, time_avg, time_final, io_time_avg, io_time_final, & proc_time, io_proc_time, file_exists, start, finish, nt) - if (mod(t_step - t_step_start, t_step_save) == 0 .or. t_step > t_step_stop) then + if (mod(t_step - t_step_start, t_step_save) == 0 .or. t_step == t_step_stop) then call s_save_data(t_step, start, finish, io_time_avg, nt) end if diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index 88eb7b0044..4658d6b6cc 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -110,7 +110,7 @@ def analytic(self): "mu_v", "k_v", "G", "cv", "qv", "qvp" ]: PRE_PROCESS[f"fluid_pp({f_id})%{real_attr}"] = ParamType.REAL -for p_id in range(1, 10+4): +for p_id in range(1, 10+1): for attribute, ty in [("geometry", ParamType.INT), ("smoothen", ParamType.LOG), ("smooth_patch_id", ParamType.INT), ("hcid", ParamType.INT)]: PRE_PROCESS[f"patch_icpp({p_id})%{attribute}"] = ty From d2874619be7a38b173b43173c68f21f17dc63ad8 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 4 Aug 2024 23:03:34 -0500 Subject: [PATCH 275/380] removed diff.txt --- diff.txt | 8030 ------------------------------------------------------ 1 file changed, 8030 deletions(-) delete mode 100644 diff.txt diff --git a/diff.txt b/diff.txt deleted file mode 100644 index 8eb6fd7bcb..0000000000 --- a/diff.txt +++ /dev/null @@ -1,8030 +0,0 @@ -diff --git a/batch_mfc.sh b/batch_mfc.sh -new file mode 100755 -index 00000000..41df3c34 ---- /dev/null -+++ b/batch_mfc.sh -@@ -0,0 +1,14 @@ -+#!/bin/bash -+ -+./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar -+ -+./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar -+ -+./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar -+ -diff --git a/examples/2D_lungwave/case.py b/examples/2D_lungwave/case.py -new file mode 100644 -index 00000000..e5888cbe ---- /dev/null -+++ b/examples/2D_lungwave/case.py -@@ -0,0 +1,193 @@ -+#!/usr/bin/env python3 -+ -+import math -+import json -+ -+pi = 3.141592653589 -+# material parameters -+ -+#material1 :: gas -+#patterson 2018 -+ -+gammag = 1.4 #unitless -+Bg =0 #pascals -+rhog = 1.18 #kg/m^3 -+c_g = 347.2 #m/s -+G_g = 0 #pa -+ -+ #material2 :: lung -+ -+gammal = 5.5 -+Bl = 492.E+06 -+rhol = 996.0 -+c_l = 1648.7 -+G_l = 1E3 -+ -+#primitive vartiables -+patmos = 101325. #pa -+ -+#problem specific variable -+lambda_wave = 1E-3 -+ -+#define pulse -+P_amp = 10.E+6 -+P_len = 45 #length of the impulse -+theta = -math.pi/2 #direction of propagation -+ -+#non-dim -+ -+#define characteristic density, length, time, stress material -+rho_char = rhog -+length_char = lambda_wave -+c_char = c_g -+time_char = length_char/c_char -+stress_char = rho_char*c_char*c_char/gammag -+ -+#non-dim the properties -+rhog_n = rhog/rho_char -+c_g_n = c_g/c_char -+rhol_n = rhol/rho_char -+c_l_n = c_l/c_char -+Bg_n = Bg/stress_char -+Bl_n = Bl/stress_char -+G_g_n = G_g/stress_char -+G_l_n = G_l/stress_char -+patmos_n = patmos/stress_char -+P_amp_n = P_amp/stress_char -+ -+#geometry -+dlengx = 1. -+dlengy = 20. -+Nx = 200 -+Ny = dlengy*Nx -+dx = dlengx/Nx -+dy = dlengy/Ny -+alphal_back = 1.0 -+alphag_back = 0.0 -+alphal_lung = 0.0 -+alphag_lung = 1.0 -+ -+interface_amp = 0.5 -+ -+# time stepping requirements -+time_end = 2.5 -+cfl = 0.5 -+ -+dt = cfl * dx/c_l -+Nt = int(time_end/dt) -+Nframes = 50000 -+tstart = 0 -+tstop = Nt -+tsave = int(Nt/Nframes) -+ -+#interface profile -+interface_amp = 0.5 -+ -+# Configuring case dictionary -+print(json.dumps({ -+ # Logistics ================================================================ -+ 'run_time_info' : 'T', -+ # ========================================================================== -+ -+ # Computational Domain Parameters ========================================== -+ 'x_domain%beg' : 0., -+ 'x_domain%end' : dlengx, -+ 'y_domain%beg' : -dlengy/2., -+ 'y_domain%end' : dlengy/2., -+ 'm' : int(Nx), -+ 'n' : int(Ny), -+ 'p' : 0, -+ 'dt' : dt, -+ 't_step_start' : tstart, -+ 't_step_stop' : tstop, -+ 't_step_save' : tsave, -+ # ========================================================================== -+ -+ # Simulation Algorithm Parameters ========================================== -+ 'num_patches' : 2, -+ 'model_eqns' : 2, -+ 'alt_soundspeed' : 'F', -+ 'num_fluids' : 2, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'T', -+ 'mixture_err' : 'T', -+ 'time_stepper' : 3, -+ 'weno_order' : 5, -+ 'weno_eps' : 1.E-16, -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'T', -+ 'riemann_solver' : 2, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -1, -+ 'bc_x%end' : -1, -+ 'bc_y%beg' : -6, -+ 'bc_y%end' : -6, -+ # ========================================================================== -+ -+ # Formatted Database Files Structure Parameters ============================ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt' :'T', -+ 'parallel_io' :'T', -+ # ========================================================================== -+ -+ # Monopole setting ========================================================= -+ 'Monopole' : 'T', # creating an acoustic wave -+ 'num_mono' : 1, # place in the middle and expand -+ 'Mono(1)%pulse' : 3, # sine wave -+ 'Mono(1)%npulse' : 1, # 1 pulse -+ 'Mono(1)%mag' : 10.0*patmos_n, # magnitude -+ 'Mono(1)%length' : 1*dlengx, # impulse length -+ 'Mono(1)%loc(1)' : dlengx/2, # x_center of the domain -+ 'Mono(1)%loc(2)' : 5.0*dlengx, # upper boundary of the domain -+ 'Mono(1)%dir' : -math.pi/2, # direction: -pi/2 -+ #============================================================================== -+ -+ # Patch 1: Background ====================================================== -+ 'patch_icpp(1)%geometry' : 3, -+ 'patch_icpp(1)%x_centroid' : dlengx/2, -+ 'patch_icpp(1)%y_centroid' : 0., -+ 'patch_icpp(1)%length_x' : dlengx, -+ 'patch_icpp(1)%length_y' : dlengy, -+ 'patch_icpp(1)%vel(1)' : 0., -+ 'patch_icpp(1)%vel(2)' : 0.E+00, -+ 'patch_icpp(1)%pres' : patmos_n, -+ 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, -+ 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, -+ 'patch_icpp(1)%alpha(1)' : alphal_back, -+ 'patch_icpp(1)%alpha(2)' : alphag_back, -+ # ========================================================================== -+ -+ -+ # Patch 2: Lung ============================================================ -+ 'patch_icpp(2)%geometry' : 7, -+ 'patch_icpp(2)%hcid' : 205, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ 'patch_icpp(2)%x_centroid' : dlengx/2., -+ 'patch_icpp(2)%y_centroid' : -dlengy/4., -+ 'patch_icpp(2)%length_x' : dlengx, -+ 'patch_icpp(2)%length_y' : dlengy/2.+2, -+ 'patch_icpp(2)%a2' : interface_amp, -+ 'patch_icpp(2)%vel(1)' : 0.E+00, -+ 'patch_icpp(2)%vel(2)' : 0.0, -+ 'patch_icpp(2)%pres' : patmos_n, -+ 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, -+ 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, -+ 'patch_icpp(2)%alpha(1)' : alphal_lung, -+ 'patch_icpp(2)%alpha(2)' : alphag_lung, -+ # ========================================================================== -+ -+ # Fluids Physical Parameters =============================================== -+ 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), -+ 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), -+ 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), -+ 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), -+ # ========================================================================== -+ -+})) -+ -+# ============================================================================== -diff --git a/examples/2D_lungwave_horizontal/case.py b/examples/2D_lungwave_horizontal/case.py -new file mode 100644 -index 00000000..d11aeac2 ---- /dev/null -+++ b/examples/2D_lungwave_horizontal/case.py -@@ -0,0 +1,189 @@ -+#!/usr/bin/env python3 -+ -+import math -+import json -+ -+pi = 3.141592653589 -+# material parameters -+ -+#material1 :: gas -+#patterson 2018 -+ -+gammag = 1.4 #unitless -+Bg =0 #pascals -+rhog = 1.18 #kg/m^3 -+c_g = 347.2 #m/s -+G_g = 0 #pa -+ -+#material2 :: water -+gammal = 5.5 -+Bl = 492.E+06 -+rhol = 996.0 -+c_l = 1648.7 -+G_l = 1E3 -+ -+#primitive vartiables -+patmos = 101325. #pa -+ -+#problem specific variable -+lambda_wave = 1E-3 -+ -+#define pulse -+P_amp = 10.E+6 -+P_len = 45 #length of the impulse -+theta = -math.pi/2 #direction of propagation -+ -+#non-dim -+ -+#define characteristic density, length, time, stress material -+rho_char = rhog -+length_char = lambda_wave -+c_char = c_g -+time_char = length_char/c_char -+stress_char = rho_char*c_char*c_char/gammag -+ -+#non-dim the properties -+rhog_n = rhog/rho_char -+c_g_n = c_g/c_char -+rhol_n = rhol/rho_char -+c_l_n = c_l/c_char -+Bg_n = Bg/stress_char -+Bl_n = Bl/stress_char -+G_g_n = G_g/stress_char -+G_l_n = G_l/stress_char -+patmos_n = patmos/stress_char -+P_amp_n = P_amp/stress_char -+ -+#geometry -+dlengx = 10. -+dlengy = 2. -+Ny = 500 -+Nx = dlengx*Ny -+dx = dlengx/Nx -+dy = dlengy/Ny -+alphal_back = 1.0 -+alphag_back = 0.0 -+alphal_lung = 0.0 -+alphag_lung = 1.0 -+ -+interface_amp = 0.5 -+ -+# time stepping requirements -+time_end = 5 -+cfl = 8.0 -+ -+dt = cfl * dx/c_l -+Nt = int(time_end/dt) -+Nframes = 500 -+tstart = 0 -+tstop = Nt -+tsave = int(Nt/Nframes) -+ -+# Configuring case dictionary -+print(json.dumps({ -+ # Logistics ================================================================ -+ 'run_time_info' : 'T', -+ # ========================================================================== -+ -+ # Computational Domain Parameters ========================================== -+ 'x_domain%beg' : -dlengx/2., -+ 'x_domain%end' : dlengx/2., -+ 'y_domain%beg' : 0., -+ 'y_domain%end' : dlengy, -+ 'm' : int(Nx), -+ 'n' : int(Ny), -+ 'p' : 0, -+ 'dt' : dt, -+ 't_step_start' : tstart, -+ 't_step_stop' : tstop, -+ 't_step_save' : tsave, -+ # ========================================================================== -+ -+ # Simulation Algorithm Parameters ========================================== -+ 'num_patches' : 2, -+ 'model_eqns' : 2, -+ 'alt_soundspeed' : 'F', -+ 'num_fluids' : 2, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'T', -+ 'mixture_err' : 'T', -+ 'time_stepper' : 3, -+ 'weno_order' : 5, -+ 'weno_eps' : 1.E-16, -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'T', -+ 'riemann_solver' : 2, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -6, -+ 'bc_x%end' : -6, -+ 'bc_y%beg' : -1, -+ 'bc_y%end' : -1, -+ # ========================================================================== -+ -+ # Formatted Database Files Structure Parameters ============================ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt' :'T', -+ 'parallel_io' :'T', -+ # ========================================================================== -+ -+ # Monopole setting ========================================================= -+ 'Monopole' : 'T', # creating an acoustic wave -+ 'num_mono' : 1, # place in the middle and expand -+ 'Mono(1)%pulse' : 3, # square wave -+ 'Mono(1)%npulse' : 1, # 1 pulse -+ 'Mono(1)%mag' : 100.0*patmos_n,# magnitude -+ 'Mono(1)%length' : 45.0*dlengy, # pulse length -+ 'Mono(1)%support' : 2, # 2D semi infinite plane (x: -inf,inf; y:-len/2, len/2) -+ 'Mono(1)%support_width' : 30, -+ 'Mono(1)%loc(1)' : 0.7*dlengy, # x_center of the domain -+ 'Mono(1)%loc(2)' : dlengy/2, # upper boundary of the domain -+ 'Mono(1)%dir' : -math.pi, # direction: -pi/2 -+ -+ # Patch 1: Background ====================================================== -+ 'patch_icpp(1)%geometry' : 3, -+ 'patch_icpp(1)%x_centroid' : 0., -+ 'patch_icpp(1)%y_centroid' : dlengy/2., -+ 'patch_icpp(1)%length_x' : dlengx, -+ 'patch_icpp(1)%length_y' : dlengy, -+ 'patch_icpp(1)%vel(1)' : 0., -+ 'patch_icpp(1)%vel(2)' : 0.E+00, -+ 'patch_icpp(1)%pres' : patmos_n, -+ 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, -+ 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, -+ 'patch_icpp(1)%alpha(1)' : alphal_back, -+ 'patch_icpp(1)%alpha(2)' : alphag_back, -+ # ========================================================================== -+ -+ # Patch 2: Lung ============================================================ -+ 'patch_icpp(2)%geometry' : 7, -+ 'patch_icpp(2)%hcid' : 206, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ 'patch_icpp(2)%x_centroid' : -dlengx/4., -+ 'patch_icpp(2)%y_centroid' : dlengy/2., -+ 'patch_icpp(2)%length_x' : dlengx/2.+2, -+ 'patch_icpp(2)%length_y' : dlengy, -+ 'patch_icpp(2)%a2' : interface_amp, -+ 'patch_icpp(2)%vel(1)' : 0.E+00, -+ 'patch_icpp(2)%vel(2)' : 0.0, -+ 'patch_icpp(2)%pres' : patmos_n, -+ 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, -+ 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, -+ 'patch_icpp(2)%alpha(1)' : alphal_lung, -+ 'patch_icpp(2)%alpha(2)' : alphag_lung, -+ # ========================================================================== -+ -+ # Fluids Physical Parameters =============================================== -+ 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), -+ 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), -+ 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), -+ 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), -+ -+ #============================================================================== -+})) -+ -+# ============================================================================== -diff --git a/examples/2D_phasechange_bubble/case.py b/examples/2D_phasechange_bubble/case.py -new file mode 100644 -index 00000000..5fbe5f83 ---- /dev/null -+++ b/examples/2D_phasechange_bubble/case.py -@@ -0,0 +1,286 @@ -+#!/usr/bin/env python3 -+import math, json -+ -+## 1 FOR BACKGROUND, 2 FOR BUBBLE -+# Pressure [Pa] -+p01 = 5E6 -+p02 = 3550 -+ -+# Temperature [K] -+T01 = 298.15 -+T02 = 298.15 -+#T02 = 7.914 -+ -+#### FLUID PROPERTIES #### -+ -+### liquid water ### -+# pi infty -+piwl = 1.0E+09 -+# qv -+qvwl = -1167000 -+# qv' -+qvpwl = 0.0E0 -+# cv -+cvwl = 1816 -+# cp -+cpwl = 4267 -+# gamma -+gamwl = cpwl / cvwl -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) -+rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) -+ -+# speed of sound FOR -+c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) -+c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) -+ -+# part for Gases - relations from IMR -+Ru = 8.3144598 # Universal gas constant (J/mol-K) -+ -+### Vapor water ### -+Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) -+# gamma -+gamwv = 1.4 -+# cp -+cpwv = Rv * gamwv/(gamwv-1) -+# cv -+cvwv = cpwv/gamwv -+# pi infinity -+piwv = 0.0E0 -+# qv -+qvwv = 2030000 -+# qv' -+qvpwv = -23400 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) -+rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) -+ -+# speed of sound -+c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) -+c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) -+ -+### Air ### -+ -+Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) -+# gamma -+gama = 1.4 -+# cp -+cpa = Ra * gama/(gama-1) -+# cv -+cva = cpa/gama -+# pi infinity -+pia = 0.0E0 -+# qv -+qva = 0.0E0 -+# qv' -+qvpa = 0.0E0 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0a1 = (p01 + pia)/((gama-1)*cva*T01) -+rho0a2 = (p02 + pia)/((gama-1)*cva*T02) -+ -+# Speed of sound -+c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) -+c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) -+ -+## SHOCK RELATIONS -+p02Op01 = p02 / p01 -+ -+# Mach number of the shocked region - this should agree with Min, if everything is correct -+Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) -+ -+# shock speed -+ss = Ms * c_a1 -+ -+### volume fractions for each of the patches ### -+C0 = 0.25 # vapor concentration for IMR -+ -+# water liquid -+awl1 = 1.00E00-2.00E-12 -+awl2 = 1.00E-12 -+# water vapor -+awv1 = 1.00E-12 -+awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) -+# air -+aa1 = 1.0 - awl1 - awv1 -+aa2 = 1.0 - awl2 - awv2 -+ -+## SIMULATION PARAMETERS -+ -+# CFL -+cfl = 0.50 -+ -+# Bubble Initial Radius -+R0 = 30E-06 -+ -+# number of elements -+Nx0 = 400 -+Nx = 1600 -+Ny = 1600 -+Nz = 1600 -+ -+# domain boundaries -+xb = 0.00 -+xe = 120E-6 -+ -+yb = 0.00 -+ye = 120E-6 -+ -+zb = 0.00 -+ze = 120E-6 -+ -+# typical cell size -+dx = ( xe - xb ) / Nx -+dy = ( ye - yb ) / Ny -+dz = ( ze - zb ) / Nz -+ -+# time step -+ -+# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) -+SF = 200 -+ -+# Critical time-step -+tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) -+ -+# making Nt divisible by SF -+# tendA = 1.5 * tc -+tend = 1.2 * tc -+ -+# 1 - ensure NtA is sufficient to go a little beyond tendA -+# NtA = int( tendA // dt + 1 ) -+ -+# Array of saves. it is the same as Nt/Sf = t_step_save -+# AS = int( NtA // SF + 1 ) -+ -+# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) -+# Nt = AS * SF -+Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) -+ -+dt = tend / Nt -+ -+AS = int( Nt//SF ) -+ -+# Total physical time -+# tend = Nt * dt -+ -+# Configuring case dictionary ================================================== -+print(json.dumps({ -+ # Logistics ================================================ -+ 'run_time_info': 'T', -+ # ========================================================== -+ # Computational Domain Parameters ========================== -+ 'x_domain%beg' : xb, -+ 'x_domain%end' : xe, -+ 'y_domain%beg' : yb, -+ 'y_domain%end' : ye, -+ 'stretch_x' : 'T', -+ 'loops_x' : 3, -+ 'a_x' : 4.0E0, -+ 'x_a' : -2.0*R0, -+ 'x_b' : 2.0*R0, -+ 'stretch_y' : 'T', -+ 'loops_y' : 3, -+ 'a_y' : 4.0E0, -+ 'y_a' : -2.0*R0, -+ 'y_b' : 2.0*R0, -+ 'cyl_coord' : 'T', -+ 'm' : Nx, -+ 'n' : Ny, -+ 'p' : 0, -+ 'dt' : dt, -+ 't_step_start' : 0, -+ 't_step_stop' : Nt, -+ 't_step_save' : AS, -+ # ========================================================== -+ # Simulation Algorithm Parameters ========================== -+ 'num_patches' : 2, -+ 'model_eqns' : 3, -+ 'num_fluids' : 3, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'T', -+ 'mixture_err' : 'T', -+ 'relax' : 'T', -+ 'relax_model' : 6, -+ 'palpha_eps' : 1.0E-8, -+ 'ptgalpha_eps' : 1.0E-2, -+ 'time_stepper' : 3, -+ 'weno_order' : 3, -+ 'weno_eps' : 1.0E-16, -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'F', -+ 'riemann_solver' : 2, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -2, -+ 'bc_x%end' : -6, -+ 'bc_y%beg' : -2, -+ 'bc_y%end' : -6, -+ # ========================================================== -+ # Formatted Database Files Structure Parameters ============ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt':'T', -+ 'parallel_io' :'T', -+ # ========================================================== -+ # Patch 1: High pressured water ============================ -+ # Specify the cubic water background grid geometry -+ 'patch_icpp(1)%geometry' : 3, -+ 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, -+ 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, -+ 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, -+ 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, -+ 'patch_icpp(1)%vel(1)' : 0.0E+00, -+ 'patch_icpp(1)%vel(2)' : 0.0E+00, -+ 'patch_icpp(1)%pres' : p01, -+ 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, -+ 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, -+ 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, -+ 'patch_icpp(1)%alpha(1)' : awl1, -+ 'patch_icpp(1)%alpha(2)' : awv1, -+ 'patch_icpp(1)%alpha(3)' : aa1, -+ # ========================================================== -+ # Patch 2: (Vapor) Bubble ================================== -+ 'patch_icpp(2)%geometry' : 2, -+ 'patch_icpp(2)%x_centroid' : xb, -+ 'patch_icpp(2)%y_centroid' : yb, -+ 'patch_icpp(2)%radius' : R0, -+ 'patch_icpp(2)%vel(1)' : 0.0E+00, -+ 'patch_icpp(2)%vel(2)' : 0.0E+00, -+ 'patch_icpp(2)%pres' : p02, -+ 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, -+ 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, -+ 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, -+ 'patch_icpp(2)%alpha(1)' : awl2, -+ 'patch_icpp(2)%alpha(2)' : awv2, -+ 'patch_icpp(2)%alpha(3)' : aa2, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ # ========================================================== -+ # Fluids Physical Parameters =============================== -+ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), -+ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), -+ 'fluid_pp(1)%cv' : cvwl, -+ 'fluid_pp(1)%qv' : qvwl, -+ 'fluid_pp(1)%qvp' : qvpwl, -+ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), -+ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), -+ 'fluid_pp(2)%cv' : cvwv, -+ 'fluid_pp(2)%qv' : qvwv, -+ 'fluid_pp(2)%qvp' : qvpwv, -+ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), -+ 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), -+ 'fluid_pp(3)%cv' : cva, -+ 'fluid_pp(3)%qv' : qva, -+ 'fluid_pp(3)%qvp' : qvpa, -+ # ========================================================== -+})) -diff --git a/examples/2D_phasechange_bubble/casefile.py b/examples/2D_phasechange_bubble/casefile.py -new file mode 100644 -index 00000000..722d0049 ---- /dev/null -+++ b/examples/2D_phasechange_bubble/casefile.py -@@ -0,0 +1,300 @@ -+#!/usr/bin/env python3 -+import math, json -+ -+## 1 FOR BACKGROUND, 2 FOR BUBBLE -+# Pressure [Pa] -+p01 = 5E6 -+p02 = 3550 -+ -+# Temperature [K] -+T01 = 298.15 -+T02 = 298.15 -+#T02 = 7.914 -+ -+#### FLUID PROPERTIES #### -+ -+### liquid water ### -+# pi infty -+piwl = 1.0E+09 -+# qv -+qvwl = -1167000 -+# qv' -+qvpwl = 0.0E0 -+# cv -+cvwl = 1816 -+# cp -+cpwl = 4267 -+# gamma -+gamwl = cpwl / cvwl -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) -+rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) -+ -+# speed of sound FOR -+c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) -+c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) -+ -+# part for Gases - relations from IMR -+Ru = 8.3144598 # Universal gas constant (J/mol-K) -+ -+### Vapor water ### -+Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) -+# gamma -+gamwv = 1.4 -+# cp -+cpwv = Rv * gamwv/(gamwv-1) -+# cv -+cvwv = cpwv/gamwv -+# pi infinity -+piwv = 0.0E0 -+# qv -+qvwv = 2030000 -+# qv' -+qvpwv = -23400 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) -+rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) -+ -+# speed of sound -+c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) -+c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) -+ -+### Air ### -+ -+Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) -+# gamma -+gama = 1.4 -+# cp -+cpa = Ra * gama/(gama-1) -+# cv -+cva = cpa/gama -+# pi infinity -+pia = 0.0E0 -+# qv -+qva = 0.0E0 -+# qv' -+qvpa = 0.0E0 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0a1 = (p01 + pia)/((gama-1)*cva*T01) -+rho0a2 = (p02 + pia)/((gama-1)*cva*T02) -+ -+# Speed of sound -+c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) -+c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) -+ -+## SHOCK RELATIONS -+p02Op01 = p02 / p01 -+ -+# Mach number of the shocked region - this should agree with Min, if everything is correct -+Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) -+ -+# shock speed -+ss = Ms * c_a1 -+ -+### volume fractions for each of the patches ### -+C0 = 0.25 # vapor concentration for IMR -+ -+# water liquid -+awl1 = 1.00E00-2.00E-12 -+awl2 = 1.00E-12 -+# water vapor -+awv1 = 1.00E-12 -+awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) -+# air -+aa1 = 1.0 - awl1 - awv1 -+aa2 = 1.0 - awl2 - awv2 -+ -+## SIMULATION PARAMETERS -+ -+# CFL -+cfl = 0.50 -+ -+# Bubble Initial Radius -+R0 = 30E-06 -+ -+# number of elements -+Nx0 = 400 -+Nx = 100 -+Ny = 100 -+Nz = 100 -+ -+# domain boundaries -+xb = 0.00 -+xe = 120E-6 -+ -+yb = 0.00 -+ye = 120E-6 -+ -+zb = 0.00 -+ze = 120E-6 -+ -+# typical cell size -+dx = ( xe - xb ) / Nx -+dy = ( ye - yb ) / Ny -+dz = ( ze - zb ) / Nz -+ -+# time step -+ -+# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) -+SF = 200 -+ -+# Critical time-step -+tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) -+ -+# making Nt divisible by SF -+# tendA = 1.5 * tc -+tend = 1.2 * tc -+ -+# 1 - ensure NtA is sufficient to go a little beyond tendA -+# NtA = int( tendA // dt + 1 ) -+ -+# Array of saves. it is the same as Nt/Sf = t_step_save -+# AS = int( NtA // SF + 1 ) -+ -+# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) -+# Nt = AS * SF -+Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) -+ -+dt = tend / Nt -+ -+AS = int( Nt//SF ) -+ -+# Total physical time -+# tend = Nt * dt -+ -+# Configuring case dictionary ================================================== -+print(json.dumps({ -+ # Logistics ================================================ -+ 'run_time_info': 'T', -+ # ========================================================== -+ # Computational Domain Parameters ========================== -+ 'x_domain%beg' : xb, -+ 'x_domain%end' : xe, -+ 'y_domain%beg' : yb, -+ 'y_domain%end' : ye, -+ 'z_domain%beg' : zb, -+ 'z_domain%end' : ze, -+ 'stretch_x' : 'T', -+ 'loops_x' : 3, -+ 'a_x' : 4.0E0, -+ 'x_a' : -2.0*R0, -+ 'x_b' : 2.0*R0, -+ 'stretch_y' : 'T', -+ 'loops_y' : 3, -+ 'a_y' : 4.0E0, -+ 'y_a' : -2.0*R0, -+ 'y_b' : 2.0*R0, -+ 'stretch_z' : 'T', -+ 'loops_z' : 3, -+ 'a_z' : 4.0E0, -+ 'z_a' : -2.0*R0, -+ 'z_b' : 2.0*R0, -+ 'cyl_coord' : 'F', -+ 'm' : Nx, -+ 'n' : Ny, -+ 'p' : Nz, -+ 'dt' : dt, -+ 't_step_start' : 0, -+ 't_step_stop' : Nt, -+ 't_step_save' : AS, -+ # ========================================================== -+ # Simulation Algorithm Parameters ========================== -+ 'num_patches' : 2, -+ 'model_eqns' : 3, -+ 'num_fluids' : 3, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'T', -+ 'mixture_err' : 'T', -+ 'relax' : 'T', -+ 'relax_model' : 6, -+ 'palpha_eps' : 1.0E-6, -+ 'ptgalpha_eps' : 1.0E-2, -+ 'time_stepper' : 3, -+ 'weno_order' : 3, -+ 'weno_eps' : 1.0E-32, -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'F', -+ 'riemann_solver' : 2, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -2, -+ 'bc_x%end' : -6, -+ 'bc_y%beg' : -2, -+ 'bc_y%end' : -6, -+ 'bc_z%beg' : -2, -+ 'bc_z%end' : -6, -+ # ========================================================== -+ # Formatted Database Files Structure Parameters ============ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt':'T', -+ 'parallel_io' :'T', -+ # ========================================================== -+ # Patch 1: High pressured water ============================ -+ # Specify the cubic water background grid geometry -+ 'patch_icpp(1)%geometry' : 9, -+ 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, -+ 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, -+ 'patch_icpp(1)%z_centroid' : ( ze + zb ) * 500000 / 100, -+ 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, -+ 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, -+ 'patch_icpp(1)%length_z' : ( ze - zb ) * 1000000 / 100, -+ 'patch_icpp(1)%vel(1)' : 0.0E+00, -+ 'patch_icpp(1)%vel(2)' : 0.0E+00, -+ 'patch_icpp(1)%vel(3)' : 0.0E+00, -+ 'patch_icpp(1)%pres' : p01, -+ 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, -+ 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, -+ 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, -+ 'patch_icpp(1)%alpha(1)' : awl1, -+ 'patch_icpp(1)%alpha(2)' : awv1, -+ 'patch_icpp(1)%alpha(3)' : aa1, -+ # ========================================================== -+ # Patch 2: (Vapor) Bubble ================================== -+ 'patch_icpp(2)%geometry' : 8, -+ 'patch_icpp(2)%x_centroid' : xb, -+ 'patch_icpp(2)%y_centroid' : yb, -+ 'patch_icpp(2)%z_centroid' : zb, -+ 'patch_icpp(2)%radius' : R0, -+ 'patch_icpp(2)%vel(1)' : 0.0E+00, -+ 'patch_icpp(2)%vel(2)' : 0.0E+00, -+ 'patch_icpp(2)%vel(3)' : 0.0E+00, -+ 'patch_icpp(2)%pres' : p02, -+ 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, -+ 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, -+ 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, -+ 'patch_icpp(2)%alpha(1)' : awl2, -+ 'patch_icpp(2)%alpha(2)' : awv2, -+ 'patch_icpp(2)%alpha(3)' : aa2, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ # ========================================================== -+ # Fluids Physical Parameters =============================== -+ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), -+ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), -+ 'fluid_pp(1)%cv' : cvwl, -+ 'fluid_pp(1)%qv' : qvwl, -+ 'fluid_pp(1)%qvp' : qvpwl, -+ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), -+ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), -+ 'fluid_pp(2)%cv' : cvwv, -+ 'fluid_pp(2)%qv' : qvwv, -+ 'fluid_pp(2)%qvp' : qvpwv, -+ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), -+ 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), -+ 'fluid_pp(3)%cv' : cva, -+ 'fluid_pp(3)%qv' : qva, -+ 'fluid_pp(3)%qvp' : qvpa, -+ # ========================================================== -+})) -diff --git a/examples/3D_CAV/3D_CAV_sph_col.py b/examples/3D_CAV/3D_CAV_sph_col.py -new file mode 100644 -index 00000000..a54df0a5 ---- /dev/null -+++ b/examples/3D_CAV/3D_CAV_sph_col.py -@@ -0,0 +1,205 @@ -+import math -+import json -+ -+ -+## Deine characteristic values for the sim -+Ri = 50E-6 -+T = 407.9 -+rhog = 0.027 -+Pb = 3550 -+Pl = 101325 -+#mulc = 9E-04 -+#mubc = 1.0E-05 -+domain_length = 3*Ri -+ -+ -+## fluid properties -+Pi_inf_l = 1.0E+09 -+Pi_inf_b = 0.0E+00 -+nl = 2.35 -+nb = 1.47 -+alpha1 = 1.0E+00 -+Cv_l = 1816 -+rhol = (Pl+Pi_inf_l)/((nl-1)*Cv_l*T) -+alpha2 = alpha1 -+cl = (nl*(Pl+Pi_inf_l)/rhol)**(0.5) -+ -+## Defining Characteristic Values -+Rc = Ri -+rhoc = rhol -+uc = (Pl/rhol)**(0.5E+00) -+tc = Ri/uc -+Pc = rhoc*uc**(2.0E+00) -+ -+## Non-Dimensionalizing values using characteristic values -+Rin = Ri/Rc -+rholn = rhol/rhoc -+rhogn = rhog/rhoc -+Pln = Pl/Pc -+Pbn = Pb/Pc -+tcn = tc/tc -+Pi_inf_ln = Pi_inf_l/Pc -+leng = domain_length/Rc -+clc = cl/uc -+ -+ -+## Non-Dimensional Numbers -+#Rel = rhol*uc*2*Rin/mulc -+#Reb = rhog*uc*2*Rin/mubc -+Ma = uc/cl -+ -+## Grid Specifications -+CFL = 0.1 -+PpBr = 192 -+Nx = PpBr*leng -+Ny = Nx -+Nz = Nx -+x_beg = 0.0E+00 -+x_end = leng -+y_beg = 0.0E+00 -+y_end = leng -+z_beg = 0.0E+00 -+z_end = leng -+delta_x = leng/Nx -+delta_t = CFL*delta_x/clc -+Nt = int(1.1*tcn/delta_t) -+x_centroidl = (x_end+x_beg)/(2.0E+00) -+y_centroidl = (y_end+y_beg)/(2.0E+00) -+z_centroidl = (z_end+z_beg)/(2.0E+00) -+x_centroidb = 0.0E+00 -+y_centroidb = 0.0E+00 -+z_centroidb = 0.0E+00 -+ -+ -+# Configuring case dictionary -+print(json.dumps({ -+ # Logistics ================================================ -+ 'run_time_info' : 'T', -+ 'sim_data' : 'T', -+ # ========================================================== -+ -+ # Computational Domain Parameters ========================== -+ 'x_domain%beg' : x_beg, -+ 'x_domain%end' : x_end, -+ 'y_domain%beg' : y_beg, -+ 'y_domain%end' : y_end, -+ 'z_domain%beg' : z_beg, -+ 'z_domain%end' : z_end, -+ 'm' : int(Nx), -+ 'n' : int(Ny), -+ 'p' : int(Nz), -+ 'cyl_coord' : 'F', -+ 'dt' : delta_t, -+ 't_step_start' : 0, -+ 't_step_stop' : Nt, -+ 't_step_save' : int(Nt/360), -+# ========================================================== -+ -+ # Simulation Algorithm Parameters ========================== -+ 'num_patches' : 2, -+ 'model_eqns' : 2, -+ 'alt_soundspeed' : 'F', -+ 'num_fluids' : 2, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'T', -+ 'mixture_err' : 'T', -+ 'time_stepper' : 3, -+ 'weno_order' : 5, -+ 'weno_eps' : 1.E-100, -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'F', -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'riemann_solver' : 2, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -2, -+ 'bc_x%end' : -6, -+ 'bc_y%beg' : -2, -+ 'bc_y%end' : -6, -+ 'bc_z%beg' : -2, -+ 'bc_z%end' : -6, -+ 'stretch_x' : 'T', -+ 'stretch_y' : 'T', -+ 'stretch_z' : 'T', -+ 'a_x' : 4.0E+00, -+ 'x_a' : -1.5E+00, -+ 'x_b' : 1.5E+00, -+ 'a_y' : 4.0E+00, -+ 'y_a' : -1.5E+00, -+ 'y_b' : 1.5E+00, -+ 'a_z' : 4.0E+00, -+ 'z_a' : -1.5E+00, -+ 'z_b' : 1.5E+00, -+ # ========================================================== -+ -+ # Formatted Database Files Structure Parameters ============ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt' :'T', -+ 'parallel_io' :'T', -+ 'fd_order' :'1', -+ 'probe_wrt' :'T', -+ 'num_probes' : 1, -+ 'probe(1)%x' : 0., -+ 'probe(1)%y' : 0., -+ 'probe(1)%z' : 0., -+ # ========================================================== -+ -+ # Patch 1: Background ============================ -+ 'patch_icpp(1)%geometry' : 9, -+ 'patch_icpp(1)%x_centroid' : 40*x_centroidl, -+ 'patch_icpp(1)%y_centroid' : 40*y_centroidl, -+ 'patch_icpp(1)%z_centroid' : 40*z_centroidl, -+ 'patch_icpp(1)%length_x' : 40*leng, -+ 'patch_icpp(1)%length_y' : 40*leng, -+ 'patch_icpp(1)%length_z' : 40*leng, -+ 'patch_icpp(1)%vel(1)' : 0.E+00, -+ 'patch_icpp(1)%vel(2)' : 0.E+00, -+ 'patch_icpp(1)%vel(3)' : 0.E+00, -+ 'patch_icpp(1)%pres' : Pln, -+ 'patch_icpp(1)%alpha_rho(1)' : alpha1*rholn, -+ 'patch_icpp(1)%alpha_rho(2)' : 0.0E+00, -+ 'patch_icpp(1)%alpha(1)' : alpha1, -+ 'patch_icpp(1)%alpha(2)' : 0.0E+00, -+ # ========================================================== -+ # Patch 2: Bubble ====================================== -+ 'patch_icpp(2)%geometry' : 14, -+ 'patch_icpp(2)%x_centroid' : x_centroidb, -+ 'patch_icpp(2)%y_centroid' : y_centroidb, -+ 'patch_icpp(2)%z_centroid' : z_centroidb, -+ 'patch_icpp(2)%radius' : Rin, -+ 'patch_icpp(2)%smoothen' : 'T', -+ 'patch_icpp(2)%smooth_patch_id': 1, -+ 'patch_icpp(2)%smooth_coeff' : 1.5E+00, -+ 'patch_icpp(2)%non_axis_sym' : 'F', -+ 'patch_icpp(2)%a2' : 0.0E+00, -+ 'patch_icpp(2)%a3' : 0.0E+00, -+ 'patch_icpp(2)%a4' : 0.0E+00, -+ 'patch_icpp(2)%a5' : 0.0E+00, -+ 'patch_icpp(2)%a6' : 0.0E+00, -+ 'patch_icpp(2)%a7' : 0.0E+00, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ 'patch_icpp(2)%vel(1)' : 0.E+00, -+ 'patch_icpp(2)%vel(2)' : 0.E+00, -+ 'patch_icpp(2)%vel(3)' : 0.E+00, -+ 'patch_icpp(2)%pres' : Pbn, -+ 'patch_icpp(2)%alpha_rho(1)' : 0.0E+00, -+ 'patch_icpp(2)%alpha_rho(2)' : alpha2*rhogn, -+ 'patch_icpp(2)%alpha(1)' : 0.0E+00, -+ 'patch_icpp(2)%alpha(2)' : alpha2, -+ # ========================================================== -+ -+ # Fluids Physical Parameters =============================== -+ 'fluid_pp(1)%gamma' : 1/(nl-1), -+ 'fluid_pp(1)%pi_inf' : nl*Pi_inf_ln/(nl-1), -+ 'fluid_pp(2)%gamma' : 1/(nb-1), -+ 'fluid_pp(2)%pi_inf' : 0.0E+00, -+# 'fluid_pp(1)%Re(1)' : Rel, -+# 'fluid_pp(2)%Re(1)' : Reb, -+ # ========================================================== -+})) -+ -+# ============================================================================== -+ -diff --git a/examples/3D_ctr_test/case.py b/examples/3D_ctr_test/case.py -new file mode 100644 -index 00000000..aac9ec36 ---- /dev/null -+++ b/examples/3D_ctr_test/case.py -@@ -0,0 +1,399 @@ -+#!/usr/bin/env python3 -+import math, json -+ -+## 1 FOR BACKGROUND, 2 FOR BUBBLE, 3 FOR GEL -+# Pressure [Pa] -+p01 = 5E6 -+p02 = 3550 -+p03 = p01 -+ -+# Temperature [K] -+T01 = 298.15 -+T02 = 298.15 -+T03 = T01 -+ -+#### FLUID PROPERTIES #### -+ -+### liquid water ### -+# pi infty -+piwl = 1.0E+09 -+# qv -+qvwl = -1167000 -+# qv' -+qvpwl = 0.0E0 -+# cv -+cvwl = 1816 -+# cp -+cpwl = 4267 -+# gamma -+gamwl = cpwl / cvwl -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) -+rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) -+rho0wl3 = (p03 + piwl)/((gamwl-1)*cvwl*T03) -+ -+# speed of sound FOR -+c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) -+c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) -+c_wl3 = math.sqrt( gamwl * ( p03 + piwl ) / rho0wl3 ) -+ -+# part for Gases - relations from IMR -+Ru = 8.3144598 # Universal gas constant (J/mol-K) -+ -+### Vapor water ### -+Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) -+# gamma -+gamwv = 1.4 -+# cp -+cpwv = Rv * gamwv/(gamwv-1) -+# cv -+cvwv = cpwv/gamwv -+# pi infinity -+piwv = 0.0E0 -+# qv -+qvwv = 2030000 -+# qv' -+qvpwv = -23400 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) -+rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) -+rho0wv3 = (p03 + piwv)/((gamwv-1)*cvwv*T03) -+ -+# speed of sound -+c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) -+c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) -+c_wv3 = math.sqrt( gamwv * ( p03 + piwv ) / rho0wv3 ) -+ -+### Air ### -+ -+Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) -+gamwa = 1.4 -+# cp -+cpa = Ra * gamwa/(gamwa-1) -+# cv -+cva = cpa/gamwa -+# pi infinity -+pia = 0.0E0 -+# qv -+qvwa = 0.0E0 -+# qv' -+qvpwa = 0.0E0 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wa1 = (p01 + pia)/((gamwa-1)*cva*T01) -+rho0wa2 = (p02 + pia)/((gamwa-1)*cva*T02) -+ -+# Speed of sound -+c_a1 = math.sqrt( gamwa * ( p01 + pia ) / rho0wa1 ) -+c_a2 = math.sqrt( gamwa * ( p02 + pia ) / rho0wa2 ) -+ -+### 3% polyacrylamide gel ### -+# gamma -+gamwg = 2.35 -+# pi infty -+pig = 1.0E+09 -+# qv -+qvwg = -1167000 -+# qv' -+qvpwg = 0.0E0 -+# cv -+cvg = 1816 -+# cp -+cpg = gamwg*cvg -+ -+## FOR PATCHES 1 & 2 & 3 ## -+ -+# density -+rho0wg1 = (p01 + pig)/((gamwg-1)*cvg*T01) -+rho0wg2 = (p02 + pig)/((gamwg-1)*cvg*T02) -+rho0wg3 = (p03 + pig)/((gamwg-1)*cvg*T03) -+ -+# Speed of sound -+c_g1 = math.sqrt( gamwg * ( p01 + pig ) / rho0wg1 ) -+c_g2 = math.sqrt( gamwg * ( p02 + pig ) / rho0wg2 ) -+c_g3 = math.sqrt( gamwg * ( p03 + pig ) / rho0wg3 ) -+ -+## SHOCK RELATIONS -+p02Op01 = p02 / p01 -+ -+# Mach number of the shocked region - this should agree with Min, if everything is correct -+Ms = math.sqrt( ( gamwa + 1. ) / ( 2. * gamwa ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) -+ -+# shock speed -+ss = Ms * c_a1 -+ -+### volume fractions for each of the patches ### -+C0 = 0.5 # vapor concentration for IMR -+ -+# patch 1: liquid water -+liq_wv = 1.00E-15 -+liq_wg = 0. -+liq_wa = 1.00E-15 -+liq_wl = 1.00E00 - liq_wv - liq_wa - liq_wg -+# water vapor -+vap_wl = 1.00E-15 -+vap_wv = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0wa2 + 1 ) -+vap_wg = 0. -+vap_wa = 1.00E-15 -+vap_tot = vap_wl + vap_wv + vap_wa + vap_wg -+# bub -+bub_wl = 1.00E-15 -+bub_wv = vap_tot -+bub_wg = 0. -+bub_wa = 1.00E00 - bub_wl - bub_wv - bub_wg -+# gel -+gel_wv = 0. -+gel_wl = 0. -+gel_wa = 0. -+gel_wg = 1.00E00 - gel_wl - gel_wv - gel_wa -+ -+## SIMULATION PARAMETERS -+ -+# CFL -+cfl = 0.50 -+ -+# Bubble Initial Radius -+R0 = 230.4E-06 -+ -+# number of elements -+Nx0 = 400 -+Nx = 399 -+Ny = 199 -+Nz = 199 -+ -+lref = 921.6E-6 -+# domain boundaries -+xb = -lref -+xe = lref -+ -+yb = 0.00 -+ye = lref -+ -+zb = 0.00 -+ze = lref -+ -+lenx = ( xe - xb ) -+leny = ( ye - yb ) -+lenz = ( ze - zb ) -+ -+xcenl = (xb + xe)/2.0 -+ycenl = (yb + ye)/2.0 -+zcenl = (zb + ze)/2.0 -+ -+#xdist = 6.51E-10 #2.17E-5 -+#sod = xdist/R0 -+sod = -2.17 -+xcenb = sod*R0 -+ycenb = 0.00 -+zcenb = 0.00 -+ -+xbg = 0 -+xeg = xe -+ -+lenxg = (xeg - xbg) -+lenyg = leny -+lenzg = lenz -+xceng = (xbg + xeg)/2.0 -+yceng = ycenl -+zceng = zcenl -+ -+# typical cell size -+dx = ( xe - xb ) / Nx -+dy = ( ye - yb ) / Ny -+dz = ( ze - zb ) / Nz -+#print(dx) -+# time step -+ -+# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) -+SF = 60 -+ -+# Critical time-step -+tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) -+ -+# making Nt divisible by SF -+# tendA = 1.5 * tc -+tend = 1.2 * tc -+ -+# 1 - ensure NtA is sufficient to go a little beyond tendA -+# NtA = int( tendA // dt + 1 ) -+ -+# Array of saves. it is the same as Nt/Sf = t_step_save -+# AS = int( NtA // SF + 1 ) -+ -+# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) -+# Nt = AS * SF -+Nt = int(10E3 * tend // tc * Nx / Nx0 + 1) -+#print(Nt) -+dt = tend / Nt -+ -+AS = int( Nt//SF ) -+ -+# Total physical time -+# tend = Nt * dt -+ -+# Configuring case dictionary ================================================== -+print(json.dumps({ -+ # Logistics ================================================ -+ 'run_time_info': 'T', -+ # ========================================================== -+ # Computational Domain Parameters ========================== -+ 'x_domain%beg' : xb, -+ 'x_domain%end' : xe, -+ 'y_domain%beg' : yb, -+ 'y_domain%end' : ye, -+ 'z_domain%beg' : zb, -+ 'z_domain%end' : ze, -+ 'stretch_x' : 'F', -+ 'loops_x' : 1, -+ 'a_x' : 4.0E0, -+ 'x_a' : -2.0*R0, -+ 'x_b' : 2.0*R0, -+ 'stretch_y' : 'F', -+ 'loops_y' : 1, -+ 'a_y' : 4.0E0, -+ 'y_a' : -2.0*R0, -+ 'y_b' : 2.0*R0, -+ 'stretch_z' : 'F', -+ 'loops_z' : 1, -+ 'a_z' : 4.0E0, -+ 'z_a' : -2.0*R0, -+ 'z_b' : 2.0*R0, -+ 'cyl_coord' : 'F', -+ 'm' : Nx, -+ 'n' : Ny, -+ 'p' : Nz, -+ 'dt' : dt, -+ 't_step_start' : 0, -+ 't_step_stop' : Nt, -+ 't_step_save' : AS, -+ # ========================================================== -+ # Simulation Algorithm Parameters ========================== -+ 'num_patches' : 3, -+ 'model_eqns' : 3, -+ 'num_fluids' : 4, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'T', -+ 'mixture_err' : 'T', -+ 'relax' : 'T', -+ 'relax_model' : 6, -+ 'palpha_eps' : 1.0E-6, -+ 'ptgalpha_eps' : 1.0E-2, -+ 'time_stepper' : 3, -+ 'weno_order' : 3, -+ 'weno_eps' : 1.0E-16, -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'F', -+ 'riemann_solver' : 2, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -6, #-2, -+ 'bc_x%end' : -6, -+ 'bc_y%beg' : -2, -+ 'bc_y%end' : -6, -+ 'bc_z%beg' : -2, -+ 'bc_z%end' : -6, -+ # ========================================================== -+ # Formatted Database Files Structure Parameters ============ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt':'T', -+ 'parallel_io' :'T', -+ # ========================================================== -+ # Patch 1: High pressured water ============================ -+ # Specify the cubic water background grid geometry -+ 'patch_icpp(1)%geometry' : 9, -+ 'patch_icpp(1)%x_centroid' : xcenl, -+ 'patch_icpp(1)%y_centroid' : ycenl, -+ 'patch_icpp(1)%z_centroid' : zcenl, -+ 'patch_icpp(1)%length_x' : lenx, -+ 'patch_icpp(1)%length_y' : leny, -+ 'patch_icpp(1)%length_z' : lenz, -+ 'patch_icpp(1)%vel(1)' : 0.0E+00, -+ 'patch_icpp(1)%vel(2)' : 0.0E+00, -+ 'patch_icpp(1)%vel(3)' : 0.0E+00, -+ 'patch_icpp(1)%pres' : p01, -+ 'patch_icpp(1)%alpha_rho(1)' : liq_wl * rho0wl1, -+ 'patch_icpp(1)%alpha_rho(2)' : liq_wv * rho0wv1, -+ 'patch_icpp(1)%alpha_rho(3)' : liq_wa * rho0wa1, -+ 'patch_icpp(1)%alpha_rho(4)' : liq_wg * rho0wg1, -+ 'patch_icpp(1)%alpha(1)' : liq_wl, -+ 'patch_icpp(1)%alpha(2)' : liq_wv, -+ 'patch_icpp(1)%alpha(3)' : liq_wa, -+ 'patch_icpp(1)%alpha(4)' : liq_wg, -+ # ========================================================== -+ # Patch 2: (Vapor) Bubble ================================== -+ 'patch_icpp(2)%geometry' : 8, -+ 'patch_icpp(2)%x_centroid' : xcenb, -+ 'patch_icpp(2)%y_centroid' : ycenb, -+ 'patch_icpp(2)%z_centroid' : zcenb, -+ 'patch_icpp(2)%radius' : R0, -+ 'patch_icpp(2)%vel(1)' : 0.0E+00, -+ 'patch_icpp(2)%vel(2)' : 0.0E+00, -+ 'patch_icpp(2)%vel(3)' : 0.0E+00, -+ 'patch_icpp(2)%pres' : p02, -+ 'patch_icpp(2)%alpha_rho(1)' : bub_wl * rho0wl2, -+ 'patch_icpp(2)%alpha_rho(2)' : bub_wv * rho0wv2, -+ 'patch_icpp(2)%alpha_rho(3)' : bub_wa * rho0wa2, -+ 'patch_icpp(2)%alpha_rho(4)' : bub_wg * rho0wg2, -+ 'patch_icpp(2)%alpha(1)' : bub_wl, -+ 'patch_icpp(2)%alpha(2)' : bub_wv, -+ 'patch_icpp(2)%alpha(3)' : bub_wa, -+ 'patch_icpp(2)%alpha(4)' : bub_wg, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ # ========================================================== -+ # Patch 3: Gel Object ====================================== -+ 'patch_icpp(3)%geometry' : 9, -+ 'patch_icpp(3)%x_centroid' : xceng, -+ 'patch_icpp(3)%y_centroid' : yceng, -+ 'patch_icpp(3)%z_centroid' : zceng, -+ 'patch_icpp(3)%length_x' : lenxg, -+ 'patch_icpp(3)%length_y' : lenyg, -+ 'patch_icpp(3)%length_z' : lenzg, -+ 'patch_icpp(3)%vel(1)' : 0.0E+00, -+ 'patch_icpp(3)%vel(2)' : 0.0E+00, -+ 'patch_icpp(3)%vel(3)' : 0.0E+00, -+ 'patch_icpp(3)%pres' : p03, -+ 'patch_icpp(3)%alpha_rho(1)' : gel_wl * rho0wl2, -+ 'patch_icpp(3)%alpha_rho(2)' : gel_wv * rho0wv2, -+ 'patch_icpp(3)%alpha_rho(3)' : gel_wa * rho0wa2, -+ 'patch_icpp(3)%alpha_rho(4)' : gel_wg * rho0wg2, -+ 'patch_icpp(3)%alpha(1)' : gel_wl, -+ 'patch_icpp(3)%alpha(2)' : gel_wv, -+ 'patch_icpp(3)%alpha(3)' : gel_wa, -+ 'patch_icpp(3)%alpha(4)' : gel_wg, -+ 'patch_icpp(3)%alter_patch(1)' : 'T', -+ # ========================================================== -+ # Fluids Physical Parameters =============================== -+ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), -+ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), -+ 'fluid_pp(1)%cv' : cvwl, -+ 'fluid_pp(1)%qv' : qvwl, -+ 'fluid_pp(1)%qvp' : qvpwl, -+ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), -+ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), -+ 'fluid_pp(2)%cv' : cvwv, -+ 'fluid_pp(2)%qv' : qvwv, -+ 'fluid_pp(2)%qvp' : qvpwv, -+ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gamwa - 1 ), -+ 'fluid_pp(3)%pi_inf' : gamwa * pia / ( gamwa - 1 ), -+ 'fluid_pp(3)%cv' : cva, -+ 'fluid_pp(3)%qv' : qvwa, -+ 'fluid_pp(3)%qvp' : qvpwa, -+ 'fluid_pp(4)%gamma' : 1.0E+00 / ( gamwg - 1), -+ 'fluid_pp(4)%pi_inf' : gamwg * pig / ( gamwg - 1), -+ 'fluid_pp(4)%cv' : cvg, -+ 'fluid_pp(4)%qv' : qvwg, -+ 'fluid_pp(4)%qvp' : qvpwg, -+ # ========================================================== -+})) -diff --git a/examples/3D_ctr_test/old_case.py b/examples/3D_ctr_test/old_case.py -new file mode 100644 -index 00000000..092c0213 ---- /dev/null -+++ b/examples/3D_ctr_test/old_case.py -@@ -0,0 +1,399 @@ -+#!/usr/bin/env python3 -+import math, json -+ -+## 1 FOR BACKGROUND, 2 FOR BUBBLE, 3 FOR GEL -+# Pressure [Pa] -+p01 = 5E6 -+p02 = 3550 -+p03 = p01 -+ -+# Temperature [K] -+T01 = 298.15 -+T02 = 298.15 -+T03 = T01 -+ -+#### FLUID PROPERTIES #### -+ -+### liquid water ### -+# pi infty -+piwl = 1.0E+09 -+# qv -+qvwl = -1167000 -+# qv' -+qvpwl = 0.0E0 -+# cv -+cvwl = 1816 -+# cp -+cpwl = 4267 -+# gamma -+gamwl = cpwl / cvwl -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) -+rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) -+rho0wl3 = (p03 + piwl)/((gamwl-1)*cvwl*T03) -+ -+# speed of sound FOR -+c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) -+c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) -+c_wl3 = math.sqrt( gamwl * ( p03 + piwl ) / rho0wl3 ) -+ -+# part for Gases - relations from IMR -+Ru = 8.3144598 # Universal gas constant (J/mol-K) -+ -+### Vapor water ### -+Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) -+# gamma -+gamwv = 1.4 -+# cp -+cpwv = Rv * gamwv/(gamwv-1) -+# cv -+cvwv = cpwv/gamwv -+# pi infinity -+piwv = 0.0E0 -+# qv -+qvwv = 2030000 -+# qv' -+qvpwv = -23400 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) -+rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) -+rho0wv3 = (p03 + piwv)/((gamwv-1)*cvwv*T03) -+ -+# speed of sound -+c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) -+c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) -+c_wv3 = math.sqrt( gamwv * ( p03 + piwv ) / rho0wv3 ) -+ -+### Air ### -+ -+Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) -+gamwa = 1.4 -+# cp -+cpa = Ra * gamwa/(gamwa-1) -+# cv -+cva = cpa/gamwa -+# pi infinity -+pia = 0.0E0 -+# qv -+qvwa = 0.0E0 -+# qv' -+qvpwa = 0.0E0 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wa1 = (p01 + pia)/((gamwa-1)*cva*T01) -+rho0wa2 = (p02 + pia)/((gamwa-1)*cva*T02) -+ -+# Speed of sound -+c_a1 = math.sqrt( gamwa * ( p01 + pia ) / rho0wa1 ) -+c_a2 = math.sqrt( gamwa * ( p02 + pia ) / rho0wa2 ) -+ -+### 3% polyacrylamide gel ### -+# gamma -+gamwg = 2.35 -+# pi infty -+pig = 1.0E+09 -+# qv -+qvwg = -1167000 -+# qv' -+qvpwg = 0.0E0 -+# cv -+cvg = 1816 -+# cp -+cpg = gamwg*cvg -+ -+## FOR PATCHES 1 & 2 & 3 ## -+ -+# density -+rho0wg1 = (p01 + pig)/((gamwg-1)*cvg*T01) -+rho0wg2 = (p02 + pig)/((gamwg-1)*cvg*T02) -+rho0wg3 = (p03 + pig)/((gamwg-1)*cvg*T03) -+ -+# Speed of sound -+c_g1 = math.sqrt( gamwg * ( p01 + pig ) / rho0wg1 ) -+c_g2 = math.sqrt( gamwg * ( p02 + pig ) / rho0wg2 ) -+c_g3 = math.sqrt( gamwg * ( p03 + pig ) / rho0wg3 ) -+ -+## SHOCK RELATIONS -+p02Op01 = p02 / p01 -+ -+# Mach number of the shocked region - this should agree with Min, if everything is correct -+Ms = math.sqrt( ( gamwa + 1. ) / ( 2. * gamwa ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) -+ -+# shock speed -+ss = Ms * c_a1 -+ -+### volume fractions for each of the patches ### -+C0 = 0.1 # vapor concentration for IMR -+ -+# patch 1: liquid water -+liq_wv = 1.00E-15 -+liq_wg = 1.00E-15 -+liq_wa = 1.00E-15 -+liq_wl = 1.00E00 - liq_wv - liq_wa - liq_wg -+# water vapor -+vap_wl = 1.00E-15 -+vap_wv = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0wa2 + 1 ) -+vap_wg = 1.00E-15 -+vap_wa = 1.00E-15 -+vap_tot = vap_wl + vap_wv + vap_wa + vap_wg -+# bub -+bub_wl = 1.00E-15 -+bub_wv = vap_tot -+bub_wg = 1.00E-15 -+bub_wa = 1.00E00 - bub_wl - bub_wv - bub_wg -+# gel -+gel_wv = 1.00E-15 -+gel_wl = 1.00E-15 -+gel_wa = 1.00E-15 -+gel_wg = 1.00E00 - gel_wl - gel_wv - gel_wa -+ -+## SIMULATION PARAMETERS -+ -+# CFL -+cfl = 0.50 -+ -+# Bubble Initial Radius -+R0 = 230.4E-06 -+ -+# number of elements -+Nx0 = 400 -+Nx = 199*2 -+Ny = 199 -+Nz = 199 -+ -+lref = 921.6E-6 -+# domain boundaries -+xb = -lref -+xe = lref -+ -+yb = 0.00 -+ye = lref -+ -+zb = 0.00 -+ze = lref -+ -+lenx = ( xe - xb ) -+leny = ( ye - yb ) -+lenz = ( ze - zb ) -+ -+xcenl = (xb + xe)/2.0 -+ycenl = (yb + ye)/2.0 -+zcenl = (zb + ze)/2.0 -+ -+#xdist = 6.51E-10 #2.17E-5 -+#sod = xdist/R0 -+sod = -2.17 -+xcenb = sod*R0 -+ycenb = 0.00 -+zcenb = 0.00 -+ -+xbg = 0 -+xeg = xe -+ -+lenxg = (xeg - xbg) -+lenyg = leny -+lenzg = lenz -+xceng = (xbg + xeg)/2.0 -+yceng = ycenl -+zceng = zcenl -+ -+# typical cell size -+dx = ( xe - xb ) / Nx -+dy = ( ye - yb ) / Ny -+dz = ( ze - zb ) / Nz -+#print(dx) -+# time step -+ -+# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) -+SF = 60 -+ -+# Critical time-step -+tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) -+ -+# making Nt divisible by SF -+# tendA = 1.5 * tc -+tend = 1.2 * tc -+ -+# 1 - ensure NtA is sufficient to go a little beyond tendA -+# NtA = int( tendA // dt + 1 ) -+ -+# Array of saves. it is the same as Nt/Sf = t_step_save -+# AS = int( NtA // SF + 1 ) -+ -+# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) -+# Nt = AS * SF -+Nt = int(10E3 * tend // tc * Nx / Nx0 + 1) -+#print(Nt) -+dt = tend / Nt -+ -+AS = int( Nt//SF ) -+ -+# Total physical time -+# tend = Nt * dt -+ -+# Configuring case dictionary ================================================== -+print(json.dumps({ -+ # Logistics ================================================ -+ 'run_time_info': 'T', -+ # ========================================================== -+ # Computational Domain Parameters ========================== -+ 'x_domain%beg' : xb, -+ 'x_domain%end' : xe, -+ 'y_domain%beg' : yb, -+ 'y_domain%end' : ye, -+ 'z_domain%beg' : zb, -+ 'z_domain%end' : ze, -+ 'stretch_x' : 'F', -+ 'loops_x' : 1, -+ 'a_x' : 4.0E0, -+ 'x_a' : -2.0*R0, -+ 'x_b' : 2.0*R0, -+ 'stretch_y' : 'F', -+ 'loops_y' : 1, -+ 'a_y' : 4.0E0, -+ 'y_a' : -2.0*R0, -+ 'y_b' : 2.0*R0, -+ 'stretch_z' : 'F', -+ 'loops_z' : 1, -+ 'a_z' : 4.0E0, -+ 'z_a' : -2.0*R0, -+ 'z_b' : 2.0*R0, -+ 'cyl_coord' : 'F', -+ 'm' : Nx, -+ 'n' : Ny, -+ 'p' : Nz, -+ 'dt' : dt, -+ 't_step_start' : 0, -+ 't_step_stop' : Nt, -+ 't_step_save' : AS, -+ # ========================================================== -+ # Simulation Algorithm Parameters ========================== -+ 'num_patches' : 3, -+ 'model_eqns' : 3, -+ 'num_fluids' : 4, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'T', -+ 'mixture_err' : 'T', -+ 'relax' : 'T', -+ 'relax_model' : 6, -+ 'palpha_eps' : 1.0E-6, -+ 'ptgalpha_eps' : 1.0E-2, -+ 'time_stepper' : 3, -+ 'weno_order' : 3, -+ 'weno_eps' : 1.0E-16, -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'F', -+ 'riemann_solver' : 2, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -6, #-2, -+ 'bc_x%end' : -6, -+ 'bc_y%beg' : -2, -+ 'bc_y%end' : -6, -+ 'bc_z%beg' : -2, -+ 'bc_z%end' : -6, -+ # ========================================================== -+ # Formatted Database Files Structure Parameters ============ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt':'T', -+ 'parallel_io' :'T', -+ # ========================================================== -+ # Patch 1: High pressured water ============================ -+ # Specify the cubic water background grid geometry -+ 'patch_icpp(1)%geometry' : 9, -+ 'patch_icpp(1)%x_centroid' : xcenl, -+ 'patch_icpp(1)%y_centroid' : ycenl, -+ 'patch_icpp(1)%z_centroid' : zcenl, -+ 'patch_icpp(1)%length_x' : lenx, -+ 'patch_icpp(1)%length_y' : leny, -+ 'patch_icpp(1)%length_z' : lenz, -+ 'patch_icpp(1)%vel(1)' : 0.0E+00, -+ 'patch_icpp(1)%vel(2)' : 0.0E+00, -+ 'patch_icpp(1)%vel(3)' : 0.0E+00, -+ 'patch_icpp(1)%pres' : p01, -+ 'patch_icpp(1)%alpha_rho(1)' : liq_wl * rho0wl1, -+ 'patch_icpp(1)%alpha_rho(2)' : liq_wv * rho0wv1, -+ 'patch_icpp(1)%alpha_rho(3)' : liq_wa * rho0wa1, -+ 'patch_icpp(1)%alpha_rho(4)' : liq_wg * rho0wg1, -+ 'patch_icpp(1)%alpha(1)' : liq_wl, -+ 'patch_icpp(1)%alpha(2)' : liq_wv, -+ 'patch_icpp(1)%alpha(3)' : liq_wa, -+ 'patch_icpp(1)%alpha(4)' : liq_wg, -+ # ========================================================== -+ # Patch 2: (Vapor) Bubble ================================== -+ 'patch_icpp(2)%geometry' : 8, -+ 'patch_icpp(2)%x_centroid' : xcenb, -+ 'patch_icpp(2)%y_centroid' : ycenb, -+ 'patch_icpp(2)%z_centroid' : zcenb, -+ 'patch_icpp(2)%radius' : R0, -+ 'patch_icpp(2)%vel(1)' : 0.0E+00, -+ 'patch_icpp(2)%vel(2)' : 0.0E+00, -+ 'patch_icpp(2)%vel(3)' : 0.0E+00, -+ 'patch_icpp(2)%pres' : p02, -+ 'patch_icpp(2)%alpha_rho(1)' : bub_wl * rho0wl2, -+ 'patch_icpp(2)%alpha_rho(2)' : bub_wv * rho0wv2, -+ 'patch_icpp(2)%alpha_rho(3)' : bub_wa * rho0wa2, -+ 'patch_icpp(2)%alpha_rho(4)' : bub_wg * rho0wg2, -+ 'patch_icpp(2)%alpha(1)' : bub_wl, -+ 'patch_icpp(2)%alpha(2)' : bub_wv, -+ 'patch_icpp(2)%alpha(3)' : bub_wa, -+ 'patch_icpp(2)%alpha(4)' : bub_wg, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ # ========================================================== -+ # Patch 3: Gel Object ====================================== -+ 'patch_icpp(3)%geometry' : 9, -+ 'patch_icpp(3)%x_centroid' : xceng, -+ 'patch_icpp(3)%y_centroid' : yceng, -+ 'patch_icpp(3)%z_centroid' : zceng, -+ 'patch_icpp(3)%length_x' : lenxg, -+ 'patch_icpp(3)%length_y' : lenyg, -+ 'patch_icpp(3)%length_z' : lenzg, -+ 'patch_icpp(3)%vel(1)' : 0.0E+00, -+ 'patch_icpp(3)%vel(2)' : 0.0E+00, -+ 'patch_icpp(3)%vel(3)' : 0.0E+00, -+ 'patch_icpp(3)%pres' : p03, -+ 'patch_icpp(3)%alpha_rho(1)' : gel_wl * rho0wl2, -+ 'patch_icpp(3)%alpha_rho(2)' : gel_wv * rho0wv2, -+ 'patch_icpp(3)%alpha_rho(3)' : gel_wa * rho0wa2, -+ 'patch_icpp(3)%alpha_rho(4)' : gel_wg * rho0wg2, -+ 'patch_icpp(3)%alpha(1)' : gel_wl, -+ 'patch_icpp(3)%alpha(2)' : gel_wv, -+ 'patch_icpp(3)%alpha(3)' : gel_wa, -+ 'patch_icpp(3)%alpha(4)' : gel_wg, -+ 'patch_icpp(3)%alter_patch(1)' : 'T', -+ # ========================================================== -+ # Fluids Physical Parameters =============================== -+ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), -+ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), -+ 'fluid_pp(1)%cv' : cvwl, -+ 'fluid_pp(1)%qv' : qvwl, -+ 'fluid_pp(1)%qvp' : qvpwl, -+ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), -+ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), -+ 'fluid_pp(2)%cv' : cvwv, -+ 'fluid_pp(2)%qv' : qvwv, -+ 'fluid_pp(2)%qvp' : qvpwv, -+ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gamwa - 1 ), -+ 'fluid_pp(3)%pi_inf' : gamwa * pia / ( gamwa - 1 ), -+ 'fluid_pp(3)%cv' : cva, -+ 'fluid_pp(3)%qv' : qvwa, -+ 'fluid_pp(3)%qvp' : qvpwa, -+ 'fluid_pp(4)%gamma' : 1.0E+00 / ( gamwg - 1), -+ 'fluid_pp(4)%pi_inf' : gamwg * pig / ( gamwg - 1), -+ 'fluid_pp(4)%cv' : cvg, -+ 'fluid_pp(4)%qv' : qvwg, -+ 'fluid_pp(4)%qvp' : qvpwg, -+ # ========================================================== -+})) -diff --git a/examples/3D_hyperelasticity/hyper_gel.py b/examples/3D_hyperelasticity/hyper_gel.py -new file mode 100644 -index 00000000..09782de4 ---- /dev/null -+++ b/examples/3D_hyperelasticity/hyper_gel.py -@@ -0,0 +1,312 @@ -+import math -+import json -+#need quadrant and collapse near hypoelastic wall -+ -+## Define characteristic values for the sim -+Ri = 230.4E-6 -+# temperature -+T = (10*101325+1.0E+09)/(1000*(2.35-1)*1816) -+# print("T :: ",T) -+rhog = 1 -+Pb = 3550 #Pb = 101325 -+Pl = 101325 #Pl = 20*101325 -+Po = Pl -+Pi_inf_l = 1.0E+09 -+Pi_inf_b = 0.0E+00 -+Pi_inf_o = 1.1754E+09 -+ -+## fluid properties -+# liquid -+nl = 2.35E+00 -+cv_l = 1816 -+rhol = (Pl+Pi_inf_l)/((nl-1)*cv_l*T) -+# object -+obj_rhol = rhol -+cv_o = cv_l -+rhoo = 1060 -+no = 2.35 -+#no = 1.19E+00 -+muo = 0.060E+00 -+# gas -+ng = 1.47E+00 -+ -+# alpha seeding fractions -+bub_wl = 1.0E-12 -+bub_wo = 1.0E-12 -+bub_wg = 1 - bub_wl - bub_wo -+liq_wo = 1.0E-12 -+liq_wg = 1.0E-12 -+liq_wl = 1 - liq_wo - liq_wg -+obj_wl = 1.0E-12 -+obj_wg = 1.0E-12 -+obj_wo = 1 - obj_wl - obj_wg -+ -+Gl = 0. -+Gg = 0. -+Go = 0.57E+03 #1.0933E+04 -+ -+## mixture values in the liquid -+#rhoml = (alpha1-alph_eps)*rhol+alph_eps*rhog -+#pi_inf_m = (alpha1-alph_eps)*Pi_inf_l -+#nml = (alpha1-alph_eps)*nl+alph_eps*ng -+cl = (nl*(Pl+Pi_inf_l)/rhol)**(0.5) -+rhoml = liq_wl*rhol + liq_wg*rhog + liq_wo*rhoo -+ -+## Defining Characteristic Values -+Rc = Ri -+rhoc = rhol -+uc = (Pl/rhol)**(0.5E+00) -+ucc = (Pl/rhoml)**(0.5E+00) -+# characteristic collapse time, change later to prevent horrific confusion -+tc = Ri/uc -+Pc = rhoc*uc**(2.0E+00) -+ -+## Non-Dimensionalizing values using characteristic values -+Rin = Ri/Rc -+rholn = rhol/rhoc -+rhogn = rhog/rhoc -+rhoon = rhoo/rhoc -+Pln = Pl/Pc -+Pbn = Pb/Pc -+Pon = Po/Pc -+tcn = tc/tc -+Pi_inf_ln = Pi_inf_l/Pc -+clc = cl/uc -+sod_nd = 2.17 -+#clmc = clm/ucc -+Pi_inf_on = Pi_inf_o/Pc -+ -+# Un comment if dimensional -+#Rin = Ri -+#rholn = rhol -+#rhogn = rhog -+#rhoon = rhoo -+#Pln = Pl -+#Pbn = Pb/rhoo -+#Pon = Po -+#tcn = tc -+#Pi_inf_ln = Pi_inf_l -+#leng = domain_length -+#clc = cl -+#sod_nd = sod -+ -+## Non-Dimensional Numbers -+#Rel = rhol*uc*2*Rin/mulc -+#Reb = rhog*uc*2*Rin/mubc -+Rel = 0 -+Reb = 0 -+Reo = rhoo*uc*2/muo -+Ma = uc/cl -+Co = Pl/Go -+iCo = 1/Co -+ -+## GEOMETRY:: Grid Specifications -+lengx = 8.0E+00 -+lengy = 3.0E+00 -+lengz = 3.0E+00 -+CFL = 0.3 -+PPBR = 16 #92 -+x_beg = -5.0E+00 -+x_end = 3.0E+00 -+y_beg = 0.0E+00 -+y_end = lengy -+z_beg = 0.0E+00 -+z_end = lengz -+Nx = PPBR*lengx -+Ny = PPBR*lengy -+Nz = PPBR*lengz -+delta_x = lengx/Nx -+delta_t = CFL*delta_x/clc -+ -+#print("NX :: ",Nx,", NY :: ",Ny,", NZ :: ",Nz) -+ -+#delta_t_c = 0.185*delta_x/clmc -+#print(delta_t_c) -+ -+Nt = int(1.7*tcn/delta_t) -+# liquid centroid, patch 1 -+x_centroidl = x_beg/(2.0E+00) -+y_centroidl = (y_end+y_beg)/(2.0E+00) -+z_centroidl = (z_end+z_beg)/(2.0E+00) -+# bubble centroid, patch 2 -+x_centroidb = -sod_nd -+y_centroidb = 0.0 -+z_centroidb = 0.0 -+# objective centroid, patch 3 -+x_centroido = x_end/2 -+y_centroido = (y_end+y_beg)/(2.0E+00) -+z_centroido = (z_end+z_beg)/(2.0E+00) -+ -+# Configuring case dictionary -+print(json.dumps({ -+ # Logistics ================================================ -+ 'run_time_info' : 'T', -+ 'sim_data' : 'T', -+ # ========================================================== -+ -+ # Computational Domain Parameters ========================== -+ 'x_domain%beg' : x_beg, -+ 'x_domain%end' : x_end, -+ 'y_domain%beg' : y_beg, -+ 'y_domain%end' : y_end, -+ 'z_domain%beg' : z_beg, -+ 'z_domain%end' : z_end, -+ 'm' : int(Nx), -+ 'n' : int(Ny), -+ 'p' : int(Nz), -+ 'cyl_coord' : 'F', -+ 'dt' : delta_t, -+ 't_step_start' : 0, -+ 't_step_stop' : Nt, -+ 't_step_save' : int(5),#int(Nt/150), -+# ========================================================== -+ -+ # Simulation Algorithm Parameters ========================== -+ 'num_patches' : 3, -+ 'model_eqns' : 2, -+ 'hypoelasticity' : 'F', -+ 'hyperelasticity' : 'T', -+ 'pre_stress' : 'F', -+ 'alt_soundspeed' : 'F', -+ 'num_fluids' : 3, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'F', -+ 'mixture_err' : 'T', -+ 'time_stepper' : 3, -+ 'weno_order' : 5, -+ 'weno_eps' : 1.E-16, -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'T', -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'riemann_solver' : 1, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -6, #-16,#-2 -+ 'bc_x%end' : -6, -+ 'bc_y%beg' : -2, -+ 'bc_y%end' : -6, -+ 'bc_z%beg' : -2, -+ 'bc_z%end' : -6, -+ 'stretch_x' : 'F', -+ 'stretch_y' : 'F', -+ 'stretch_z' : 'F', -+ 'a_x' : 4.0E+00, -+ 'x_a' : -1.5E+00-sod_nd, -+ 'x_b' : 2.5E+00, -+ #'loops_x' : 0, -+ 'a_y' : 4.0E+00, -+ 'y_a' : -1.5E+00, -+ 'y_b' : 1.5E+00, -+ #'loops_y' : 0, -+ 'a_z' : 4.0E+00, -+ 'z_a' : -1.5E+00, -+ 'z_b' : 1.5E+00, -+ #'loops_z' : 0, -+ # ========================================================== -+ -+ # Formatted Database Files Structure Parameters ============ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt' :'T', -+ 'parallel_io' :'T', -+ 'probe_wrt' :'T', -+ 'fd_order' : 1, -+ 'num_probes' : 1, -+ 'probe(1)%x' : 0., -+ 'probe(1)%y' : 0., -+ 'probe(1)%z' : 0., -+ # ========================================================== -+ -+ # Patch 1: Background ============================ -+ 'patch_icpp(1)%geometry' : 9,# for 3D -+ 'patch_icpp(1)%x_centroid' : x_centroidl, #100*x_centroidl, -+ 'patch_icpp(1)%y_centroid' : y_centroidl, #100*y_centroidl, -+ 'patch_icpp(1)%z_centroid' : z_centroidl, #100*z_centroidl, -+ 'patch_icpp(1)%length_x' : lengx, #200*lengx, -+ 'patch_icpp(1)%length_y' : lengy, #200*lengy, -+ 'patch_icpp(1)%length_z' : lengz, #200*lengz, -+ 'patch_icpp(1)%vel(1)' : 0.E+00, -+ 'patch_icpp(1)%vel(2)' : 0.E+00, -+ 'patch_icpp(1)%vel(3)' : 0.E+00, -+ 'patch_icpp(1)%pres' : Pln, -+ 'patch_icpp(1)%alpha_rho(1)' : liq_wl*rholn, -+ 'patch_icpp(1)%alpha_rho(2)' : liq_wg*rhogn, -+ 'patch_icpp(1)%alpha_rho(3)' : liq_wo*rhoon, -+ 'patch_icpp(1)%alpha(1)' : liq_wl, -+ 'patch_icpp(1)%alpha(2)' : liq_wg, -+ 'patch_icpp(1)%alpha(3)' : liq_wo, -+ # ========================================================== -+ # Patch 2: Bubble ====================================== -+ # Specify the spherical gas bubble grid geometry -+ 'patch_icpp(2)%geometry' : 8,# for 3D -+ 'patch_icpp(2)%smoothen' : 'T', -+ 'patch_icpp(2)%smooth_patch_id' : 1, -+ 'patch_icpp(2)%smooth_coeff' : 4.0E+00, -+ 'patch_icpp(2)%x_centroid' : x_centroidb, -+ 'patch_icpp(2)%y_centroid' : y_centroidb, -+ 'patch_icpp(2)%z_centroid' : z_centroidb, -+ 'patch_icpp(2)%radius' : Rin, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ # Specify the patch primitive variables -+ 'patch_icpp(2)%vel(1)' : 0.E+00, -+ 'patch_icpp(2)%vel(2)' : 0.E+00, -+ 'patch_icpp(2)%vel(3)' : 0.E+00, -+ 'patch_icpp(2)%pres' : Pbn, -+ 'patch_icpp(2)%alpha_rho(1)' : bub_wl*rholn, -+ 'patch_icpp(2)%alpha_rho(2)' : bub_wg*rhogn, -+ 'patch_icpp(2)%alpha_rho(3)' : bub_wo*rhoon, -+ 'patch_icpp(2)%alpha(1)' : bub_wl, -+ 'patch_icpp(2)%alpha(2)' : bub_wg, -+ 'patch_icpp(2)%alpha(3)' : bub_wo, -+ # ========================================================== -+ # Patch 3: Gel =========================================== -+ # Specify the gel grid geometry -+ 'patch_icpp(3)%geometry' : 9,# for 3D -+ 'patch_icpp(3)%x_centroid' : x_centroido, #100*x_centroido, -+ 'patch_icpp(3)%y_centroid' : y_centroido, #100*y_centroido, -+ 'patch_icpp(3)%z_centroid' : z_centroido, #100*z_centroido, -+ 'patch_icpp(3)%length_x' : 3.0E+00, #100*lengx, -+ 'patch_icpp(3)%length_y' : lengy, #200*lengy, -+ 'patch_icpp(3)%length_z' : lengz, #200*lengz, -+ 'patch_icpp(3)%alter_patch(1)' : 'T', -+ # Specify the patch primitive variables -+ 'patch_icpp(3)%vel(1)' : 0.E+00, -+ 'patch_icpp(3)%vel(2)' : 0.E+00, -+ 'patch_icpp(3)%vel(3)' : 0.E+00, -+ 'patch_icpp(3)%pres' : Pon, -+ 'patch_icpp(3)%alpha_rho(1)' : obj_wl*rholn, -+ 'patch_icpp(3)%alpha_rho(2)' : obj_wg*rhogn, -+ 'patch_icpp(3)%alpha_rho(3)' : obj_wo*rhoon, -+ 'patch_icpp(3)%alpha(1)' : obj_wl, -+ 'patch_icpp(3)%alpha(2)' : obj_wg, -+ 'patch_icpp(3)%alpha(3)' : obj_wo, -+ # ========================================================== -+ -+ -+ # Fluids Physical Parameters =============================== -+ 'fluid_pp(1)%gamma' : 1./(nl-1.), -+ 'fluid_pp(1)%pi_inf' : nl*Pi_inf_ln/(nl-1.), -+ 'fluid_pp(1)%G' : Gl, -+ 'fluid_pp(2)%gamma' : 1./(ng-1.), -+ 'fluid_pp(2)%pi_inf' : 0.0E+00, -+ 'fluid_pp(2)%G' : Gg, -+ 'fluid_pp(3)%gamma' : 1./(no-1.), -+ 'fluid_pp(3)%pi_inf' : no*Pi_inf_on/(no-1.), -+ 'fluid_pp(3)%G' : iCo, -+ 'fluid_pp(1)%qv' : 0.0E+00, -+ 'fluid_pp(1)%qvp' : 0.0E+00, -+ 'fluid_pp(2)%qv' : 0.0E+00, -+ 'fluid_pp(2)%qvp' : 0.0E+00, -+ 'fluid_pp(3)%qv' : 0.0E+00, -+ 'fluid_pp(3)%qvp' : 0.0E+00, -+# 'fluid_pp(1)%Re(1)' : Rel, -+# 'fluid_pp(2)%Re(1)' : Reb, -+# 'fluid_pp(3)%Re(1)' : Reo, -+ # ===========++============================================= -+})) -+ -+# ============================================================================== -+ -+ -diff --git a/examples/3D_phasechange_bubble/case.py b/examples/3D_phasechange_bubble/case.py -new file mode 100644 -index 00000000..047c8655 ---- /dev/null -+++ b/examples/3D_phasechange_bubble/case.py -@@ -0,0 +1,300 @@ -+#!/usr/bin/env python3 -+import math, json -+ -+## 1 FOR BACKGROUND, 2 FOR BUBBLE -+# Pressure [Pa] -+p01 = 5E6 -+p02 = 3550 -+ -+# Temperature [K] -+T01 = 298.15 -+T02 = 298.15 -+#T02 = 7.914 -+ -+#### FLUID PROPERTIES #### -+ -+### liquid water ### -+# pi infty -+piwl = 1.0E+09 -+# qv -+qvwl = -1167000 -+# qv' -+qvpwl = 0.0E0 -+# cv -+cvwl = 1816 -+# cp -+cpwl = 4267 -+# gamma -+gamwl = cpwl / cvwl -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) -+rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) -+ -+# speed of sound FOR -+c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) -+c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) -+ -+# part for Gases - relations from IMR -+Ru = 8.3144598 # Universal gas constant (J/mol-K) -+ -+### Vapor water ### -+Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) -+# gamma -+gamwv = 1.4 -+# cp -+cpwv = Rv * gamwv/(gamwv-1) -+# cv -+cvwv = cpwv/gamwv -+# pi infinity -+piwv = 0.0E0 -+# qv -+qvwv = 2030000 -+# qv' -+qvpwv = -23400 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) -+rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) -+ -+# speed of sound -+c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) -+c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) -+ -+### Air ### -+ -+Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) -+# gamma -+gama = 1.4 -+# cp -+cpa = Ra * gama/(gama-1) -+# cv -+cva = cpa/gama -+# pi infinity -+pia = 0.0E0 -+# qv -+qva = 0.0E0 -+# qv' -+qvpa = 0.0E0 -+ -+## FOR PATCHES 1 & 2 ## -+ -+# density -+rho0a1 = (p01 + pia)/((gama-1)*cva*T01) -+rho0a2 = (p02 + pia)/((gama-1)*cva*T02) -+ -+# Speed of sound -+c_a1 = math.sqrt( gama * ( p01 + pia ) / rho0a1 ) -+c_a2 = math.sqrt( gama * ( p02 + pia ) / rho0a2 ) -+ -+## SHOCK RELATIONS -+p02Op01 = p02 / p01 -+ -+# Mach number of the shocked region - this should agree with Min, if everything is correct -+Ms = math.sqrt( ( gama + 1. ) / ( 2. * gama ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) -+ -+# shock speed -+ss = Ms * c_a1 -+ -+### volume fractions for each of the patches ### -+C0 = 0.25 # vapor concentration for IMR -+ -+# water liquid -+awl1 = 1.00E00-2.00E-12 -+awl2 = 1.00E-12 -+# water vapor -+awv1 = 1.00E-12 -+awv2 = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0a2 + 1 ) -+# air -+aa1 = 1.0 - awl1 - awv1 -+aa2 = 1.0 - awl2 - awv2 -+ -+## SIMULATION PARAMETERS -+ -+# CFL -+cfl = 0.50 -+ -+# Bubble Initial Radius -+R0 = 30E-06 -+ -+# number of elements -+Nx0 = 400 -+Nx = 199 -+Ny = 199 -+Nz = 199 -+ -+# domain boundaries -+xb = 0.00 -+xe = 120E-6 -+ -+yb = 0.00 -+ye = 120E-6 -+ -+zb = 0.00 -+ze = 120E-6 -+ -+# typical cell size -+dx = ( xe - xb ) / Nx -+dy = ( ye - yb ) / Ny -+dz = ( ze - zb ) / Nz -+ -+# time step -+ -+# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) -+SF = 200 -+ -+# Critical time-step -+tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) -+ -+# making Nt divisible by SF -+# tendA = 1.5 * tc -+tend = 1.2 * tc -+ -+# 1 - ensure NtA is sufficient to go a little beyond tendA -+# NtA = int( tendA // dt + 1 ) -+ -+# Array of saves. it is the same as Nt/Sf = t_step_save -+# AS = int( NtA // SF + 1 ) -+ -+# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) -+# Nt = AS * SF -+Nt = int(18E3 * tend // tc * Nx / Nx0 + 1) -+ -+dt = tend / Nt -+ -+AS = int( Nt//SF ) -+ -+# Total physical time -+# tend = Nt * dt -+ -+# Configuring case dictionary ================================================== -+print(json.dumps({ -+ # Logistics ================================================ -+ 'run_time_info': 'T', -+ # ========================================================== -+ # Computational Domain Parameters ========================== -+ 'x_domain%beg' : xb, -+ 'x_domain%end' : xe, -+ 'y_domain%beg' : yb, -+ 'y_domain%end' : ye, -+ 'z_domain%beg' : zb, -+ 'z_domain%end' : ze, -+ 'stretch_x' : 'T', -+ 'loops_x' : 3, -+ 'a_x' : 4.0E0, -+ 'x_a' : -2.0*R0, -+ 'x_b' : 2.0*R0, -+ 'stretch_y' : 'T', -+ 'loops_y' : 3, -+ 'a_y' : 4.0E0, -+ 'y_a' : -2.0*R0, -+ 'y_b' : 2.0*R0, -+ 'stretch_z' : 'T', -+ 'loops_z' : 3, -+ 'a_z' : 4.0E0, -+ 'z_a' : -2.0*R0, -+ 'z_b' : 2.0*R0, -+ 'cyl_coord' : 'F', -+ 'm' : Nx, -+ 'n' : Ny, -+ 'p' : Nz, -+ 'dt' : dt, -+ 't_step_start' : 0, -+ 't_step_stop' : Nt, -+ 't_step_save' : AS, -+ # ========================================================== -+ # Simulation Algorithm Parameters ========================== -+ 'num_patches' : 2, -+ 'model_eqns' : 3, -+ 'num_fluids' : 3, -+ 'adv_alphan' : 'T', -+ 'mpp_lim' : 'T', -+ 'mixture_err' : 'T', -+ 'relax' : 'T', -+ 'relax_model' : 6, -+ 'palpha_eps' : 1.0E-6, -+ 'ptgalpha_eps' : 1.0E-2, -+ 'time_stepper' : 3, -+ 'weno_order' : 3, -+ 'weno_eps' : 1.0E-32, -+ 'weno_Re_flux' : 'F', -+ 'weno_avg' : 'F', -+ 'mapped_weno' : 'T', -+ 'null_weights' : 'F', -+ 'mp_weno' : 'F', -+ 'riemann_solver' : 2, -+ 'wave_speeds' : 1, -+ 'avg_state' : 2, -+ 'bc_x%beg' : -2, -+ 'bc_x%end' : -6, -+ 'bc_y%beg' : -2, -+ 'bc_y%end' : -6, -+ 'bc_z%beg' : -2, -+ 'bc_z%end' : -6, -+ # ========================================================== -+ # Formatted Database Files Structure Parameters ============ -+ 'format' : 1, -+ 'precision' : 2, -+ 'prim_vars_wrt':'T', -+ 'parallel_io' :'T', -+ # ========================================================== -+ # Patch 1: High pressured water ============================ -+ # Specify the cubic water background grid geometry -+ 'patch_icpp(1)%geometry' : 9, -+ 'patch_icpp(1)%x_centroid' : ( xe + xb ) * 500000 / 100, -+ 'patch_icpp(1)%y_centroid' : ( ye + yb ) * 500000 / 100, -+ 'patch_icpp(1)%z_centroid' : ( ze + zb ) * 500000 / 100, -+ 'patch_icpp(1)%length_x' : ( xe - xb ) * 1000000 / 100, -+ 'patch_icpp(1)%length_y' : ( ye - yb ) * 1000000 / 100, -+ 'patch_icpp(1)%length_z' : ( ze - zb ) * 1000000 / 100, -+ 'patch_icpp(1)%vel(1)' : 0.0E+00, -+ 'patch_icpp(1)%vel(2)' : 0.0E+00, -+ 'patch_icpp(1)%vel(3)' : 0.0E+00, -+ 'patch_icpp(1)%pres' : p01, -+ 'patch_icpp(1)%alpha_rho(1)' : awl1 * rho0wl1, -+ 'patch_icpp(1)%alpha_rho(2)' : awv1 * rho0wv1, -+ 'patch_icpp(1)%alpha_rho(3)' : aa1 * rho0a1, -+ 'patch_icpp(1)%alpha(1)' : awl1, -+ 'patch_icpp(1)%alpha(2)' : awv1, -+ 'patch_icpp(1)%alpha(3)' : aa1, -+ # ========================================================== -+ # Patch 2: (Vapor) Bubble ================================== -+ 'patch_icpp(2)%geometry' : 8, -+ 'patch_icpp(2)%x_centroid' : xb, -+ 'patch_icpp(2)%y_centroid' : yb, -+ 'patch_icpp(2)%z_centroid' : zb, -+ 'patch_icpp(2)%radius' : R0, -+ 'patch_icpp(2)%vel(1)' : 0.0E+00, -+ 'patch_icpp(2)%vel(2)' : 0.0E+00, -+ 'patch_icpp(2)%vel(3)' : 0.0E+00, -+ 'patch_icpp(2)%pres' : p02, -+ 'patch_icpp(2)%alpha_rho(1)' : awl2 * rho0wl2, -+ 'patch_icpp(2)%alpha_rho(2)' : awv2 * rho0wv2, -+ 'patch_icpp(2)%alpha_rho(3)' : aa2 * rho0a2, -+ 'patch_icpp(2)%alpha(1)' : awl2, -+ 'patch_icpp(2)%alpha(2)' : awv2, -+ 'patch_icpp(2)%alpha(3)' : aa2, -+ 'patch_icpp(2)%alter_patch(1)' : 'T', -+ # ========================================================== -+ # Fluids Physical Parameters =============================== -+ 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), -+ 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), -+ 'fluid_pp(1)%cv' : cvwl, -+ 'fluid_pp(1)%qv' : qvwl, -+ 'fluid_pp(1)%qvp' : qvpwl, -+ 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), -+ 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), -+ 'fluid_pp(2)%cv' : cvwv, -+ 'fluid_pp(2)%qv' : qvwv, -+ 'fluid_pp(2)%qvp' : qvpwv, -+ 'fluid_pp(3)%gamma' : 1.0E+00 / ( gama - 1 ), -+ 'fluid_pp(3)%pi_inf' : gama * pia / ( gama - 1 ), -+ 'fluid_pp(3)%cv' : cva, -+ 'fluid_pp(3)%qv' : qva, -+ 'fluid_pp(3)%qvp' : qvpa, -+ # ========================================================== -+})) -diff --git a/run_mfc.sh b/run_mfc.sh -new file mode 100755 -index 00000000..fc734bea ---- /dev/null -+++ b/run_mfc.sh -@@ -0,0 +1,14 @@ -+#!/bin/bash -+ -+./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar -+ -+./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar -+ -+./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -+./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar -+ -diff --git a/src/common/include/inline_conversions.fpp b/src/common/include/inline_conversions.fpp -index a63af61e..c2f0263e 100644 ---- a/src/common/include/inline_conversions.fpp -+++ b/src/common/include/inline_conversions.fpp -@@ -1,17 +1,17 @@ - #:def s_compute_speed_of_sound() -- subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c) -+ subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c, G) - #ifdef CRAY_ACC_WAR - !DIR$ INLINEALWAYS s_compute_speed_of_sound - #else - !$acc routine seq - #endif -- real(kind(0d0)), intent(in) :: pres -- real(kind(0d0)), intent(in) :: rho, gamma, pi_inf -- real(kind(0d0)), intent(in) :: H -- real(kind(0d0)), dimension(num_fluids), intent(in) :: adv -- real(kind(0d0)), intent(in) :: vel_sum -- real(kind(0d0)), intent(out) :: c -- -+ real(kind(0d0)), intent(IN) :: pres -+ real(kind(0d0)), intent(IN) :: rho, gamma, pi_inf -+ real(kind(0d0)), intent(IN) :: H -+ real(kind(0d0)), dimension(num_fluids), intent(IN) :: adv -+ real(kind(0d0)), intent(IN) :: vel_sum -+ real(kind(0d0)), optional, dimension(num_fluids), intent(IN) :: G -+ real(kind(0d0)), intent(OUT) :: c - real(kind(0d0)) :: blkmod1, blkmod2 - - integer :: q -@@ -22,6 +22,7 @@ - blkmod2 = ((gammas(2) + 1d0)*pres + & - pi_infs(2))/gammas(2) - c = (1d0/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2))) -+ - elseif (model_eqns == 3) then - c = 0d0 - !$acc loop seq -@@ -43,6 +44,7 @@ - (pres + pi_inf/(gamma + 1d0))/ & - (rho*(1d0 - adv(num_fluids))) - end if -+ - else - c = ((H - 5d-1*vel_sum)/gamma) - end if -diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp -index 2a15083c..386a844c 100644 ---- a/src/common/m_checker_common.fpp -+++ b/src/common/m_checker_common.fpp -@@ -38,6 +38,7 @@ contains - call s_check_inputs_qbmm_and_polydisperse - if (adv_n) call s_check_inputs_adv_n - if (hypoelasticity) call s_check_inputs_hypoelasticity -+ if (hyperelasticity) call s_check_inputs_hyperelasticity - call s_check_inputs_phase_change - call s_check_inputs_ibm - #endif -@@ -173,12 +174,27 @@ contains - !> Checks constraints on the hypoelasticity parameters. - !! Called by s_check_inputs_common for pre-processing and simulation - subroutine s_check_inputs_hypoelasticity -- if (model_eqns /= 2) then -- call s_mpi_abort('hypoelasticity requires 5-equation model'// & -- '(model_eqns = 2). Exiting ...') -+ !if ((model_eqns /= 2) .or. (model_eqns /= 3)) then -+ if ((model_eqns == 1) .or. (model_eqns == 4)) then -+ call s_mpi_abort('hypoelasticity requires either '// & -+ '5-equation (model_eqns = 2) or '// & -+ '6-equation model (model_eqns = 3). Exiting ...') -+ end if -+ if (hyperelasticity) then -+ call s_mpi_abort('hyperelasticity cannot be true with hypoelasticity. '// & -+ 'Exiting ...') - end if - end subroutine s_check_inputs_hypoelasticity - -+ !> Checks constraints on the hyperelasticity parameters. -+ !! Called by s_check_inputs_common for pre-processing and simulation -+ subroutine s_check_inputs_hyperelasticity -+ if (model_eqns /= 3) then -+ call s_mpi_abort('hyperelasticity requires '// & -+ '6-equation model (model_eqns = 3). Exiting ...') -+ end if -+ end subroutine s_check_inputs_hyperelasticity -+ - !> Checks constraints on the phase change parameters. - !! Called by s_check_inputs_common for pre-processing and simulation - subroutine s_check_inputs_phase_change -diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp -index a506acb9..6f9ab2ff 100644 ---- a/src/common/m_constants.fpp -+++ b/src/common/m_constants.fpp -@@ -7,18 +7,18 @@ module m_constants - character, parameter :: dflt_char = ' ' !< Default string value - - real(kind(0d0)), parameter :: dflt_real = -1d6 !< Default real value -- real(kind(0d0)), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance -- real(kind(0d0)), parameter :: small_alf = 1d-11 !< Small alf tolerance -- real(kind(0d0)), parameter :: pi = 3.141592653589793d0 !< Pi -+ real(kind(0d0)), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance -+ real(kind(0d0)), parameter :: small_alf = 1d-11 !< Small alf tolerance -+ real(kind(0d0)), parameter :: pi = 3.141592653589793d0 !< Pi - real(kind(0d0)), parameter :: verysmall = 1.d-12 !< Very small number - -- integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils -- integer, parameter :: path_len = 400 !< Maximum path length -- integer, parameter :: name_len = 50 !< Maximum name length -- integer, parameter :: dflt_int = -100 !< Default integer value -- integer, parameter :: fourier_rings = 5 !< Fourier filter ring limit -- integer, parameter :: num_fluids_max = 10 !< Maximum number of fluids in the simulation -- integer, parameter :: num_probes_max = 10 !< Maximum number of flow probes in the simulation -+ integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils -+ integer, parameter :: path_len = 400 !< Maximum path length -+ integer, parameter :: name_len = 50 !< Maximum name length -+ integer, parameter :: dflt_int = -100 !< Default integer value -+ integer, parameter :: fourier_rings = 5 !< Fourier filter ring limit -+ integer, parameter :: num_fluids_max = 10 !< Maximum number of fluids in the simulation -+ integer, parameter :: num_probes_max = 10 !< Maximum number of flow probes in the simulation - integer, parameter :: num_patches_max = 10 - integer, parameter :: pathlen_max = 400 - integer, parameter :: nnode = 4 !< Number of QBMM nodes -diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp -index 9ad172cc..cea5f90d 100644 ---- a/src/common/m_derived_types.fpp -+++ b/src/common/m_derived_types.fpp -@@ -142,7 +142,13 @@ module m_derived_types - type(ic_model_parameters) :: model !< Model parameters - - real(kind(0d0)) :: epsilon, beta !< -- !! The spherical harmonics eccentricity parameters. -+ !! The isentropic vortex parameters administrating, respectively, both -+ !! the amplitude of the disturbance as well as its domain of influence. -+ -+ real(kind(0d0)) :: a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 !< -+ !! The parameters needed for the spherical harmonic patch -+ -+ logical :: non_axis_sym - - real(kind(0d0)), dimension(3) :: normal !< - !! Normal vector indicating the orientation of the patch. It is specified -diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp -index b6d48729..a2b77082 100644 ---- a/src/common/m_helper.fpp -+++ b/src/common/m_helper.fpp -@@ -73,8 +73,8 @@ contains - lE = q - end if - -- if (allocated(fd_coeff_s)) deallocate (fd_coeff_s) -- allocate (fd_coeff_s(-fd_number_in:fd_number_in, lb:lE)) -+ if (allocated(fd_coeff_s)) deallocate(fd_coeff_s) -+ allocate(fd_coeff_s(-fd_number_in:fd_number_in, lb:lE)) - - ! Computing the 1st order finite-difference coefficients - if (fd_order_in == 1) then -@@ -83,7 +83,6 @@ contains - fd_coeff_s(0, i) = -1d0/(s_cc(i + 1) - s_cc(i)) - fd_coeff_s(1, i) = -fd_coeff_s(0, i) - end do -- - ! Computing the 2nd order finite-difference coefficients - elseif (fd_order_in == 2) then - do i = lB, lE -@@ -91,7 +90,6 @@ contains - fd_coeff_s(0, i) = 0d0 - fd_coeff_s(1, i) = -fd_coeff_s(-1, i) - end do -- - ! Computing the 4th order finite-difference coefficients - else - do i = lB, lE -@@ -101,7 +99,6 @@ contains - fd_coeff_s(1, i) = -fd_coeff_s(-1, i) - fd_coeff_s(2, i) = -fd_coeff_s(-2, i) - end do -- - end if - - end subroutine s_compute_finite_difference_coefficients -diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp -index f6372322..c13fa233 100644 ---- a/src/common/m_phase_change.fpp -+++ b/src/common/m_phase_change.fpp -@@ -1,11 +1,3 @@ --!> --!! @file m_phase_change.fpp --!! @brief Contains module m_phasechange -- --#:include 'macros.fpp' -- --!> @brief This module is used to relax the model equations (6-eqn model) --!> towards pressure and temperature (6-eqn to 4-eqn), and (if wanted) Gibbs free - !> energies (6-eqn to 4-eqn) equilibrium through an infinitely fast (algebraic) - !> procedure. - module m_phase_change -@@ -356,8 +348,9 @@ contains - - ! Newton Solver for the pT-equilibrium - ns = 0 -- ! change this relative error metric. 1E4 is just arbitrary -- do while ((DABS(pS - pO) > palpha_eps) .and. (DABS((pS - pO)/pO) > palpha_eps/1e4) .or. (ns == 0)) -+ ! change this relative error metric. 1E4 is arbitrary -+ do while ((DABS(pS - pO) > palpha_eps) .and. & -+ (DABS((pS - pO)/pO) > palpha_eps/1d4) .or. (ns == 0)) - - ! increasing counter - ns = ns + 1 -diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp -index 46436cb8..5652470a 100644 ---- a/src/common/m_variables_conversion.fpp -+++ b/src/common/m_variables_conversion.fpp -@@ -22,6 +22,7 @@ module m_variables_conversion - use m_helper_basic !< Functions to compare floating point numbers - - use m_helper -+ - ! ========================================================================== - - implicit none -@@ -145,8 +146,8 @@ contains - else - pres = (pref + pi_inf)* & - (energy/ & -- (rhoref*(1 - alf)) & -- )**(1/gamma + 1) - pi_inf -+ (rhoref*(1.d0 - alf)) & -+ )**(1.d0/gamma + 1.d0) - pi_inf - end if - - if (hypoelasticity .and. present(G)) then -@@ -164,11 +165,7 @@ contains - end if - end do - -- pres = ( & -- energy - & -- 0.5d0*(mom**2.d0)/rho - & -- pi_inf - qv - E_e & -- )/gamma -+ pres = (energy - 0.5d0*(mom**2.d0)/rho - pi_inf - qv - E_e)/gamma - - end if - -@@ -409,7 +406,6 @@ contains - pi_inf = pi_inf + alpha_K(i)*pi_infs(i) - qv = qv + alpha_rho_K(i)*qvs(i) - end do -- - #ifdef MFC_SIMULATION - ! Computing the shear and bulk Reynolds numbers from species analogs - do i = 1, 2 -@@ -427,6 +423,7 @@ contains - #endif - - if (present(G_K)) then -+ !TODO Check our mixture rule? Replace with Cauchy numbers, make code nondimensional - G_K = 0d0 - do i = 1, num_fluids - G_K = G_K + alpha_K(i)*G(i) -@@ -502,6 +499,7 @@ contains - G_K = 0d0 - do i = 1, num_fluids - !TODO: change to use Gs directly here? -+ !TODO: Make this changes as well for GPUs - G_K = G_K + alpha_K(i)*G(i) - end do - G_K = max(0d0, G_K) -@@ -679,7 +677,6 @@ contains - do i = 1, nb - bubrs(i) = bub_idx%rs(i) - end do -- - !$acc update device(bubrs) - end if - -@@ -862,7 +859,7 @@ contains - - integer :: i, j, k, l, q !< Generic loop iterators - -- real(kind(0.d0)) :: ntmp -+ real(kind(0d0)) :: ntmp - - #:if MFC_CASE_OPTIMIZATION - #ifndef MFC_SIMULATION -@@ -880,7 +877,7 @@ contains - end if - #:endif - -- !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp) -+ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, R3tmp, G_K) - do l = izb, ize - do k = iyb, iye - do j = ixb, ixe -@@ -900,7 +897,7 @@ contains - if (model_eqns /= 4) then - #ifdef MFC_SIMULATION - ! If in simulation, use acc mixture subroutines -- if (hypoelasticity) then -+ if (elasticity) then - call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & - alpha_rho_K, Re_K, j, k, l, G_K, Gs) - else if (bubbles) then -@@ -912,7 +909,7 @@ contains - end if - #else - ! If pre-processing, use non acc mixture subroutines -- if (hypoelasticity) then -+ if (elasticity) then - call s_convert_to_mixture_variables(qK_cons_vf, j, k, l, & - rho_K, gamma_K, pi_inf_K, qv_K, Re_K, G_K, fluid_pp(:)%G) - else -@@ -988,7 +985,7 @@ contains - qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & - /rho_K - ! subtracting elastic contribution for pressure calculation -- if (G_K > 1000) then !TODO: check if stable for >0 -+ if (G_K .gt. verysmall) then !TODO: check if stable for >0 - qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K - ! extra terms in 2 and 3D -@@ -1002,6 +999,17 @@ contains - end do - end if - -+ if (hyperelasticity) then -+ !$acc loop seq -+ do i = strxb, strxe -+ qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K -+ end do -+ !$acc loop seq -+ do i = xibeg, xiend -+ qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K -+ end do -+ end if -+ - !$acc loop seq - do i = advxb, advxe - qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) -@@ -1016,7 +1024,9 @@ contains - end do - !$acc end parallel loop - -- end subroutine s_convert_conservative_to_primitive_variables -+ !print *, 'I got here AA' -+ -+ end subroutine s_convert_conservative_to_primitive_variables ! --------- - - !> The following procedure handles the conversion between - !! the primitive variables and the conservative variables. -@@ -1029,13 +1039,8 @@ contains - subroutine s_convert_primitive_to_conservative_variables(q_prim_vf, & - q_cons_vf) - -- type(scalar_field), & -- dimension(sys_size), & -- intent(in) :: q_prim_vf -- -- type(scalar_field), & -- dimension(sys_size), & -- intent(inout) :: q_cons_vf -+ type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf -+ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf - - ! Density, specific heat ratio function, liquid stiffness function - ! and dynamic pressure, as defined in the incompressible flow sense, -@@ -1144,10 +1149,10 @@ contains - end if - - if (hypoelasticity) then -- do i = stress_idx%beg, stress_idx%end -+ do i = strxb, strxe - q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) - ! adding elastic contribution -- if (G > 1000) then -+ if (G .gt. verysmall) then - q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) - ! extra terms in 2 and 3D -@@ -1161,6 +1166,19 @@ contains - end do - end if - -+ ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 -+ if (hyperelasticity) then -+ ! adding the elastic contribution -+ ! Multiply \tau to \rho \tau -+ do i = strxb, strxe -+ q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) -+ end do -+ ! Multiply \xi to \rho \xi -+ do i = xibeg, xiend -+ q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) -+ end do -+ end if -+ - if (.not. f_is_default(sigma)) then - q_cons_vf(c_idx)%sf(j, k, l) = q_prim_vf(c_idx)%sf(j, k, l) - end if -@@ -1168,7 +1186,6 @@ contains - end do - end do - end do -- - #else - if (proc_rank == 0) then - call s_mpi_abort('Conversion from primitive to '// & -@@ -1176,7 +1193,6 @@ contains - 'implemented. Exiting ...') - end if - #endif -- - end subroutine s_convert_primitive_to_conservative_variables - - !> The following subroutine handles the conversion between -@@ -1252,7 +1268,7 @@ contains - end do - - pres_K = qK_prim_vf(j, k, l, E_idx) -- if (hypoelasticity) then -+ if (elasticity) then - call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, & - alpha_K, alpha_rho_K, Re_K, & - j, k, l, G_K, Gs) -@@ -1310,10 +1326,11 @@ contains - end do - end do - #endif -- - end subroutine s_convert_primitive_to_flux_variables - -- subroutine s_finalize_variables_conversion_module -+ subroutine s_finalize_variables_conversion_module() ! ------------------ -+ -+ integer :: i !< Generic loop iterators - - ! Deallocating the density, the specific heat ratio function and the - ! liquid stiffness function -diff --git a/src/post_process/m_data_input.f90 b/src/post_process/m_data_input.f90 -index 567816f7..bbd063df 100644 ---- a/src/post_process/m_data_input.f90 -+++ b/src/post_process/m_data_input.f90 -@@ -370,7 +370,7 @@ contains - NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) - - ! Read the data for each variable -- if (bubbles .or. hypoelasticity) then -+ if (bubbles .or. elasticity) then - do i = 1, sys_size - var_MOK = int(i, MPI_OFFSET_KIND) - -@@ -444,7 +444,7 @@ contains - NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) - - ! Read the data for each variable -- if (bubbles .or. hypoelasticity) then -+ if (bubbles .or. elasticity) then - do i = 1, sys_size - var_MOK = int(i, MPI_OFFSET_KIND) - -diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp -index 7aa7e873..e68c021b 100644 ---- a/src/post_process/m_data_output.fpp -+++ b/src/post_process/m_data_output.fpp -@@ -16,6 +16,8 @@ module m_data_output - - use m_global_parameters ! Global parameters for the code - -+ use m_derived_variables !< Procedures used to compute quantities derived -+ - use m_mpi_proxy ! Message passing interface (MPI) module proxy - - use m_compile_specific -@@ -27,9 +29,15 @@ module m_data_output - - private; public :: s_initialize_data_output_module, & - s_open_formatted_database_file, & -+ s_open_intf_data_file, & -+ s_open_energy_data_file, & - s_write_grid_to_formatted_database_file, & - s_write_variable_to_formatted_database_file, & -+ s_write_intf_data_file, & -+ s_write_energy_data_file, & - s_close_formatted_database_file, & -+ s_close_intf_data_file, & -+ s_close_energy_data_file, & - s_finalize_data_output_module - - ! Including the Silo Fortran interface library that features the subroutines -@@ -531,7 +539,40 @@ contains - - end subroutine s_open_formatted_database_file - -- subroutine s_write_grid_to_formatted_database_file(t_step) -+ subroutine s_open_intf_data_file() ! ------------------------ -+ -+ character(LEN=path_len + 3*name_len) :: file_path !< -+ !! Relative path to a file in the case directory -+ -+ write (file_path, '(A)') '/intf_data.dat' -+ file_path = trim(case_dir)//trim(file_path) -+ -+ ! Opening the simulation data file -+ open (211, FILE=trim(file_path), & -+ FORM='formatted', & -+ POSITION='append', & -+ STATUS='unknown') -+ -+ end subroutine s_open_intf_data_file ! --------------------------------------- -+ -+ subroutine s_open_energy_data_file() ! ------------------------ -+ -+ character(LEN=path_len + 3*name_len) :: file_path !< -+ !! Relative path to a file in the case directory -+ -+ write (file_path, '(A)') '/eng_data.dat' -+ file_path = trim(case_dir)//trim(file_path) -+ -+ ! Opening the simulation data file -+ open (251, FILE=trim(file_path), & -+ FORM='formatted', & -+ POSITION='append', & -+ STATUS='unknown') -+ -+ end subroutine s_open_energy_data_file ! ---------------------------------------- -+ -+ subroutine s_write_grid_to_formatted_database_file(t_step) ! ----------- -+ - ! Description: The general objective of this subroutine is to write the - ! necessary grid data to the formatted database file, for - ! the current time-step, t_step. The local processor will -@@ -939,7 +980,196 @@ contains - - end subroutine s_write_variable_to_formatted_database_file - -- subroutine s_close_formatted_database_file -+ subroutine s_write_intf_data_file(q_prim_vf) -+ -+ type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf -+ integer :: i, j, k, l, w, cent !< Generic loop iterators -+ integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations -+ real(kind(0d0)), dimension(num_fluids) :: alpha, vol_fluid, xcom, ycom, zcom -+ real(kind=8), parameter :: pi = 4.d0*datan(1.d0) -+ real(kind(0d0)), allocatable :: x_td(:), y_td(:), x_d1(:), y_d1(:), y_d(:), x_d(:) -+ real(kind(0d0)) :: axp, axm, ayp, aym, azm, azp, tgp, euc_d, thres, maxalph_loc, maxalph_glb -+ -+ allocate (x_d1(m*n)) -+ allocate (y_d1(m*n)) -+ counter = 0 -+ maxalph_loc = 0d0 -+ do k = 0, p -+ do j = 0, n -+ do i = 0, m -+ if (q_prim_vf(E_idx + 2)%sf(i, j, k) > maxalph_loc) then -+ maxalph_loc = q_prim_vf(E_idx + 2)%sf(i, j, k) -+ end if -+ end do -+ end do -+ end do -+ -+ call s_mpi_allreduce_max(maxalph_loc, maxalph_glb) -+ if (p > 0) then -+ do l = 0, p -+ if (z_cc(l) < dz(l) .and. z_cc(l) > 0) then -+ cent = l -+ end if -+ end do -+ else -+ cent = 0 -+ end if -+ -+ thres = 0.9d0*maxalph_glb -+ do k = 0, n -+ OLoop: do j = 0, m -+ axp = q_prim_vf(E_idx + 2)%sf(j + 1, k, cent) -+ axm = q_prim_vf(E_idx + 2)%sf(j, k, cent) -+ ayp = q_prim_vf(E_idx + 2)%sf(j, k + 1, cent) -+ aym = q_prim_vf(E_idx + 2)%sf(j, k, cent) -+ if ((axp > thres .and. axm < thres) .or. (axp < thres .and. axm > thres) & -+ .or. (ayp > thres .and. aym < thres) .or. (ayp < thres .and. aym > thres)) then -+ if (counter == 0) then -+ counter = counter + 1 -+ x_d1(counter) = x_cc(j) -+ y_d1(counter) = y_cc(k) -+ euc_d = sqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2) -+ tgp = sqrt(dx(j)**2 + dy(k)**2) -+ else -+ euc_d = dsqrt((x_cc(j) - x_d1(i))**2 + (y_cc(k) - y_d1(i))**2) -+ tgp = dsqrt(dx(j)**2 + dy(k)**2) -+ do i = 1, counter -+ if (euc_d < tgp) then -+ cycle OLoop -+ elseif (euc_d > tgp .and. i == counter) then -+ counter = counter + 1 -+ x_d1(counter) = x_cc(j) -+ y_d1(counter) = y_cc(k) -+ -+ end if -+ end do -+ end if -+ end if -+ end do OLoop -+ end do -+ -+ allocate (y_d(counter)) -+ allocate (x_d(counter)) -+ do i = 1, counter -+ y_d(i) = y_d1(i) -+ x_d(i) = x_d1(i) -+ end do -+ root = 0 -+ -+ call s_mpi_gather_data(x_d, counter, x_td, root) -+ call s_mpi_gather_data(y_d, counter, y_td, root) -+ if (proc_rank == 0) then -+ do i = 1, size(x_td) -+ if (i == size(x_td)) then -+ write (211, '(F12.9,1X,F12.9,1X,I4)') & -+ x_td(i), y_td(i), size(x_td) -+ else -+ write (211, '(F12.9,1X,F12.9,1X,F3.1)') & -+ x_td(i), y_td(i), 0d0 -+ end if -+ end do -+ end if -+ -+ end subroutine s_write_intf_data_file ! ----------------------------------- -+ -+ subroutine s_write_energy_data_file(q_prim_vf, q_cons_vf) -+ type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf, q_cons_vf -+ real(kind(0d0)) :: Elk, Egk, Elp, Egint, Vb, Vl, pres_av, Et -+ real(kind(0d0)) :: rho, pres, dV, tmp, gamma, pi_inf, MaxMa, MaxMa_glb, maxvel, c, Ma, H -+ real(kind(0d0)), dimension(num_dims) :: vel -+ real(kind(0d0)), dimension(num_fluids) :: gammas, pi_infs, adv -+ integer :: i, j, k, l, s !looping indicies -+ integer :: ierr, counter, root !< number of data points extracted to fit shape to SH perturbations -+ -+ Egk = 0d0 -+ Elp = 0d0 -+ Egint = 0d0 -+ Vb = 0d0 -+ maxvel = 0d0 -+ MaxMa = 0d0 -+ Vl = 0d0 -+ Elk = 0d0 -+ Et = 0d0 -+ Vb = 0d0 -+ dV = 0d0 -+ pres_av = 0d0 -+ pres = 0d0 -+ do k = 0, p -+ do j = 0, n -+ do i = 0, m -+ pres = 0d0 -+ dV = dx(i)*dy(j)*dz(k) -+ rho = 0d0 -+ gamma = 0d0 -+ pi_inf = 0d0 -+ pres = q_prim_vf(E_idx)%sf(i, j, k) -+ Egint = Egint + q_prim_vf(E_idx + 2)%sf(i, j, k)*(fluid_pp(2)%gamma*pres)*dV -+ do s = 1, num_dims -+ vel(s) = q_prim_vf(num_fluids + s)%sf(i, j, k) -+ Egk = Egk + 0.5d0*q_prim_vf(E_idx + 2)%sf(i, j, k)*q_prim_vf(2)%sf(i, j, k)*vel(s)*vel(s)*dV -+ Elk = Elk + 0.5d0*q_prim_vf(E_idx + 1)%sf(i, j, k)*q_prim_vf(1)%sf(i, j, k)*vel(s)*vel(s)*dV -+ if (dabs(vel(s)) > maxvel) then -+ maxvel = dabs(vel(s)) -+ end if -+ end do -+ do l = 1, adv_idx%end - E_idx -+ adv(l) = q_prim_vf(E_idx + l)%sf(i, j, k) -+ gamma = gamma + adv(l)*fluid_pp(l)%gamma -+ pi_inf = pi_inf + adv(l)*fluid_pp(l)%pi_inf -+ rho = rho + adv(l)*q_prim_vf(l)%sf(i, j, k) -+ end do -+ -+ H = ((gamma + 1d0)*pres + pi_inf)/rho -+ -+ call s_compute_speed_of_sound(pres, rho, & -+ gamma, pi_inf, & -+ H, adv, 0d0, c) -+ -+ Ma = maxvel/c -+ if (Ma > MaxMa .and. adv(1) > 1.0d0 - 1.0d-10) then -+ MaxMa = Ma -+ end if -+ Vl = Vl + adv(1)*dV -+ Vb = Vb + adv(2)*dV -+ pres_av = pres_av + adv(1)*pres*dV -+ Et = Et + q_cons_vf(E_idx)%sf(i, j, k)*dV -+ end do -+ end do -+ end do -+ -+ tmp = pres_av -+ call s_mpi_allreduce_sum(tmp, pres_av) -+ tmp = Vl -+ call s_mpi_allreduce_sum(tmp, Vl) -+ -+ call s_mpi_allreduce_max(MaxMa, MaxMa_glb) -+ tmp = Elk -+ call s_mpi_allreduce_sum(tmp, Elk) -+ tmp = Egint -+ call s_mpi_allreduce_sum(tmp, Egint) -+ tmp = Egk -+ call s_mpi_allreduce_sum(tmp, Egk) -+ tmp = Vb -+ call s_mpi_allreduce_sum(tmp, Vb) -+ tmp = Et -+ call s_mpi_allreduce_sum(tmp, Et) -+ -+ Elp = pres_av/Vl*Vb -+ if (proc_rank == 0) then -+ write (251, '(10X, 8F24.8)') & -+ Elp, & -+ Egint, & -+ Elk, & -+ Egk, & -+ Et, & -+ Vb, & -+ Vl, & -+ MaxMa_glb -+ end if -+ -+ end subroutine s_write_energy_data_file -+ -+ subroutine s_close_formatted_database_file() ! ------------------------- - ! Description: The purpose of this subroutine is to close any formatted - ! database file(s) that may be opened at the time-step that - ! is currently being post-processed. The root process must -@@ -966,7 +1196,19 @@ contains - - end subroutine s_close_formatted_database_file - -- subroutine s_finalize_data_output_module -+ subroutine s_close_intf_data_file() ! ----------------------- -+ -+ close (211) -+ -+ end subroutine s_close_intf_data_file !--------------------- -+ -+ subroutine s_close_energy_data_file() ! ----------------------- -+ -+ close (251) -+ -+ end subroutine s_close_energy_data_file !--------------------- -+ -+ subroutine s_finalize_data_output_module() ! ------------------------- - ! Description: Deallocation procedures for the module - - ! Deallocating the generic storage employed for the flow variable(s) -diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp -index 0e5401f1..fa6941cb 100644 ---- a/src/post_process/m_global_parameters.fpp -+++ b/src/post_process/m_global_parameters.fpp -@@ -94,6 +94,10 @@ module m_global_parameters - logical :: mixture_err !< Mixture error limiter - logical :: alt_soundspeed !< Alternate sound speed - logical :: hypoelasticity !< Turn hypoelasticity on -+ logical :: hyperelasticity !< Turn hyperelasticity on -+ logical :: elasticity !< elasticity modeling, true for hyper or hypo -+ integer :: b_size !< Number of components in the b tensor -+ integer :: tensor_size !< Number of components in the nonsymmetric tensor - !> @} - - !> @name Annotations of the structure, i.e. the organization, of the state vectors -@@ -109,6 +113,7 @@ module m_global_parameters - integer :: alf_idx !< Index of specific heat ratio func. eqn. - integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. - type(int_bounds_info) :: stress_idx !< Indices of elastic stresses -+ type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. - integer :: c_idx !< Index of color function - !> @} - -@@ -118,6 +123,7 @@ module m_global_parameters - !> @} - - logical :: parallel_io !< Format of the data files -+ logical :: sim_data - logical :: file_per_process !< output format - - integer, allocatable, dimension(:) :: proc_coords !< -@@ -255,6 +261,7 @@ module m_global_parameters - integer :: intxb, intxe - integer :: bubxb, bubxe - integer :: strxb, strxe -+ integer :: xibeg, xiend - !> @} - - contains -@@ -286,7 +293,10 @@ contains - alt_soundspeed = .false. - relax = .false. - relax_model = dflt_int -+ - hypoelasticity = .false. -+ hyperelasticity = .false. -+ elasticity = .false. - - bc_x%beg = dflt_int; bc_x%end = dflt_int - bc_y%beg = dflt_int; bc_y%end = dflt_int -@@ -335,6 +345,7 @@ contains - omega_wrt = .false. - qm_wrt = .false. - schlieren_wrt = .false. -+ sim_data = .false. - cf_wrt = .false. - ib = .false. - -@@ -486,12 +497,24 @@ contains - - end if - -- if (hypoelasticity) then -+ if (hypoelasticity .or. hyperelasticity) then -+ elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 -+ ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D - sys_size = stress_idx%end - end if - -+ if (hyperelasticity) then -+ xi_idx%beg = sys_size + 1 -+ xi_idx%end = sys_size + num_dims -+ ! adding three more equations for the \xi field and the elastic energy -+ sys_size = xi_idx%end + 1 -+ ! number of entries in the symmetric btensor plus the jacobian -+ b_size = (num_dims*(num_dims + 1))/2 + 1 -+ tensor_size = num_dims**2 + 1 -+ end if -+ - if (.not. f_is_default(sigma)) then - c_idx = sys_size + 1 - sys_size = c_idx -@@ -517,6 +540,24 @@ contains - sys_size = internalEnergies_idx%end - alf_idx = 1 ! dummy, cannot actually have a void fraction - -+ if (hypoelasticity .or. hyperelasticity) then -+ elasticity = .true. -+ stress_idx%beg = sys_size + 1 -+ stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 -+ ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D -+ sys_size = stress_idx%end -+ end if -+ -+ if (hyperelasticity) then -+ xi_idx%beg = sys_size + 1 -+ xi_idx%end = sys_size + num_dims -+ ! adding three more equations for the \xi field and the elastic energy -+ sys_size = xi_idx%end + 1 -+ ! number of entries in the symmetric btensor plus the jacobian -+ b_size = (num_dims*(num_dims + 1))/2 + 1 -+ tensor_size = num_dims**2 + 1 -+ end if -+ - if (.not. f_is_default(sigma)) then - c_idx = sys_size + 1 - sys_size = c_idx -@@ -590,6 +631,8 @@ contains - strxe = stress_idx%end - intxb = internalEnergies_idx%beg - intxe = internalEnergies_idx%end -+ xibeg = xi_idx%beg -+ xiend = xi_idx%end - ! ================================================================== - - #ifdef MFC_MPI -diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp -index a5dffdb4..5da4c74e 100644 ---- a/src/post_process/m_mpi_proxy.fpp -+++ b/src/post_process/m_mpi_proxy.fpp -@@ -141,6 +141,38 @@ contains - - end subroutine s_initialize_mpi_proxy_module - -+ subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root) -+ -+#ifdef MFC_MPI -+ -+ implicit none -+ integer, intent(in) :: counts ! Array of vector lengths for each process -+ real(kind(0d0)), intent(in), dimension(counts) :: my_vector ! Input vector on each process -+ integer, intent(in) :: root ! Rank of the root process -+ real(kind(0d0)), allocatable, intent(out) :: gathered_vector(:) ! Gathered vector on the root process -+ -+ integer :: i, offset, ierr -+ integer, allocatable :: recounts(:), displs(:) -+ -+ allocate (recounts(num_procs)) -+ -+ call MPI_GATHER(counts, 1, MPI_INTEGER, recounts, 1, MPI_INTEGER, root, & -+ MPI_COMM_WORLD, ierr) -+ -+ allocate (displs(size(recounts))) -+ -+ displs(1) = 0 -+ -+ do i = 2, size(recounts) -+ displs(i) = displs(i - 1) + recounts(i - 1) -+ end do -+ -+ allocate (gathered_vector(sum(recounts))) -+ call MPI_GATHERV(my_vector, counts, MPI_DOUBLE_PRECISION, gathered_vector, recounts, displs, MPI_DOUBLE_PRECISION, & -+ root, MPI_COMM_WORLD, ierr) -+#endif -+ end subroutine s_mpi_gather_data -+ - !> Since only processor with rank 0 is in charge of reading - !! and checking the consistency of the user provided inputs, - !! these are not available to the remaining processors. This -@@ -164,11 +196,11 @@ contains - - #:for VAR in [ 'cyl_coord', 'mpp_lim', 'mixture_err', & - & 'alt_soundspeed', 'hypoelasticity', 'parallel_io', 'rho_wrt', & -- & 'E_wrt', 'pres_wrt', 'gamma_wrt', & -+ & 'E_wrt', 'pres_wrt', 'gamma_wrt', 'sim_data', & - & 'heat_ratio_wrt', 'pi_inf_wrt', 'pres_inf_wrt', 'cons_vars_wrt', & - & 'prim_vars_wrt', 'c_wrt', 'qm_wrt','schlieren_wrt', 'bubbles', 'qbmm', & - & 'polytropic', 'polydisperse', 'file_per_process', 'relax', 'cf_wrt', & -- & 'adv_n', 'ib' ] -+ & 'adv_n', 'ib', 'hyperelasticity' ] - call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) - #:endfor - -diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 -index ed1003ff..60d3d094 100644 ---- a/src/post_process/m_start_up.f90 -+++ b/src/post_process/m_start_up.f90 -@@ -74,7 +74,8 @@ contains - parallel_io, rhoref, pref, bubbles, qbmm, sigR, & - R0ref, nb, polytropic, thermal, Ca, Web, Re_inv, & - polydisperse, poly_sigma, file_per_process, relax, & -- relax_model, cf_wrt, sigma, adv_n, ib -+ relax_model, cf_wrt, sigma, adv_n, ib, sim_data, & -+ hyperelasticity - - ! Inquiring the status of the post_process.inp file - file_loc = 'post_process.inp' -@@ -148,9 +149,9 @@ contains - (t_step_stop - t_step_start)/t_step_save + 1, & - t_step - end if -- - ! Populating the grid and conservative variables - call s_read_data_files(t_step) -+ - ! Populating the buffer regions of the grid variables - if (buff_size > 0) then - call s_populate_grid_variables_buffer_regions() -@@ -163,6 +164,7 @@ contains - - ! Converting the conservative variables to the primitive ones - call s_convert_conservative_to_primitive_variables(q_cons_vf, q_prim_vf) -+ - end subroutine s_perform_time_step - - subroutine s_save_data(t_step, varname, pres, c, H) -@@ -176,6 +178,16 @@ contains - ! Opening a new formatted database file - call s_open_formatted_database_file(t_step) - -+ if (sim_data .and. proc_rank == 0) then -+ call s_open_intf_data_file() -+ call s_open_energy_data_file() -+ end if -+ -+ if (sim_data) then -+ call s_write_intf_data_file(q_prim_vf) -+ call s_write_energy_data_file(q_prim_vf, q_cons_vf) -+ end if -+ - ! Adding the grid to the formatted database file - call s_write_grid_to_formatted_database_file(t_step) - -@@ -304,22 +316,34 @@ contains - - end if - ! ---------------------------------------------------------------------- -- - ! Adding the elastic shear stresses to the formatted database file ----- -- if (hypoelasticity) then -+ if (elasticity) then - do i = 1, stress_idx%end - stress_idx%beg + 1 - if (prim_vars_wrt) then - q_sf = q_prim_vf(i - 1 + stress_idx%beg)%sf( & - -offset_x%beg:m + offset_x%end, & - -offset_y%beg:n + offset_y%end, & - -offset_z%beg:p + offset_z%end) -- - write (varname, '(A,I0)') 'tau', i - call s_write_variable_to_formatted_database_file(varname, t_step) - end if - varname(:) = ' ' - end do - end if -+ if (hyperelasticity) then -+ do i = 1, xiend - xibeg + 1 -+ if (prim_vars_wrt) then -+ q_sf = q_prim_vf(i - 1 + xibeg)%sf( & -+ -offset_x%beg:m + offset_x%end, & -+ -offset_y%beg:n + offset_y%end, & -+ -offset_z%beg:p + offset_z%end) -+ write (varname, '(A,I0)') 'xi', i -+ call s_write_variable_to_formatted_database_file(varname, t_step) -+ end if -+ varname(:) = ' ' -+ end do -+ end if -+ - ! ---------------------------------------------------------------------- - - ! Adding the pressure to the formatted database file ------------------- -@@ -625,8 +649,19 @@ contains - end if - end if - -+! if (proc_rank == 0 .and. sim_data) then -+! close (211) -+! close (251) -+! end if -+ -+ if (sim_data .and. proc_rank == 0) then -+ call s_close_intf_data_file() -+ call s_close_energy_data_file() -+ end if -+ - ! Closing the formatted database file - call s_close_formatted_database_file() -+ - end subroutine s_save_data - - subroutine s_initialize_modules -@@ -682,6 +717,11 @@ contains - ! Disassociate pointers for serial and parallel I/O - s_read_data_files => null() - -+! if (sim_data .and. proc_rank == 0) then -+! call s_close_intf_data_file() -+! call s_close_energy_data_file() -+! end if -+ - ! Deallocation procedures for the modules - call s_finalize_data_output_module() - call s_finalize_derived_variables_module() -diff --git a/src/post_process/p_main.fpp b/src/post_process/p_main.fpp -index c780ce9a..ede32ed7 100644 ---- a/src/post_process/p_main.fpp -+++ b/src/post_process/p_main.fpp -@@ -39,6 +39,7 @@ program p_main - - ! Time-Marching Loop ======================================================= - do -+ - call s_perform_time_step(t_step) - - call s_save_data(t_step, varname, pres, c, H) -diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp -index 7d6ee960..394f560b 100644 ---- a/src/pre_process/include/2dHardcodedIC.fpp -+++ b/src/pre_process/include/2dHardcodedIC.fpp -@@ -2,8 +2,7 @@ - - real(kind(0d0)) :: eps - real(kind(0d0)) :: r, rmax, gam, umax, p0 -- -- real(kind(0d0)) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph -+ real(kind(0d0)) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph - - eps = 1e-9 - -@@ -12,6 +11,7 @@ - #:def Hardcoded2D() - - select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case -+ - case (200) - if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1d0/3d0)) then - ! Volume Fractions -@@ -68,7 +68,7 @@ - - q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(E_idx)%sf(i, j, 0)**(1d0/gam) - -- case (204) ! Rayleigh-Taylor instability -+ case (204) ! Rayleigh-taylor problem - rhoH = 3 - rhoL = 1 - pRef = 1e5 -@@ -100,11 +100,42 @@ - q_prim_vf(E_idx)%sf(i, j, 0) = pInt + rhoL*9.81*(intH - y_cc(j)) - end if - -+ case (205) ! 2D lung wave interaction problem -+ h = 0.0 !non dim origin y -+ lam = 1.0 !non dim lambda -+ amp = patch_icpp(patch_id)%a2 !to be changed later! !non dim amplitude -+ -+ intH = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h -+ -+ if (y_cc(j) > intH) then -+ q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) -+ q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) -+ q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres -+ q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) -+ q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) -+ end if -+ -+ case (206) ! 2D lung wave interaction problem - horizontal domain -+ h = 0.0 !non dim origin y -+ lam = 1.0 !non dim lambda -+ amp = patch_icpp(patch_id)%a2 -+ -+ intL = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h -+ -+ if (x_cc(i) > intL) then !this is the liquid -+ q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1) -+ q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2) -+ q_prim_vf(E_idx)%sf(i, j, 0) = patch_icpp(1)%pres -+ q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1) -+ q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2) -+ end if -+ - case default - if (proc_rank == 0) then - call s_int_to_str(patch_id, iStr) - call s_mpi_abort("Invalid hcid specified for patch "//trim(iStr)) - end if -+ - end select - - #:enddef -diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp -index 3d9a4e2f..4088fcc2 100644 ---- a/src/pre_process/include/3dHardcodedIC.fpp -+++ b/src/pre_process/include/3dHardcodedIC.fpp -@@ -42,7 +42,20 @@ - pInt = pref + rhoH*9.81*(1.2 - intH) - q_prim_vf(E_idx)%sf(i, j, k) = pInt + rhoL*9.81*(intH - y_cc(j)) - end if -- -+ -+ case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|) -+ h = 0.0 -+ lam = 1.0 -+ amp = patch_icpp(patch_id)%a2 -+ intH = amp*ABS((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h) -+ if (x_cc(i) > intH) then -+ q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1) -+ q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2) -+ q_prim_vf(E_idx)%sf(i, j, k) = patch_icpp(1)%pres -+ q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1) -+ q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2) -+ end if -+ - ! Put your variable assignments here - case default - call s_int_to_str(patch_id, iStr) -diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 -index 9ff468a3..4a49c46a 100644 ---- a/src/pre_process/m_assign_variables.f90 -+++ b/src/pre_process/m_assign_variables.f90 -@@ -276,6 +276,8 @@ contains - real(kind(0d0)) :: orig_qv - real(kind(0d0)) :: muR, muV - real(kind(0d0)) :: R3bar -+ real(kind(0d0)) :: rcoord, theta, phi, xi_sph -+ real(kind(0d0)), dimension(3) :: xi_cart - - real(kind(0d0)), dimension(int(E_idx - mom_idx%beg)) :: vel !< velocity - real(kind(0d0)) :: pres !< pressure -@@ -448,7 +450,7 @@ contains - end do - - ! Elastic Shear Stress -- if (hypoelasticity) then -+ if (elasticity) then - do i = 1, (stress_idx%end - stress_idx%beg) + 1 - q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = & - (eta*patch_icpp(patch_id)%tau_e(i) & -@@ -456,6 +458,32 @@ contains - end do - end if - -+ ! Elastic Shear Stress -+ if (hyperelasticity) then -+ -+ if (pre_stress) then ! pre stressed initial condition in spatial domain -+ rcoord = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2)) -+ theta = atan2(y_cc(k), x_cc(j)) -+ phi = atan2(sqrt(x_cc(j)**2 + y_cc(k)**2), z_cc(l)) -+ !spherical coord, assuming Rmax=1 -+ xi_sph = (rcoord**3 - R0ref**3 + 1d0)**(1d0/3d0) -+ xi_cart(1) = xi_sph*sin(phi)*cos(theta) -+ xi_cart(2) = xi_sph*sin(phi)*sin(theta) -+ xi_cart(3) = xi_sph*cos(phi) -+ else -+ xi_cart(1) = x_cc(j) -+ xi_cart(2) = y_cc(k) -+ xi_cart(3) = z_cc(l) -+ end if -+ -+ ! assigning the reference map to the q_prim vector field -+ do i = 1, num_dims -+ q_prim_vf(i + xibeg - 1)%sf(j, k, l) = eta*xi_cart(i) + & -+ (1d0 - eta)*orig_prim_vf(i + xibeg - 1) -+ end do -+ -+ end if -+ - if (mpp_lim .and. bubbles) then - !adjust volume fractions, according to modeled gas void fraction - alf_sum%sf = 0d0 -diff --git a/src/pre_process/m_check_patches.fpp b/src/pre_process/m_check_patches.fpp -index 4579f5bd..bda4418e 100644 ---- a/src/pre_process/m_check_patches.fpp -+++ b/src/pre_process/m_check_patches.fpp -@@ -119,7 +119,8 @@ contains - patch_icpp(i)%geometry == 9 .or. & - patch_icpp(i)%geometry == 10 .or. & - patch_icpp(i)%geometry == 11 .or. & -- patch_icpp(i)%geometry == 12)) then -+ patch_icpp(i)%geometry == 12 .or. & -+ patch_icpp(i)%geometry == 14)) then - call s_check_supported_patch_smoothing(i) - else - call s_check_unsupported_patch_smoothing(i) -diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp -index 94d5d8fb..c0049095 100644 ---- a/src/pre_process/m_data_output.fpp -+++ b/src/pre_process/m_data_output.fpp -@@ -638,6 +638,7 @@ contains - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) - end do -+ - end if - - call MPI_FILE_CLOSE(ifile, ierr) -diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp -index 57dcda37..78e8c293 100644 ---- a/src/pre_process/m_global_parameters.fpp -+++ b/src/pre_process/m_global_parameters.fpp -@@ -20,11 +20,11 @@ module m_global_parameters - implicit none - - ! Logistics ================================================================ -- integer :: num_procs !< Number of processors -- character(LEN=path_len) :: case_dir !< Case folder location -- logical :: old_grid !< Use existing grid data -- logical :: old_ic !< Use existing IC data -- integer :: t_step_old, t_step_start !< Existing IC/grid folder -+ integer :: num_procs !< Number of processors -+ character(LEN=path_len) :: case_dir !< Case folder location -+ logical :: old_grid !< Use existing grid data -+ logical :: old_ic, non_axis_sym !< Use existing IC data -+ integer :: t_step_old, t_step_start !< Existing IC/grid folder - ! ========================================================================== - - ! Computational Domain Parameters ========================================== -@@ -72,16 +72,21 @@ module m_global_parameters - ! ========================================================================== - - ! Simulation Algorithm Parameters ========================================== -- integer :: model_eqns !< Multicomponent flow model -- logical :: relax !< activate phase change -- integer :: relax_model !< Relax Model -- real(kind(0d0)) :: palpha_eps !< trigger parameter for the p relaxation procedure, phase change model -- real(kind(0d0)) :: ptgalpha_eps !< trigger parameter for the pTg relaxation procedure, phase change model -- integer :: num_fluids !< Number of different fluids present in the flow -- logical :: mpp_lim !< Alpha limiter -- integer :: sys_size !< Number of unknowns in the system of equations -- integer :: weno_order !< Order of accuracy for the WENO reconstruction -- logical :: hypoelasticity !< activate hypoelasticity -+ integer :: model_eqns !< Multicomponent flow model -+ logical :: relax !< activate phase change -+ integer :: relax_model !< Relax Model -+ real(kind(0d0)) :: palpha_eps !< trigger parameter for the p relaxation procedure, phase change model -+ real(kind(0d0)) :: ptgalpha_eps !< trigger parameter for the pTg relaxation procedure, phase change model -+ integer :: num_fluids !< Number of different fluids present in the flow -+ logical :: mpp_lim !< Alpha limiter -+ integer :: sys_size !< Number of unknowns in the system of equations -+ integer :: weno_order !< Order of accuracy for the WENO reconstruction -+ logical :: hypoelasticity !< activate hypoelasticity -+ logical :: hyperelasticity !< activate hyperelasticity -+ logical :: elasticity !< elasticity modeling, true for hyper or hypo -+ integer :: b_size !< Number of components in the b tensor -+ integer :: tensor_size !< Number of components in the nonsymmetric tensor -+ logical :: pre_stress !< activate pre_stressed domain - - ! Annotations of the structure, i.e. the organization, of the state vectors - type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. -@@ -95,6 +100,7 @@ module m_global_parameters - integer :: gamma_idx !< Index of specific heat ratio func. eqn. - integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. - type(int_bounds_info) :: stress_idx !< Indexes of elastic shear stress eqns. -+ type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. - integer :: c_idx !< Index of the color function - - type(int_bounds_info) :: bc_x, bc_y, bc_z !< -@@ -216,6 +222,7 @@ module m_global_parameters - integer :: intxb, intxe - integer :: bubxb, bubxe - integer :: strxb, strxe -+ integer :: xibeg, xiend - !> @} - - integer, allocatable, dimension(:, :, :) :: logic_grid -@@ -278,6 +285,9 @@ contains - weno_order = dflt_int - - hypoelasticity = .false. -+ hyperelasticity = .false. -+ elasticity = .false. -+ pre_stress = .false. - - bc_x%beg = dflt_int; bc_x%end = dflt_int - bc_y%beg = dflt_int; bc_y%end = dflt_int -@@ -339,6 +349,18 @@ contains - patch_icpp(i)%qv = 0d0 - patch_icpp(i)%qvp = 0d0 - patch_icpp(i)%tau_e = 0d0 -+ patch_icpp(i)%a2 = dflt_real -+ patch_icpp(i)%a3 = dflt_real -+ patch_icpp(i)%a4 = dflt_real -+ patch_icpp(i)%a5 = dflt_real -+ patch_icpp(i)%a6 = dflt_real -+ patch_icpp(i)%a8 = dflt_real -+ patch_icpp(i)%a9 = dflt_real -+ patch_icpp(i)%a10 = dflt_real -+ patch_icpp(i)%a11 = dflt_real -+ patch_icpp(i)%a12 = dflt_real -+ patch_icpp(i)%non_axis_sym = .false. -+ - !should get all of r0's and v0's - patch_icpp(i)%r0 = dflt_real - patch_icpp(i)%v0 = dflt_real -@@ -574,13 +596,24 @@ contains - end if - end if - -- if (hypoelasticity) then -+ if (hypoelasticity .or. hyperelasticity) then -+ elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D - sys_size = stress_idx%end - end if - -+ if (hyperelasticity) then -+ ! number of entries in the symmetric btensor plus the jacobian -+ b_size = (num_dims*(num_dims + 1))/2 + 1 -+ tensor_size = num_dims**2 + 1 -+ xi_idx%beg = sys_size + 1 -+ xi_idx%end = sys_size + num_dims -+ ! adding three more equations for the \xi field and the elastic energy -+ sys_size = xi_idx%end + 1 -+ end if -+ - if (.not. f_is_default(sigma)) then - c_idx = sys_size + 1 - sys_size = c_idx -@@ -605,6 +638,24 @@ contains - internalEnergies_idx%end = adv_idx%end + num_fluids - sys_size = internalEnergies_idx%end - -+ if (hypoelasticity .or. hyperelasticity) then -+ elasticity = .true. -+ stress_idx%beg = sys_size + 1 -+ stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 -+ ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D -+ sys_size = stress_idx%end -+ end if -+ -+ if (hyperelasticity) then -+ ! number of entries in the symmetric btensor plus the jacobian -+ b_size = (num_dims*(num_dims + 1))/2 + 1 -+ tensor_size = num_dims**2 + 1 -+ xi_idx%beg = sys_size + 1 -+ xi_idx%end = sys_size + num_dims -+ ! adding three more equations for the \xi field and the elastic energy -+ sys_size = xi_idx%end + 1 -+ end if -+ - if (.not. f_is_default(sigma)) then - c_idx = sys_size + 1 - sys_size = c_idx -@@ -681,6 +732,8 @@ contains - strxe = stress_idx%end - intxb = internalEnergies_idx%beg - intxe = internalEnergies_idx%end -+ xibeg = xi_idx%beg -+ xiend = xi_idx%end - - ! ================================================================== - -diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp -index 5d58d46e..869194b5 100644 ---- a/src/pre_process/m_initial_condition.fpp -+++ b/src/pre_process/m_initial_condition.fpp -@@ -238,6 +238,10 @@ contains - elseif (patch_icpp(i)%geometry == 7) then - call s_2D_analytical(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) -+ - ! Spiral patch - elseif (patch_icpp(i)%geometry == 17) then - call s_spiral(i, patch_id_fp, q_prim_vf) -@@ -311,8 +315,7 @@ contains - if (instability_wave) call s_superposition_instability_wave() - - ! Converting the primitive variables to the conservative ones -- call s_convert_primitive_to_conservative_variables(q_prim_vf, & -- q_cons_vf) -+ call s_convert_primitive_to_conservative_variables(q_prim_vf, q_cons_vf) - - if (qbmm .and. .not. polytropic) then - !Initialize pb and mv -diff --git a/src/pre_process/m_mpi_proxy.fpp b/src/pre_process/m_mpi_proxy.fpp -index 257f7fb3..6b04bf0f 100644 ---- a/src/pre_process/m_mpi_proxy.fpp -+++ b/src/pre_process/m_mpi_proxy.fpp -@@ -55,7 +55,7 @@ contains - & 'cyl_coord','mpp_lim','hypoelasticity', 'relax', & - & 'parallel_io', 'perturb_flow', 'vel_profile', 'instability_wave',& - & 'perturb_sph', 'bubbles', 'polytropic', 'polydisperse', 'qbmm', & -- & 'file_per_process', 'adv_n', 'ib' ] -+ & 'file_per_process', 'adv_n', 'ib', 'hyperelasticity','pre_stress'] - call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) - #:endfor - call MPI_BCAST(fluid_rho(1), num_fluids_max, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) -@@ -76,6 +76,7 @@ contains - #:endfor - - call MPI_BCAST(patch_icpp(i)%smoothen, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) -+ call MPI_BCAST(patch_icpp(i)%non_axis_sym, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) - call MPI_BCAST(patch_icpp(i)%alter_patch(0), num_patches_max, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) - - #:for VAR in [ 'x_centroid', 'y_centroid', 'z_centroid', & -@@ -86,6 +87,10 @@ contains - call MPI_BCAST(patch_icpp(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - #:endfor - -+ #:for VAR in [ 'a2', 'a3', 'a4', 'a5', 'a6', 'a7', 'a8', 'a9', 'a10', 'a11', 'a12'] -+ call MPI_BCAST(patch_icpp(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) -+ #:endfor -+ - call MPI_BCAST(patch_icpp(i)%model%filepath, len(patch_icpp(i)%model%filepath), MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr) - - #:for VAR in [ 'model%translate', 'model%scale', 'model%rotate', & -diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp -index 708ada19..d14d2273 100644 ---- a/src/pre_process/m_patches.fpp -+++ b/src/pre_process/m_patches.fpp -@@ -70,7 +70,8 @@ module m_patches - !! 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(kind(0d0)) :: cart_y, cart_z -+ real(kind(0d0)) :: r_cyl, theta_cyl, x_cart, y_cart, z_cart -+ real(kind(0d0)) :: cart_x, cart_y, cart_z - real(kind(0d0)) :: sph_phi !< - !! Variables to be used to hold cell locations in Cartesian coordinates if - !! 3D simulation is using cylindrical coordinates -@@ -794,7 +795,7 @@ contains - ((y_cc(j) - y_centroid)/b)**2) & - - 1d0))*(-0.5d0) + 0.5d0 - end if -- -+ print *, "a :", a, "b :", b - if ((((x_cc(i) - x_centroid)/a)**2 + & - ((y_cc(j) - y_centroid)/b)**2 <= 1d0 & - .and. & -@@ -1421,128 +1422,240 @@ contains - !! @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, 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, intent(IN) :: patch_id -+ integer, intent(INOUT), dimension(0:m, 0:n, 0:p) :: patch_id_fp -+ type(scalar_field), dimension(1:sys_size) :: q_prim_vf -+ -+ real(kind(0d0)) :: r, x_p, P2, P3, P4, P5, P6, P7, P8, P9, P10, P11, P12, eps, phi -+ real(kind(0d0)) :: a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 -+ real(kind(0d0)) :: radius, x_centroid, y_centroid, z_centroid, eta, smooth_coeff -+ logical :: non_axis_sym - - integer :: i, j, k !< generic loop iterators -- real(kind(0d0)) :: radius, epsilon, beta -- complex(kind(0d0)) :: cmplx_i = (0d0, 1d0) -- complex(kind(0d0)) :: H - - ! Transferring the patch's centroid and radius 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 -+ smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id -+ smooth_coeff = patch_icpp(patch_id)%smooth_coeff - radius = patch_icpp(patch_id)%radius -- epsilon = patch_icpp(patch_id)%epsilon -- beta = patch_icpp(patch_id)%beta -+ a2 = patch_icpp(patch_id)%a2 -+ a3 = patch_icpp(patch_id)%a3 -+ a4 = patch_icpp(patch_id)%a4 -+ a5 = patch_icpp(patch_id)%a5 -+ a6 = patch_icpp(patch_id)%a6 -+ a7 = patch_icpp(patch_id)%a7 -+ a8 = patch_icpp(patch_id)%a8 -+ a9 = patch_icpp(patch_id)%a9 -+ a10 = patch_icpp(patch_id)%a10 -+ a11 = patch_icpp(patch_id)%a11 -+ a12 = patch_icpp(patch_id)%a12 -+ non_axis_sym = 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 = 1d0 -+ eps = 1.d-32 - - ! 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. -- do k = 0, p -+ if (p > 0 .and. .not. non_axis_sym) 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 = dsqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) + eps -+ if (x_cc(i) - x_centroid <= 0) then -+ x_p = -dabs(x_cc(i) - x_centroid + eps)/r -+ else -+ x_p = dabs(x_cc(i) - x_centroid + eps)/r -+ end if -+ -+ P2 = unassociated_legendre(x_p, 2) -+ P3 = unassociated_legendre(x_p, 3) -+ P4 = unassociated_legendre(x_p, 4) -+ P5 = unassociated_legendre(x_p, 5) -+ P6 = unassociated_legendre(x_p, 6) -+ P7 = unassociated_legendre(x_p, 7) -+ if ((x_cc(i) - x_centroid >= 0 & -+ .and. & -+ r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7 <= 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 = tanh(smooth_coeff/min(dx, dy, dz)* & -+ ((r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7) & -+ - radius))*(-0.5d0) + 0.5d0 -+ end if -+ -+ call s_assign_patch_primitive_variables(patch_id, i, j, k, & -+ eta, 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 (grid_geometry == 3) then -- call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k)) -+ if (non_axis_sym) then -+ phi = atan(((y_cc(j) - y_centroid) + eps)/((x_cc(i) - x_centroid) + eps)) -+ r = dsqrt((x_cc(i) - x_centroid)**2d0 + (y_cc(j) - y_centroid)**2d0) + eps -+ x_p = (eps)/r -+ P2 = spherical_harmonic_func(x_p, phi, 2, 2) -+ P3 = spherical_harmonic_func(x_p, phi, 3, 3) -+ P4 = spherical_harmonic_func(x_p, phi, 4, 4) -+ P5 = spherical_harmonic_func(x_p, phi, 5, 5) -+ P6 = spherical_harmonic_func(x_p, phi, 6, 6) -+ P7 = spherical_harmonic_func(x_p, phi, 7, 7) -+ P8 = spherical_harmonic_func(x_p, phi, 8, 8) -+ P9 = spherical_harmonic_func(x_p, phi, 9, 9) -+ ! P10 = spherical_harmonic_func(x_p, phi, 10, 10) -+ ! P11 = spherical_harmonic_func(x_p, phi, 11, 11) -+ ! P12 = spherical_harmonic_func(x_p, phi, 12, 12) - else -- cart_y = y_cc(j) -- cart_z = z_cc(k) -+ r = dsqrt((x_cc(i) - x_centroid)**2d0 + (y_cc(j) - y_centroid)**2d0) + eps -+ x_p = dabs(x_cc(i) - x_centroid + eps)/r -+ P2 = unassociated_legendre(x_p, 2) -+ P3 = unassociated_legendre(x_p, 3) -+ P4 = unassociated_legendre(x_p, 4) -+ P5 = unassociated_legendre(x_p, 5) -+ P6 = unassociated_legendre(x_p, 6) -+ P7 = unassociated_legendre(x_p, 7) -+ P8 = unassociated_legendre(x_p, 8) -+ P9 = unassociated_legendre(x_p, 9) - end if - -- 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)))) & -+ if (x_cc(i) - x_centroid >= 0 & -+ .and. & -+ r - a2*P2 - a3*P3 - a4*P4 - a5*P5 - a6*P6 - a7*P7 - a8*P8 - a9*P9 <= 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, q_prim_vf, patch_id_fp) - -- call s_convert_cylindrical_to_spherical_coord(x_cc(i), y_cc(j)) -- -- if (epsilon == 1d0) then -- if (beta == 0d0) then -- H = 5d-1*sqrt(3d0/pi)*cos(sph_phi) -- elseif (beta == 1d0) then -- H = -5d-1*sqrt(3d0/(2d0*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi) -- end if -- elseif (epsilon == 2d0) then -- if (beta == 0d0) then -- H = 25d-2*sqrt(5d0/pi)*(3d0*cos(sph_phi)**2 - 1d0) -- elseif (beta == 1d0) then -- H = -5d-1*sqrt(15d0/(2d0*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)*cos(sph_phi) -- elseif (beta == 2d0) then -- H = 25d-2*sqrt(15d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))*sin(sph_phi)**2 -- end if -- elseif (epsilon == 3d0) then -- if (beta == 0d0) then -- H = 25d-2*sqrt(7d0/pi)*(5d0*cos(sph_phi)**3d0 - 3d0*cos(sph_phi)) -- elseif (beta == 1d0) then -- H = -125d-3*sqrt(21d0/pi)*exp(cmplx_i*z_cc(k))*sin(sph_phi)* & -- (5d0*cos(sph_phi)**2 - 1d0) -- elseif (beta == 2d0) then -- H = 25d-2*sqrt(105d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & -- sin(sph_phi)**2*cos(sph_phi) -- elseif (beta == 3d0) then -- H = -125d-3*sqrt(35d0/pi)*exp(3d0*cmplx_i*z_cc(k))*sin(sph_phi)**3d0 -- end if -- elseif (epsilon == 4d0) then -- if (beta == 0d0) then -- H = 3d0/16d0*sqrt(1d0/pi)*(35d0*cos(sph_phi)**4d0 - & -- 3d1*cos(sph_phi)**2 + 3d0) -- elseif (beta == 1d0) then -- H = -3d0/8d0*sqrt(5d0/pi)*exp(cmplx_i*z_cc(k))* & -- sin(sph_phi)*(7d0*cos(sph_phi)**3d0 - 3d0*cos(sph_phi)) -- elseif (beta == 2d0) then -- H = 3d0/8d0*sqrt(5d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & -- sin(sph_phi)**2*(7d0*cos(sph_phi)**2 - 1d0) -- elseif (beta == 3d0) then -- H = -3d0/8d0*sqrt(35d0/pi)*exp(3d0*cmplx_i*z_cc(k))* & -- sin(sph_phi)**3d0*cos(sph_phi) -- elseif (beta == 4d0) then -- H = 3d0/16d0*sqrt(35d0/(2d0*pi))*exp(4d0*cmplx_i*z_cc(k))* & -- sin(sph_phi)**4d0 -- end if -- elseif (epsilon == 5d0) then -- if (beta == 0d0) then -- H = 1d0/16d0*sqrt(11d0/pi)*(63d0*cos(sph_phi)**5d0 - & -- 7d1*cos(sph_phi)**3d0 + 15d0*cos(sph_phi)) -- elseif (beta == 1d0) then -- H = -1d0/16d0*sqrt(165d0/(2d0*pi))*exp(cmplx_i*z_cc(k))* & -- sin(sph_phi)*(21d0*cos(sph_phi)**4d0 - 14d0*cos(sph_phi)**2 + 1d0) -- elseif (beta == 2d0) then -- H = 125d-3*sqrt(1155d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & -- sin(sph_phi)**2*(3d0*cos(sph_phi)**3d0 - cos(sph_phi)) -- elseif (beta == 3d0) then -- H = -1d0/32d0*sqrt(385d0/pi)*exp(3d0*cmplx_i*z_cc(k))* & -- sin(sph_phi)**3d0*(9d0*cos(sph_phi)**2 - 1d0) -- elseif (beta == 4d0) then -- H = 3d0/16d0*sqrt(385d0/(2d0*pi))*exp(4d0*cmplx_i*z_cc(k))* & -- sin(sph_phi)**4d0*cos(sph_phi) -- elseif (beta == 5d0) then -- H = -3d0/32d0*sqrt(77d0/pi)*exp(5d0*cmplx_i*z_cc(k))* & -- sin(sph_phi)**5d0 -- end if -- end if -- -- q_prim_vf(adv_idx%beg)%sf(i, j, k) = 1d0 - abs(real(H, kind(0d0))) -+ elseif (x_cc(i) - x_centroid < 0 & -+ .and. & -+ r - a2*P2 + a3*P3 - a4*P4 + a5*P5 - a6*P6 + a7*P7 - a8*P8 + a9*P9 <= 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, q_prim_vf, patch_id_fp) - - end if -- - end do - end do -- end do -+ end if - - end subroutine s_spherical_harmonic - -+ !! This function generates the unassociated legendre poynomials with input -+ ! mode number and evaluates them at input x -+ -+ recursive function unassociated_legendre(x, l) result(P) -+ integer, intent(in) :: l -+ real(kind(0d0)), intent(in) :: x -+ real(kind(0d0)) :: P -+ -+ if (l == 0) then -+ P = 1d0 -+ else if (l == 1) then -+ P = x -+ else -+ P = ((2*l - 1)*x*unassociated_legendre(x, l - 1) - (l - 1)*unassociated_legendre(x, l - 2))/l -+ end if -+ -+ end function unassociated_legendre -+ -+ !! This function generated the spherical harmonic function valu, Y, -+ !based on inputs of x, phi, l and m -+ -+ recursive function spherical_harmonic_func(x, phi, l, m) result(Y) -+ integer, intent(in) :: l, m -+ real(kind(0d0)), intent(in) :: x, phi -+ real(kind(0d0)) :: Y, prefactor, pi -+ -+ pi = acos(-1d0) -+ prefactor = sqrt((2*l + 1)/(4*pi)*factorial(l - m)/factorial(l + m)); -+ if (m == 0) then -+ Y = prefactor*associated_legendre(x, l, m); -+ elseif (m > 0) then -+ Y = (-1d0)**m*sqrt(2d0)*prefactor*associated_legendre(x, l, m)*cos(m*phi); -+ end if -+ end function spherical_harmonic_func -+ -+ !! This function generates the associated legendre polynomials evaluated -+ !at x with inputs l and m -+ -+ recursive function associated_legendre(x, l, m) result(P) -+ integer, intent(in) :: l, m -+ real(kind(0d0)), intent(in) :: x -+ real(kind(0d0)) :: P -+ -+ if (m <= 0 .and. l <= 0) then -+ P = 1; -+ elseif (l == 1 .and. m <= 0) then -+ P = x; -+ elseif (l == 1 .and. m == 1) then -+ P = -(1 - x**2)**(1/2); -+ elseif (m == l) then -+ P = (-1)**l*double_factorial(2*l - 1)*(1 - x**2)**(l/2); -+ elseif (m == l - 1) then -+ P = x*(2*l - 1)*associated_legendre(x, l - 1, l - 1); -+ else -+ P = ((2*l - 1)*x*associated_legendre(x, l - 1, m) - (l + m - 1)*associated_legendre(x, l - 2, m))/(l - m); -+ end if -+ -+ end function associated_legendre -+ -+ !! This function calculates the double factorial value of an integer -+ -+ recursive function double_factorial(n) result(R) -+ integer, intent(in) :: n -+ integer, parameter :: int64_kind = selected_int_kind(18) ! 18 bytes for 64-bit integer -+ integer(kind=int64_kind) :: R -+ -+ if (n <= 0) then -+ R = 1 -+ else if (n == 1) then -+ R = 1 -+ else -+ R = n*double_factorial(n - 2) -+ end if -+ -+ end function double_factorial -+ -+ !! The following function calculates the factorial value of an integer -+ -+ recursive function factorial(n) result(R) -+ integer, intent(in) :: n -+ integer, parameter :: int64_kind = selected_int_kind(18) ! 18 bytes for 64-bit integer -+ integer(kind=int64_kind) :: R -+ -+ if (n == 0) then -+ R = 1 -+ else -+ R = n*factorial(n - 1) -+ end if -+ -+ end function factorial -+ - !> 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 -@@ -2110,7 +2223,7 @@ contains - - end subroutine s_convert_cylindrical_to_spherical_coord - -- !> Archimedes spiral function -+ !> Archimedes spiral funcreal(kind(0d0)) :: theta_cc, r, x_p, P2, P3, P4, P5, P6, P7tion - !! @param myth Angle - !! @param offset Thickness - !! @param a Starting position -diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp -index 546de9c5..6db827ca 100644 ---- a/src/pre_process/m_start_up.fpp -+++ b/src/pre_process/m_start_up.fpp -@@ -140,7 +140,7 @@ contains - sigR, sigV, dist_type, rhoRV, R0_type, & - file_per_process, relax, relax_model, & - palpha_eps, ptgalpha_eps, ib, num_ibs, patch_ib, & -- sigma, adv_n -+ sigma, adv_n, hyperelasticity, pre_stress - - ! Inquiring the status of the pre_process.inp file - file_loc = 'pre_process.inp' -diff --git a/src/simulation/m_boundary_conditions.fpp b/src/simulation/m_boundary_conditions.fpp -index ca77632d..2b9eee16 100644 ---- a/src/simulation/m_boundary_conditions.fpp -+++ b/src/simulation/m_boundary_conditions.fpp -@@ -357,6 +357,12 @@ contains - q_prim_vf(i)%sf(-j, k, l) = & - q_prim_vf(i)%sf(j - 1, k, l) - end do -+ -+ if(hyperelasticity) then -+ q_prim_vf(xibeg)%sf(-j, k, l) = & -+ -q_prim_vf(xibeg)%sf(j - 1, k, l) -+ end if -+ - end do - end do - end do -@@ -401,6 +407,11 @@ contains - q_prim_vf(i)%sf(m - (j - 1), k, l) - end do - -+ if(hyperelasticity) then -+ q_prim_vf(xibeg)%sf(m + j, k, l) = & -+ -q_prim_vf(xibeg)%sf(m - (j - 1), k, l) -+ end if -+ - end do - end do - end do -@@ -448,6 +459,11 @@ contains - q_prim_vf(i)%sf(l, -j, k) = & - q_prim_vf(i)%sf(l, j - 1, k) - end do -+ -+ if(hyperelasticity) then -+ q_prim_vf(xibeg + 1)%sf(l, -j, k) = & -+ -q_prim_vf(xibeg + 1)%sf(l, j - 1, k) -+ end if - end do - end do - end do -@@ -490,6 +506,11 @@ contains - q_prim_vf(i)%sf(l, n + j, k) = & - q_prim_vf(i)%sf(l, n - (j - 1), k) - end do -+ -+ if(hyperelasticity) then -+ q_prim_vf(xibeg + 1)%sf(l, n + j, k) = & -+ -q_prim_vf(xibeg + 1)%sf(l, n - (j - 1), k) -+ end if - end do - end do - end do -@@ -537,6 +558,11 @@ contains - q_prim_vf(i)%sf(k, l, -j) = & - q_prim_vf(i)%sf(k, l, j - 1) - end do -+ -+ if(hyperelasticity) then -+ q_prim_vf(xiend)%sf(k, l, -j) = & -+ -q_prim_vf(xiend)%sf(k, l, j - 1) -+ end if - end do - end do - end do -@@ -579,6 +605,11 @@ contains - q_prim_vf(i)%sf(k, l, p + j) = & - q_prim_vf(i)%sf(k, l, p - (j - 1)) - end do -+ -+ if(hyperelasticity) then -+ q_prim_vf(xiend)%sf(k, l, p + j) = & -+ -q_prim_vf(xiend)%sf(k, l, p - (j - 1)) -+ end if - end do - end do - end do -diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp -index d9513675..c3523ec9 100644 ---- a/src/simulation/m_checker.fpp -+++ b/src/simulation/m_checker.fpp -@@ -31,6 +31,7 @@ contains - call s_check_inputs_model_eqns - if (acoustic_source) call s_check_inputs_acoustic_src - if (hypoelasticity) call s_check_inputs_hypoelasticity -+ if (hyperelasticity) call s_check_inputs_hyperelasticity - if (bubbles) call s_check_inputs_bubbles - if (adap_dt) call s_check_inputs_adapt_dt - if (alt_soundspeed) call s_check_inputs_alt_soundspeed -@@ -369,10 +370,20 @@ contains - !> Checks constraints on hypoelasticity parameters - subroutine s_check_inputs_hypoelasticity - if (riemann_solver /= 1) then -- call s_mpi_abort('hypoelasticity requires HLL Riemann solver '// & -- '(riemann_solver = 1). Exiting ...') -+ call s_mpi_abort('hypoelasticity requires HLL '// & -+ '(riemann_solver = 1) Riemann solver. '// & -+ 'Exiting ...') -+ end if -+ end subroutine s_check_inputs_hypoelasticity -+ -+ !> Checks constraints on hyperelasticity parameters -+ subroutine s_check_inputs_hyperelasticity -+ if (riemann_solver /= 2) then -+ call s_mpi_abort('hyperelasticity requires HLLC '// & -+ '(riemann_solver = 2) Riemann solver. '// & -+ 'Exiting ...') - end if -- end subroutine -+ end subroutine s_check_inputs_hyperelasticity - - !> Checks constraints on bubble parameters - subroutine s_check_inputs_bubbles -diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp -index 875f0a90..93637a1b 100644 ---- a/src/simulation/m_data_output.fpp -+++ b/src/simulation/m_data_output.fpp -@@ -1,4 +1,4 @@ --!> -+ - !! @file m_data_output.f90 - !! @brief Contains module m_data_output - -@@ -37,13 +37,16 @@ module m_data_output - private; - public :: s_initialize_data_output_module, & - s_open_run_time_information_file, & -+ s_open_com_files, & - s_open_probe_files, & - s_write_run_time_information, & - s_write_data_files, & - s_write_serial_data_files, & - s_write_parallel_data_files, & -+ s_write_com_files, & - s_write_probe_files, & - s_close_run_time_information_file, & -+ s_close_com_files, & - s_close_probe_files, & - s_finalize_data_output_module - -@@ -63,11 +66,12 @@ module m_data_output - - type(scalar_field), & - dimension(sys_size), & -- intent(inout) :: q_prim_vf -+ intent(inOUT) :: q_prim_vf - - integer, intent(in) :: t_step - -- end subroutine s_write_abstract_data_files -+ end subroutine s_write_abstract_data_files ! ------------------- -+ - end interface ! ======================================================== - #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), icfl_sf) -@@ -80,6 +84,8 @@ module m_data_output - real(kind(0d0)), allocatable, dimension(:, :, :) :: vcfl_sf !< VCFL stability criterion - real(kind(0d0)), allocatable, dimension(:, :, :) :: ccfl_sf !< CCFL stability criterion - real(kind(0d0)), allocatable, dimension(:, :, :) :: Rc_sf !< Rc stability criterion -+ real(kind(0d0)), public, allocatable, dimension(:, :) :: c_mass -+ - !$acc declare create(icfl_sf, vcfl_sf, ccfl_sf, Rc_sf) - #endif - -@@ -169,6 +175,44 @@ contains - - end subroutine s_open_run_time_information_file - -+ !> This opens a formatted data file where the root processor -+ !! can write out the CoM information -+ subroutine s_open_com_files() ! ---------------------------------------- -+ character(len=path_len + 3*name_len) :: file_path !< -+ !! Relative path to the CoM file in the case directory -+ integer :: i !< Generic loop iterator -+ do i = 1, num_fluids -+ ! Generating the relative path to the CoM data file -+ write (file_path, '(A,I0,A)') '/fluid', i, '_com.dat' -+ file_path = trim(case_dir)//trim(file_path) -+ ! Creating the formatted data file and setting up its -+ ! structure -+ open (i + 120, file=trim(file_path), & -+ form='formatted', & -+ position='append', & -+ status='unknown') -+ if (n == 0) then -+ write (i + 120, '(A)') '=== Non-Dimensional Time '// & -+ '=== Total Mass '// & -+ '=== x-loc '// & -+ '=== Total Volume ===' -+ elseif (p == 0) then -+ write (i + 120, '(A)') '=== Non-Dimensional Time '// & -+ '=== Total Mass '// & -+ '=== x-loc '// & -+ '=== y-loc '// & -+ '=== Total Volume ===' -+ else -+ write (i + 120, '(A)') '=== Non-Dimensional Time '// & -+ '=== Total Mass '// & -+ '=== x-loc '// & -+ '=== y-loc '// & -+ '=== z-loc '// & -+ '=== Total Volume ===' -+ end if -+ end do -+ end subroutine s_open_com_files ! -------------------------------------- -+ - !> This opens a formatted data file where the root processor - !! can write out flow probe information - subroutine s_open_probe_files -@@ -189,12 +233,12 @@ contains - FORM='formatted', & - STATUS='unknown') - ! POSITION = 'append', & -- !WRITE(i+30,'(A,I0,A)') 'Probe ',i, ' located at:' -- !WRITE(i+30,'(A,F10.6)') 'x = ',probe(i)%x -- !WRITE(i+30,'(A,F10.6)') 'y = ',probe(i)%y -- !WRITE(i+30,'(A,F10.6)') 'z = ',probe(i)%z -- !WRITE(i+30, *) -- !WRITE(i+30,'(A)') '=== Non-Dimensional Time ' // & -+ !write(i+30,'(A,I0,A)') 'Probe ',i, ' located at:' -+ !write(i+30,'(A,F10.6)') 'x = ',probe(i)%x -+ !write(i+30,'(A,F10.6)') 'y = ',probe(i)%y -+ !write(i+30,'(A,F10.6)') 'z = ',probe(i)%z -+ !write(i+30, *) -+ !write(i+30,'(A)') '=== Non-Dimensional Time ' // & - ! '=== Density ' // & - ! '=== Velocity ' // & - ! '=== Pressure ' // & -@@ -227,8 +271,8 @@ contains - !! @param t_step Current time step - subroutine s_write_run_time_information(q_prim_vf, t_step) - -- type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf -- integer, intent(IN) :: t_step -+ type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf -+ integer, intent(in) :: t_step - - real(kind(0d0)), dimension(num_fluids) :: alpha_rho !< Cell-avg. partial density - real(kind(0d0)) :: rho !< Cell-avg. density -@@ -250,7 +294,6 @@ contains - - real(kind(0d0)) :: blkmod1, blkmod2 !< - !! Fluid bulk modulus for Woods mixture sound speed -- - integer :: i, j, k, l, q !< Generic loop iterators - - integer :: Nfq -@@ -262,7 +305,6 @@ contains - do l = 0, p - do k = 0, n - do j = 0, m -- - do i = 1, num_fluids - alpha_rho(i) = q_prim_vf(i)%sf(j, k, l) - alpha(i) = q_prim_vf(E_idx + i)%sf(j, k, l) -@@ -292,6 +334,14 @@ contains - ! Compute mixture sound speed - call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c) - -+ if (c /= c) then -+ print *, 'crashed at processor: ', proc_rank, ', at j :: ', j, ', k :: ', k, ' l :: ', l -+ print *, 'alpha1 ::', alpha(1), 'and alpha2 ::', alpha(2), ' alpha3 :: ', alpha(3) -+ print *, 'alpha_rho1 ::', alpha_rho(1), ', alpha_rho2 ::', alpha_rho(2), ' alpha_rho3 :: ', alpha_rho(3) -+ print *, 'E :: ', E, ', pres :: ', pres, ', rho :: ', rho -+ call s_mpi_abort('Exiting ...') -+ end if -+ - if (grid_geometry == 3) then - if (k == 0) then - fltr_dtheta = 2d0*pi*y_cb(0)/3d0 -@@ -369,7 +419,7 @@ contains - end do - end do - end do -- ! END: Computing Stability Criteria at Current Time-step =========== -+ ! end: Computing Stability Criteria at Current Time-step =========== - - ! Determining local stability criteria extrema at current time-step - -@@ -430,6 +480,7 @@ contains - t_step, t_step*dt, icfl_max_glb, & - vcfl_max_glb, & - Rc_min_glb -+ - else - write (1, '(13X,I8,14X,F10.6,13X,F9.6)') & - t_step, t_step*dt, icfl_max_glb -@@ -840,11 +891,11 @@ contains - - integer :: ifile, ierr, data_size - integer, dimension(MPI_STATUS_SIZE) :: status -- integer(KIND=MPI_OFFSET_KIND) :: disp -- integer(KIND=MPI_OFFSET_KIND) :: m_MOK, n_MOK, p_MOK -- integer(KIND=MPI_OFFSET_KIND) :: WP_MOK, var_MOK, str_MOK -- integer(KIND=MPI_OFFSET_KIND) :: NVARS_MOK -- integer(KIND=MPI_OFFSET_KIND) :: MOK -+ integer(kind=MPI_OFFSET_kind) :: disp -+ integer(kind=MPI_OFFSET_kind) :: m_MOK, n_MOK, p_MOK -+ integer(kind=MPI_OFFSET_kind) :: WP_MOK, var_MOK, str_MOK -+ integer(kind=MPI_OFFSET_kind) :: NVARS_MOK -+ integer(kind=MPI_OFFSET_kind) :: MOK - - character(LEN=path_len + 2*name_len) :: file_loc - logical :: file_exist, dir_check -@@ -876,7 +927,6 @@ contains - call DelayFileAccess(proc_rank) - - ! Initialize MPI data I/O -- - call s_initialize_mpi_data(q_cons_vf) - - ! Open the file to write all flow variables -@@ -1009,6 +1059,57 @@ contains - - end subroutine s_write_parallel_data_files - -+ !> This writes a formatted data file where the root processor -+ !! can write out the CoM information -+ !! @param t_step Current time-step -+ !! @param q_com Center of mass information -+ !! @param moments Higher moment information -+ subroutine s_write_com_files(t_step, c_mass) ! ------------------- -+ -+ integer, intent(in) :: t_step -+ real(kind(0d0)), dimension(num_fluids, 5), intent(in) :: c_mass -+ integer :: i, j !< Generic loop iterator -+ real(kind(0d0)) :: nondim_time !< Non-dimensional time -+ -+ ! Non-dimensional time calculation -+ if (t_step_old /= dflt_int) then -+ nondim_time = real(t_step + t_step_old, kind(0d0))*dt -+ else -+ nondim_time = real(t_step, kind(0d0))*dt -+ end if -+ -+ if (proc_rank == 0) then -+ if (n == 0) then ! 1D simulation -+ do i = 1, num_fluids ! Loop through fluids -+ write (i + 120, '(6X,4F24.12)') & -+ nondim_time, & -+ c_mass(i, 1), & -+ c_mass(i, 2), & -+ c_mass(i, 5) -+ end do -+ elseif (p == 0) then ! 2D simulation -+ do i = 1, num_fluids ! Loop through fluids -+ write (i + 120, '(6X,5F24.12)') & -+ nondim_time, & -+ c_mass(i, 1), & -+ c_mass(i, 2), & -+ c_mass(i, 3), & -+ c_mass(i, 5) -+ end do -+ else ! 3D simulation -+ do i = 1, num_fluids ! Loop through fluids -+ write (i + 120, '(6X,6F24.12)') & -+ nondim_time, & -+ c_mass(i, 1), & -+ c_mass(i, 2), & -+ c_mass(i, 3), & -+ c_mass(i, 4), & -+ c_mass(i, 5) -+ end do -+ end if -+ end if -+ end subroutine s_write_com_files ! ------------------------------------- -+ - !> This writes a formatted data file for the flow probe information - !! @param t_step Current time-step - !! @param q_cons_vf Conservative variables -@@ -1057,7 +1158,7 @@ contains - real(kind(0d0)) :: nondim_time !< Non-dimensional time - - real(kind(0d0)) :: tmp !< -- !! Temporary variable to store quantity for mpi_allreduce -+ !! Temporary variable to store quantity for mpi_allreduce - - real(kind(0d0)) :: blkmod1, blkmod2 !< - !! Fluid bulk modulus for Woods mixture sound speed -@@ -1118,7 +1219,7 @@ contains - l = 0 - - ! Computing/Sharing necessary state variables -- if (hypoelasticity) then -+ if (elasticity) then - call s_convert_to_mixture_variables(q_cons_vf, j - 2, k, l, & - rho, gamma, pi_inf, qv, & - Re, G, fluid_pp(:)%G) -@@ -1132,7 +1233,8 @@ contains - - dyn_p = 0.5d0*rho*dot_product(vel, vel) - -- if (hypoelasticity) then -+ if (elasticity) then -+ - call s_compute_pressure( & - q_cons_vf(1)%sf(j - 2, k, l), & - q_cons_vf(alf_idx)%sf(j - 2, k, l), & -@@ -1148,7 +1250,7 @@ contains - - if (model_eqns == 4) then - lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 -- else if (hypoelasticity) then -+ else if (elasticity) then - tau_e(1) = q_cons_vf(stress_idx%end)%sf(j - 2, k, l)/rho - end if - -@@ -1232,7 +1334,7 @@ contains - - dyn_p = 0.5d0*rho*dot_product(vel, vel) - -- if (hypoelasticity) then -+ if (elasticity) then - call s_compute_pressure( & - q_cons_vf(1)%sf(j - 2, k - 2, l), & - q_cons_vf(alf_idx)%sf(j - 2, k - 2, l), & -@@ -1247,7 +1349,7 @@ contains - - if (model_eqns == 4) then - lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 -- else if (hypoelasticity) then -+ else if (elasticity) then - do s = 1, 3 - tau_e(s) = q_cons_vf(s)%sf(j - 2, k - 2, l)/rho - end do -@@ -1274,15 +1376,13 @@ contains - R(:) = nR(:)/nbub - Rdot(:) = nRdot(:)/nbub - end if -- - ! Compute mixture sound speed - call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & - ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) - -- accel = accel_mag(j - 2, k - 2, l) - end if - end if -- else ! 3D simulation -+ else ! 3D - if ((probe(i)%x >= x_cb(-1)) .and. (probe(i)%x <= x_cb(m))) then - if ((probe(i)%y >= y_cb(-1)) .and. (probe(i)%y <= y_cb(n))) then - if ((probe(i)%z >= z_cb(-1)) .and. (probe(i)%z <= z_cb(p))) then -@@ -1315,7 +1415,7 @@ contains - - dyn_p = 0.5d0*rho*dot_product(vel, vel) - -- if (hypoelasticity) then -+ if (elasticity) then - call s_compute_pressure( & - q_cons_vf(1)%sf(j - 2, k - 2, l - 2), & - q_cons_vf(alf_idx)%sf(j - 2, k - 2, l - 2), & -@@ -1337,7 +1437,6 @@ contains - end if - end if - end if -- - if (num_procs > 1) then - #:for VAR in ['rho','pres','gamma','pi_inf','qv','c','accel'] - tmp = ${VAR}$ -@@ -1363,14 +1462,13 @@ contains - end if - end if - -- if (hypoelasticity) then -+ if (elasticity) then - do s = 1, (num_dims*(num_dims + 1))/2 - tmp = tau_e(s) - call s_mpi_allreduce_sum(tmp, tau_e(s)) - end do - end if - end if -- - if (proc_rank == 0) then - if (n == 0) then - if (bubbles .and. (num_fluids <= 2)) then -@@ -1457,7 +1555,7 @@ contains - nRdot(1), & - R(1), & - Rdot(1) -- else if (hypoelasticity) then -+ else if (elasticity) then - write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,'// & - 'F24.8,F24.8,F24.8)') & - nondim_time, & -@@ -1474,6 +1572,7 @@ contains - rho, & - vel(1), & - pres -+ print *, 'time =', nondim_time, 'rho =', rho, 'pres =', pres - end if - else - write (i + 30, '(6X,F12.6,F24.8,F24.8,F24.8,F24.8,'// & -@@ -1659,6 +1758,16 @@ contains - - end subroutine s_close_run_time_information_file - -+ !> Closes communication files -+ subroutine s_close_com_files() ! --------------------------------------- -+ -+ integer :: i !< Generic loop iterator -+ do i = 1, num_fluids -+ close (i + 120) -+ end do -+ -+ end subroutine s_close_com_files ! ------------------------------------- -+ - !> Closes probe files - subroutine s_close_probe_files - -@@ -1679,6 +1788,8 @@ contains - - integer :: i !< Generic loop iterator - -+ allocate (c_mass(1:num_fluids, 1:5)) -+ - ! Allocating/initializing ICFL, VCFL, CCFL and Rc stability criteria - @:ALLOCATE_GLOBAL(icfl_sf(0:m, 0:n, 0:p)) - icfl_max = 0d0 -@@ -1718,6 +1829,8 @@ contains - - integer :: i !< Generic loop iterator - -+ deallocate (c_mass) -+ - ! Deallocating the ICFL, VCFL, CCFL, and Rc stability criteria - @:DEALLOCATE_GLOBAL(icfl_sf) - if (any(Re_size > 0)) then -diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 -index 4cbe11ab..8f01d478 100644 ---- a/src/simulation/m_derived_variables.f90 -+++ b/src/simulation/m_derived_variables.f90 -@@ -20,6 +20,8 @@ module m_derived_variables - - use m_time_steppers !< Time-stepping algorithms - -+ use m_compile_specific -+ - use m_helper - ! ========================================================================== - -@@ -90,8 +92,8 @@ contains - ! Opening and writing header of flow probe files - if (proc_rank == 0) then - call s_open_probe_files() -+ call s_open_com_files() - end if -- - ! Computing centered finite difference coefficients - call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & - fd_number, fd_order) -@@ -100,12 +102,10 @@ contains - call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & - fd_number, fd_order) - end if -- - if (p > 0) then - call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & - fd_number, fd_order) - end if -- - end if - - end subroutine s_initialize_derived_variables -@@ -115,7 +115,6 @@ contains - subroutine s_compute_derived_variables(t_step) - - integer, intent(in) :: t_step -- - integer :: i, j, k !< Generic loop iterators - - if (probe_wrt) then -@@ -124,7 +123,6 @@ contains - q_prim_ts(2)%vf, & - q_prim_ts(3)%vf, & - x_accel) -- - if (n > 0) then - call s_derive_acceleration_component(2, q_prim_ts(0)%vf, & - q_prim_ts(1)%vf, & -@@ -132,7 +130,6 @@ contains - q_prim_ts(3)%vf, & - y_accel) - end if -- - if (p > 0) then - call s_derive_acceleration_component(3, q_prim_ts(0)%vf, & - q_prim_ts(1)%vf, & -@@ -140,7 +137,6 @@ contains - q_prim_ts(3)%vf, & - z_accel) - end if -- - do k = 0, p - do j = 0, n - do i = 0, m -@@ -157,8 +153,10 @@ contains - end do - end do - end do -+ call s_derive_center_of_mass(q_prim_ts(3)%vf, c_mass) - - call s_write_probe_files(t_step, q_cons_ts(1)%vf, accel_mag) -+ call s_write_com_files(t_step, c_mass) - end if - - end subroutine s_compute_derived_variables -@@ -194,7 +192,6 @@ contains - do l = 0, p - do k = 0, n - do j = 0, m -- - q_sf(j, k, l) = (11d0*q_prim_vf0(mom_idx%beg)%sf(j, k, l) & - - 18d0*q_prim_vf1(mom_idx%beg)%sf(j, k, l) & - + 9d0*q_prim_vf2(mom_idx%beg)%sf(j, k, l) & -@@ -234,18 +231,15 @@ contains - end do - end do - end do -- - ! Computing the acceleration component in the y-coordinate direction - elseif (i == 2) then - do l = 0, p - do k = 0, n - do j = 0, m -- - q_sf(j, k, l) = (11d0*q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf1(mom_idx%beg + 1)%sf(j, k, l) & - + 9d0*q_prim_vf2(mom_idx%beg + 1)%sf(j, k, l) & - - 2d0*q_prim_vf3(mom_idx%beg + 1)%sf(j, k, l))/(6d0*dt) -- - do r = -fd_number, fd_number - if (p == 0) then ! 2D simulation - q_sf(j, k, l) = q_sf(j, k, l) & -@@ -316,11 +310,154 @@ contains - - end subroutine s_derive_acceleration_component - -+ !> This subroutine is used together with the volume fraction -+ !! model and when called upon, it computes the location of -+ !! of the center of mass for each fluid from the inputted -+ !! primitive variables, q_prim_vf. The computed location -+ !! is then written to a formatted data file by the root process. -+ !! @param q_prim_vf Primitive variables -+ !! @param c_m Mass,x-location,y-location,z-location -+ subroutine s_derive_center_of_mass(q_vf, c_m) -+ type(scalar_field), dimension(sys_size), intent(IN) :: q_vf -+ real(kind(0d0)), dimension(1:num_fluids, 1:5), intent(INOUT) :: c_m -+ integer :: i, j, k, l !< Generic loop iterators -+ real(kind(0d0)) :: tmp, tmp_out !< Temporary variable to store quantity for mpi_allreduce -+ real(kind(0d0)) :: dV !< Discrete cell volume -+ -+ do i = 1, num_fluids -+ do j = 1, 5 -+ c_m(i, j) = 0.0d0 -+ end do -+ end do -+ -+ if (n == 0) then !1D simulation -+ do i = 1, num_fluids !Loop over individual fluids -+ do l = 0, p !Loop over grid -+ do k = 0, n -+ do j = 0, m -+ dV = dx(j) -+ ! Mass -+ c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV -+ ! x-location weighted -+ c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) -+ ! Volume fraction -+ c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 1)%sf(j, k, l)*dV -+ end do -+ end do -+ end do -+ end do -+ elseif (p == 0) then !2D simulation -+ do i = 1, num_fluids !Loop over individual fluids -+ do l = 0, p !Loop over grid -+ do k = 0, n -+ do j = 0, m -+ dV = dx(j)*dy(k) -+ ! Mass -+ c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV -+ ! x-location weighted -+ c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) -+ ! y-location weighted -+ c_m(i, 3) = c_m(i, 3) + q_vf(i)%sf(j, k, l)*dV*y_cc(k) -+ ! Volume fraction -+ c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 1)%sf(j, k, l)*dV -+ end do -+ end do -+ end do -+ end do -+ else !3D simulation -+ do i = 1, num_fluids !Loop over individual fluids -+ do l = 0, p !Loop over grid -+ do k = 0, n -+ do j = 0, m -+ dV = dx(j)*dy(k)*dz(l) -+ ! Mass -+ c_m(i, 1) = c_m(i, 1) + q_vf(i)%sf(j, k, l)*dV -+ ! x-location weighted -+ c_m(i, 2) = c_m(i, 2) + q_vf(i)%sf(j, k, l)*dV*x_cc(j) -+ ! y-location weighted -+ c_m(i, 3) = c_m(i, 3) + q_vf(i)%sf(j, k, l)*dV*y_cc(k) -+ ! z-location weighted -+ c_m(i, 4) = c_m(i, 4) + q_vf(i)%sf(j, k, l)*dV*z_cc(l) -+ ! Volume fraction -+ c_m(i, 5) = c_m(i, 5) + q_vf(i + adv_idx%beg - 1)%sf(j, k, l)*dV -+ end do -+ end do -+ end do -+ end do -+ end if -+ if (n == 0) then !1D simulation -+ do i = 1, num_fluids !Loop over individual fluids -+ ! Sum all components across all processors using MPI_ALLREDUCE -+ if (num_procs > 1) then -+ tmp = c_m(i, 1) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 1) = tmp_out -+ tmp = c_m(i, 2) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 2) = tmp_out -+ tmp = c_m(i, 5) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 5) = tmp_out -+ end if -+ ! Compute quotients -+ c_m(i, 2) = c_m(i, 2)/c_m(i, 1) -+ end do -+ elseif (p == 0) then !2D simulation -+ do i = 1, num_fluids !Loop over individual fluids -+ ! Sum all components across all processors using MPI_ALLREDUCE -+ if (num_procs > 1) then -+ tmp = c_m(i, 1) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 1) = tmp_out -+ tmp = c_m(i, 2) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 2) = tmp_out -+ tmp = c_m(i, 3) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 3) = tmp_out -+ tmp = c_m(i, 5) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 5) = tmp_out -+ end if -+ ! Compute quotients -+ c_m(i, 2) = c_m(i, 2)/c_m(i, 1) -+ c_m(i, 3) = c_m(i, 3)/c_m(i, 1) -+ end do -+ else !3D simulation -+ do i = 1, num_fluids !Loop over individual fluids -+ ! Sum all components across all processors using MPI_ALLREDUCE -+ if (num_procs > 1) then -+ tmp = c_m(i, 1) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 1) = tmp_out -+ tmp = c_m(i, 2) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 2) = tmp_out -+ tmp = c_m(i, 3) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 3) = tmp_out -+ tmp = c_m(i, 4) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 4) = tmp_out -+ tmp = c_m(i, 5) -+ call s_mpi_allreduce_sum(tmp, tmp_out) -+ c_m(i, 5) = tmp_out -+ end if -+ ! Compute quotients -+ c_m(i, 2) = c_m(i, 2)/c_m(i, 1) -+ c_m(i, 3) = c_m(i, 3)/c_m(i, 1) -+ c_m(i, 4) = c_m(i, 4)/c_m(i, 1) -+ end do -+ end if -+ -+ end subroutine s_derive_center_of_mass ! ---------------------------------- -+ - !> Deallocation procedures for the module - subroutine s_finalize_derived_variables_module - - ! Closing CoM and flow probe files - if (proc_rank == 0) then -+ call s_close_com_files() - if (probe_wrt) then - call s_close_probe_files() - end if -diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp -index a703eb5c..539d3b56 100644 ---- a/src/simulation/m_global_parameters.fpp -+++ b/src/simulation/m_global_parameters.fpp -@@ -144,9 +144,12 @@ module m_global_parameters - integer :: wave_speeds !< Wave speeds estimation method - integer :: avg_state !< Average state evaluation method - logical :: alt_soundspeed !< Alternate mixture sound speed -- logical :: null_weights !< Null undesired WENO weights -- logical :: mixture_err !< Mixture properties correction -- logical :: hypoelasticity !< hypoelasticity modeling -+ logical :: null_weights !< Null undesired WENO weights -+ logical :: mixture_err !< Mixture properties correction -+ logical :: hypoelasticity !< hypoelasticity modeling -+ logical :: hyperelasticity !< hyperelasticity modeling -+ integer :: hyper_model !< hyperelasticity solver algorithm -+ logical :: elasticity !< elasticity modeling, true for hyper or hypo - logical :: cu_tensor - - logical :: bodyForces -@@ -166,7 +169,7 @@ module m_global_parameters - !$acc declare create(num_dims, weno_polyn, weno_order, num_fluids, wenojs, mapped_weno, wenoz, teno) - #:endif - -- !$acc declare create(mpp_lim, model_eqns, mixture_err, alt_soundspeed, avg_state, mp_weno, weno_eps, teno_CT, hypoelasticity, low_Mach) -+ !$acc declare create(mpp_lim, model_eqns, mixture_err, alt_soundspeed, avg_state, mp_weno, weno_eps, teno_CT, hypoelasticity, hyperelasticity, elasticity, low_Mach) - - logical :: relax !< activate phase change - integer :: relax_model !< Relaxation model -@@ -182,6 +185,8 @@ module m_global_parameters - type(int_bounds_info) :: bc_x, bc_y, bc_z - !> @} - type(bounds_info) :: x_domain, y_domain, z_domain -+ real(kind(0d0)) :: x_a, y_a, z_a -+ real(kind(0d0)) :: x_b, y_b, z_b - - logical :: parallel_io !< Format of the data files - logical :: file_per_process !< shared file or not when using parallel io -@@ -208,19 +213,22 @@ module m_global_parameters - !> @name Annotations of the structure of the state and flux vectors in terms of the - !! size and the configuration of the system of equations to which they belong - !> @{ -- integer :: sys_size !< Number of unknowns in system of eqns. -+ integer :: sys_size !< Number of unknowns in system of eqns. - type(int_bounds_info) :: cont_idx !< Indexes of first & last continuity eqns. - type(int_bounds_info) :: mom_idx !< Indexes of first & last momentum eqns. -- integer :: E_idx !< Index of energy equation -- integer :: n_idx !< Index of number density -+ integer :: E_idx !< Index of energy equation -+ integer :: n_idx !< Index of number density - type(int_bounds_info) :: adv_idx !< Indexes of first & last advection eqns. - type(int_bounds_info) :: internalEnergies_idx !< Indexes of first & last internal energy eqns. -- type(bub_bounds_info) :: bub_idx !< Indexes of first & last bubble variable eqns. -- integer :: alf_idx !< Index of void fraction -- integer :: gamma_idx !< Index of specific heat ratio func. eqn. -- integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. -+ type(bub_bounds_info) :: bub_idx !< Indexes of first & last bubble variable eqns. -+ integer :: alf_idx !< Index of void fraction -+ integer :: gamma_idx !< Index of specific heat ratio func. eqn. -+ integer :: pi_inf_idx !< Index of liquid stiffness func. eqn. - type(int_bounds_info) :: stress_idx !< Indexes of first and last shear stress eqns. -- integer :: c_idx ! Index of the color function -+ type(int_bounds_info) :: xi_idx !< Indexes of first and last reference map eqns. -+ integer :: b_size !< Number of elements in the symmetric b tensor, plus one -+ integer :: tensor_size !< Number of elements in the full tensor plus one -+ integer :: c_idx !< Index of the color function - !> @} - - !$acc declare create(bub_idx) -@@ -273,7 +281,7 @@ module m_global_parameters - - integer :: startx, starty, startz - -- !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx) -+ !$acc declare create(sys_size, buff_size, startx, starty, startz, E_idx, gamma_idx, pi_inf_idx, alf_idx, n_idx, stress_idx,b_size, tensor_size, xi_idx) - - ! END: Simulation Algorithm Parameters ===================================== - -@@ -299,6 +307,7 @@ module m_global_parameters - !! The finite-difference number is given by MAX(1, fd_order/2). Essentially, - !! it is a measure of the half-size of the finite-difference stencil for the - !! selected order of accuracy. -+ !$acc declare create(fd_order,fd_number) - - logical :: probe_wrt - logical :: integral_wrt -@@ -435,7 +444,9 @@ module m_global_parameters - integer :: intxb, intxe - integer :: bubxb, bubxe - integer :: strxb, strxe -+ integer :: xibeg, xiend - !$acc declare create(momxb, momxe, advxb, advxe, contxb, contxe, intxb, intxe, bubxb, bubxe, strxb, strxe) -+!$acc declare create(xibeg,xiend) - - #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps) -@@ -515,6 +526,9 @@ contains - palpha_eps = dflt_real - ptgalpha_eps = dflt_real - hypoelasticity = .false. -+ hyperelasticity = .false. -+ elasticity = .false. -+ hyper_model = dflt_int - weno_flat = .true. - riemann_flat = .true. - rdma_mpi = .false. -@@ -828,13 +842,26 @@ contains - end if - end if - -- if (hypoelasticity) then -+ if (hypoelasticity .or. hyperelasticity) then -+ elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D - sys_size = stress_idx%end - end if - -+ if (hyperelasticity) then -+ ! number of entries in the symmetric btensor plus the jacobian -+ b_size = (num_dims*(num_dims + 1))/2 + 1 -+ ! storing the jacobian in the last entry -+ tensor_size = num_dims**2 + 1 -+ xi_idx%beg = sys_size + 1 -+ xi_idx%end = sys_size + num_dims -+ ! adding three more equations for the \xi field and the elastic energy -+ sys_size = xi_idx%end + 1 -+ hyper_model = 1 -+ end if -+ - if (.not. f_is_default(sigma)) then - c_idx = sys_size + 1 - sys_size = c_idx -@@ -853,6 +880,25 @@ contains - internalEnergies_idx%end = adv_idx%end + num_fluids - sys_size = internalEnergies_idx%end - -+ if (hypoelasticity .or. hyperelasticity) then -+ elasticity = .true. -+ stress_idx%beg = sys_size + 1 -+ stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 -+ ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D -+ sys_size = stress_idx%end -+ end if -+ -+ if (hyperelasticity) then -+ ! number of entries in the symmetric btensor plus the jacobian -+ b_size = (num_dims*(num_dims + 1))/2 + 1 -+ ! storing the jacobian in the last entry -+ tensor_size = num_dims**2 + 1 -+ xi_idx%beg = sys_size + 1 -+ xi_idx%end = sys_size + num_dims -+ ! adding three more equations for the \xi field and the elastic energy -+ sys_size = xi_idx%end + 1 -+ end if -+ - if (.not. f_is_default(sigma)) then - c_idx = sys_size + 1 - sys_size = c_idx -@@ -989,12 +1035,18 @@ contains - ! the next one - if (any(Re_size > 0)) then - buff_size = 2*weno_polyn + 2 --! else if (hypoelasticity) then !TODO: check if necessary -+! else if (elasticity) then !TODO: check if necessary - ! buff_size = 2*weno_polyn + 2 - else - buff_size = weno_polyn + 2 - end if - -+ if (elasticity) then -+ fd_order = 4 -+ fd_number = max(1, fd_order/2) -+ !buff_size = buff_size + fd_number -+ end if -+ - ! Configuring Coordinate Direction Indexes ========================= - if (bubbles) then - ix%beg = -buff_size; iy%beg = 0; iz%beg = 0 -@@ -1024,7 +1076,8 @@ contains - if (p > 0) then - startz = -buff_size - end if -- -+ -+ !$acc update device(fd_order,fd_number) - !$acc update device(startx, starty, startz) - - if (cyl_coord .neqv. .true.) then ! Cartesian grid -@@ -1047,19 +1100,23 @@ contains - strxe = stress_idx%end - intxb = internalEnergies_idx%beg - intxe = internalEnergies_idx%end -+ xibeg = xi_idx%beg -+ xiend = xi_idx%end - -- !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe) -+ !$acc update device(momxb, momxe, advxb, advxe, contxb, contxe, bubxb, bubxe, intxb, intxe, sys_size, buff_size, E_idx, alf_idx, n_idx, adv_n, adap_dt, pi_fac, strxb, strxe, b_size, xibeg, xiend, tensor_size) - !$acc update device(m, n, p) - - !$acc update device(alt_soundspeed, acoustic_source, num_source) -- !$acc update device(dt, sys_size, buff_size, pref, rhoref, gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim, bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids, model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord, mp_weno, weno_eps, teno_CT, low_Mach) -+ !$acc update device(dt, sys_size, buff_size, pref, rhoref, gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim, bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids, model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord, mp_weno, weno_eps, teno_CT, hyperelasticity, elasticity, xi_idx, low_Mach) - - #:if not MFC_CASE_OPTIMIZATION - !$acc update device(wenojs, mapped_weno, wenoz, teno) - #:endif - - !$acc enter data copyin(nb, R0ref, Ca, Web, Re_inv, weight, R0, V0, bubbles, polytropic, polydisperse, qbmm, R0_type, ptil, bubble_model, thermal, poly_sigma) -- !$acc enter data copyin(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v, k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN , mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam) -+ -+ !$acc enter data copyin(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v, k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN, mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam) -+ - !$acc enter data copyin(dir_idx, dir_flg, dir_idx_tau) - - !$acc enter data copyin(relax, relax_model, palpha_eps,ptgalpha_eps) -diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp -new file mode 100644 -index 00000000..9d8b6a4f ---- /dev/null -+++ b/src/simulation/m_hyperelastic.fpp -@@ -0,0 +1,364 @@ -+!> -+!! @file m_hyperelastic.f90 -+!! @brief Contains module m_hyperelastic -+ -+#:include 'macros.fpp' -+ -+!> @brief This module consists of subroutines used in the calculation -+!! of the cauchy tensor -+ -+module m_hyperelastic -+ -+ ! Dependencies ============================================================= -+ -+ use m_derived_types !< Definitions of the derived types -+ -+ use m_global_parameters !< Definitions of the global parameters -+ -+ use m_variables_conversion !< State variables type conversion procedures -+ -+ use m_helper -+ -+ ! ========================================================================== -+ -+ implicit none -+ -+ private; public :: s_hyperelastic_rmt_stress_update, & -+ s_initialize_hyperelastic_module, & -+ s_finalize_hyperelastic_module -+ -+ !> @name Abstract interface for creating function pointers -+ !> @{ -+ abstract interface -+ -+ !> @name Abstract subroutine for the infinite relaxation solver -+ !> @{ -+ subroutine s_abstract_hyperelastic_solver(btensor, q_prim_vf, G, j, k, l) -+ !$acc routine seq -+ import :: scalar_field, sys_size, b_size -+ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf -+ type(scalar_field), dimension(b_size), intent(inout) :: btensor -+ real(kind(0d0)), intent(in) :: G -+ integer, intent(in) :: j, k, l -+ -+ end subroutine s_abstract_hyperelastic_solver -+ !> @} -+ -+ end interface -+ !> @} -+ -+ procedure(s_abstract_hyperelastic_solver), & -+ pointer :: s_compute_cauchy_solver => null() -+ -+ !! The btensor at the cell-interior Gaussian quadrature points. -+ !! These tensor is needed to be calculated once and make the code DRY. -+ type(vector_field) :: btensor !< -+ !$acc declare create(btensor) -+ -+#ifdef CRAY_ACC_WAR -+ @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), allocatable, dimension(:, :), fd_coeff_x, fd_coeff_y, fd_coeff_z) -+ !$acc declare link(fd_coeff_x,fd_coeff_y,fd_coeff_z) -+ -+#else -+ -+ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_x -+ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_y -+ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_z -+ !$acc declare create(fd_coeff_x,fd_coeff_y,fd_coeff_z) -+ real(kind(0d0)), allocatable, dimension(:) :: Gs -+ !$acc declare create(Gs) -+#endif -+ -+contains -+ -+ !> The following subroutine handles the calculation of the btensor. -+ !! The calculation of the btensor takes qprimvf. -+ !! @param q_prim_vf Primitive variables -+ !! @param btensor is the output -+ !! calculate the grad_xi, grad_xi is a nxn tensor -+ !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor -+ !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor -+ !! btensor is symmetric, save the data space -+ subroutine s_initialize_hyperelastic_module() -+ integer :: i !< generic iterator -+ -+ @:ALLOCATE(btensor%vf(1:b_size)) -+ do i = 1, b_size -+ @:ALLOCATE(btensor%vf(i)%sf(0:m, 0:n, 0:p)) -+ end do -+ @:ACC_SETUP_VFs(btensor) -+ -+ @:ALLOCATE(Gs(1:num_fluids)) -+ !$acc loop seq -+ do i = 1, num_fluids -+ Gs(i) = fluid_pp(i)%G -+ end do -+ !$acc update device(Gs) -+ -+ ! Associating procedural pointer to the subroutine that will be -+ ! utilized to calculate the solution of a given Riemann problem -+ if (hyper_model == 1) then -+ s_compute_cauchy_solver => s_neoHookean_cauchy_solver -+ elseif (riemann_solver == 2) then -+ s_compute_cauchy_solver => s_Mooney_Rivlin_cauchy_solver -+ end if -+ -+ @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) -+ if (n > 0) then -+ @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) -+ end if -+ if (p > 0) then -+ @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) -+ end if -+ -+ ! Computing centered finite difference coefficients -+ call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & -+ fd_number, fd_order) -+ !$acc update device(fd_coeff_x) -+ if (n > 0) then -+ call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & -+ fd_number, fd_order) -+ !$acc update device(fd_coeff_y) -+ end if -+ if (p > 0) then -+ call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & -+ fd_number, fd_order) -+ !$acc update device(fd_coeff_z) -+ end if -+ -+ end subroutine s_initialize_hyperelastic_module -+ -+ !> The following subroutine handles the calculation of the btensor. -+ !! The calculation of the btensor takes qprimvf. -+ !! @param q_prim_vf Primitive variables -+ !! @param btensor is the output -+ !! calculate the grad_xi, grad_xi is a nxn tensor -+ !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor -+ !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor -+ !! btensor is symmetric, save the data space -+ subroutine s_hyperelastic_rmt_stress_update(q_cons_vf,q_prim_vf) -+ -+ type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf -+ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf -+ -+ real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb -+ real(kind(0d0)), dimension(num_fluids) :: alpha_K, alpha_rho_K -+ real(kind(0d0)), dimension(2) :: Re_K -+ real(kind(0d0)) :: rho_K, gamma_K, pi_inf_K, qv_K -+ real(kind(0d0)) :: G_K -+ integer :: j, k, l, i, r -+ -+ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,Re_K, tensora, tensorb) -+ do l = 0, p-2 -+ do k = 0, n-2 -+ do j = 2, m-2 -+ !$acc loop seq -+ do i = 1, num_fluids -+ alpha_rho_K(i) = q_cons_vf(i)%sf(j, k, l) -+ alpha_K(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) -+ end do -+ ! If in simulation, use acc mixture subroutines -+ call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & -+ alpha_rho_K, Re_K, j, k, l, G_K, Gs) -+ rho_K = max(rho_K, sgm_eps) -+ if ( G_K .le. verysmall ) G_K = 0d0 -+ -+ if ( G_K .gt. 20d0 ) then -+ !$acc loop seq -+ do i = 1, tensor_size -+ tensora(i) = 0d0 -+ end do -+ ! STEP 1: computing the grad_xi tensor using finite differences -+ ! grad_xi definition / organization -+ ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx -+ ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy -+ ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz -+ !$acc loop seq -+ do r = -fd_number, fd_number -+ ! derivatives in the x-direction -+ tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) -+ tensora(2) = tensora(2) + q_prim_vf(xibeg+1)%sf(j + r, k, l)*fd_coeff_x(r, j) -+ tensora(3) = tensora(3) + q_prim_vf(xiend)%sf(j + r, k, l)*fd_coeff_x(r, j) -+ ! derivatives in the y-direction -+ tensora(4) = tensora(4) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) -+ tensora(5) = tensora(5) + q_prim_vf(xibeg+1)%sf(j, k + r, l)*fd_coeff_y(r, k) -+ tensora(6) = tensora(6) + q_prim_vf(xiend)%sf(j, k + r, l)*fd_coeff_y(r, k) -+ ! derivatives in the z-direction -+ tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_z(r, l) -+ tensora(8) = tensora(8) + q_prim_vf(xibeg+1)%sf(j, k, l + r)*fd_coeff_z(r, l) -+ tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_z(r, l) -+ end do -+ ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse -+ tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) -+ tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) -+ tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) -+ tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) -+ tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) -+ tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) -+ tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) -+ tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) -+ tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) -+ -+ ! STEP 2b: computing the determinant of the grad_xi tensor -+ tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & -+ - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & -+ + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) -+ -+ if (tensorb(tensor_size) > 0d0) then -+ ! STEP 2c: computing the inverse of grad_xi tensor = F -+ ! tensorb is the adjoint, tensora becomes F -+ !$acc loop seq -+ do i = 1, tensor_size - 1 -+ tensora(i) = tensorb(i)/tensorb(tensor_size) -+ end do -+ -+ ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) -+ tensorb(tensor_size) = 1d0/tensorb(tensor_size) -+ -+ ! STEP 3: computing F tranpose F -+ tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 -+ tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 -+ tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 -+ tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) -+ tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) -+ tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) -+ ! STEP 4: update the btensor, this is consistent with Riemann solvers -+ ! \tau_xx -+ btensor%vf(1)%sf(j, k, l) = tensorb(1) -+ ! \tau_xy -+ btensor%vf(2)%sf(j, k, l) = tensorb(2) -+ ! \tau_yy -+ btensor%vf(3)%sf(j, k, l) = tensorb(5) -+ ! \tau_xz -+ btensor%vf(4)%sf(j, k, l) = tensorb(3) -+ ! \tau_yz -+ btensor%vf(5)%sf(j, k, l) = tensorb(6) -+ ! \tau_zz -+ btensor%vf(6)%sf(j, k, l) = tensorb(9) -+ ! store the determinant at the last entry of the btensor -+ btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) -+ ! STEP 5a: updating the Cauchy stress primitive scalar field -+ call s_compute_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) -+ ! STEP 5b: updating the pressure field -+ q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & -+ G_K*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma_K -+ ! STEP 5c: updating the Cauchy stress conservative scalar field -+ !$acc loop seq -+ do i = 1, b_size - 1 -+ q_cons_vf(strxb + i - 1)%sf(j, k, l) = & -+ rho_K*q_prim_vf(strxb + i - 1)%sf(j, k, l) -+ end do -+ end if -+ end if -+ end do -+ end do -+ end do -+ !$acc end parallel loop -+ end subroutine s_hyperelastic_rmt_stress_update -+ -+ !> The following subroutine handles the calculation of the btensor. -+ !! The calculation of the btensor takes qprimvf. -+ !! @param q_prim_vf Primitive variables -+ !! @param btensor is the output -+ !! calculate the grad_xi, grad_xi is a nxn tensor -+ !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor -+ !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor -+ !! btensor is symmetric, save the data space -+ subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) -+ !$acc routine seq -+ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf -+ type(scalar_field), dimension(b_size), intent(inout) :: btensor -+ real(kind(0d0)), intent(in) :: G -+ integer, intent(in) :: j, k, l -+ -+ real(kind(0d0)) :: trace -+ real(kind(0d0)) :: f13 = 1d0/3d0 -+ integer :: i !< Generic loop iterators -+ -+ !TODO Make this 1D and 2D capable -+ ! tensor is the symmetric tensor & calculate the trace of the tensor -+ trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) -+ -+ ! calculate the deviatoric of the tensor -+ btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace -+ btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace -+ btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace -+ -+ ! dividing by the jacobian for neo-Hookean model -+ ! setting the tensor to the stresses for riemann solver -+ !$acc loop seq -+ do i = 1, b_size - 1 -+ q_prim_vf(strxb + i - 1)%sf(j, k, l) = & -+ G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) -+ end do -+ ! compute the invariant without the elastic modulus -+ q_prim_vf(xiend + 1)%sf(j, k, l) = & -+ 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) -+ -+ end subroutine s_neoHookean_cauchy_solver -+ -+ !> The following subroutine handles the calculation of the btensor. -+ !! The calculation of the btensor takes qprimvf. -+ !! @param q_prim_vf Primitive variables -+ !! @param btensor is the output -+ !! calculate the grad_xi, grad_xi is a nxn tensor -+ !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor -+ !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor -+ !! btensor is symmetric, save the data space -+ subroutine s_Mooney_Rivlin_cauchy_solver(btensor, q_prim_vf, G, j, k, l) -+ !$acc routine seq -+ type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf -+ type(scalar_field), dimension(b_size), intent(inout) :: btensor -+ real(kind(0d0)), intent(in) :: G -+ integer, intent(in) :: j, k, l -+ -+ real(kind(0d0)) :: trace -+ real(kind(0d0)) :: f13 = 1d0/3d0 -+ integer :: i !< Generic loop iterators -+ -+ !TODO Make this 1D and 2D capable -+ ! tensor is the symmetric tensor & calculate the trace of the tensor -+ trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) -+ -+ ! calculate the deviatoric of the tensor -+ btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace -+ btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace -+ btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace -+ -+ ! dividing by the jacobian for neo-Hookean model -+ ! setting the tensor to the stresses for riemann solver -+ !$acc loop seq -+ do i = 1, b_size - 1 -+ q_prim_vf(strxb + i - 1)%sf(j, k, l) = & -+ G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) -+ end do -+ ! compute the invariant without the elastic modulus -+ q_prim_vf(xiend + 1)%sf(j, k, l) = & -+ 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) -+ -+ end subroutine s_Mooney_Rivlin_cauchy_solver -+ -+ -+ subroutine s_finalize_hyperelastic_module() -+ -+ integer :: i !< iterator -+ -+ ! Disassociating procedural pointer to the subroutine which was -+ ! utilized to calculate the solution of a given Riemann problem -+ s_compute_cauchy_solver => null() -+ -+ ! Deallocating memory -+ do i = 1, b_size -+ @:DEALLOCATE_GLOBAL(btensor%vf(i)%sf) -+ end do -+ @:DEALLOCATE_GLOBAL(fd_coeff_x) -+ if (n > 0) then -+ @:DEALLOCATE_GLOBAL(fd_coeff_y) -+ if (p > 0) then -+ @:DEALLOCATE_GLOBAL(fd_coeff_z) -+ end if -+ end if -+ -+ end subroutine s_finalize_hyperelastic_module -+ -+end module m_hyperelastic -diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp -index e3bb7ec0..7f3d54c3 100644 ---- a/src/simulation/m_hypoelastic.fpp -+++ b/src/simulation/m_hypoelastic.fpp -@@ -13,13 +13,16 @@ module m_hypoelastic - - use m_global_parameters !< Definitions of the global parameters - -- use m_mpi_proxy !< Message passing interface (MPI) module proxy -+! use m_mpi_proxy !< Message passing interface (MPI) module proxy -+ -+ use m_helper - - ! ========================================================================== - - implicit none - - private; public :: s_initialize_hypoelastic_module, & -+ s_finalize_hypoelastic_module, & - s_compute_hypoelastic_rhs - - #ifdef CRAY_ACC_WAR -@@ -33,6 +36,10 @@ module m_hypoelastic - - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), rho_K_field, G_K_field) - !$acc declare link(rho_K_field, G_K_field) -+ -+ @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), allocatable, dimension(:, :), fd_coeff_x, fd_coeff_y, fd_coeff_z) -+ !$acc declare link(fd_coeff_x,fd_coeff_y,fd_coeff_z) -+ - #else - real(kind(0d0)), allocatable, dimension(:) :: Gs - !$acc declare create(Gs) -@@ -45,13 +52,17 @@ module m_hypoelastic - real(kind(0d0)), allocatable, dimension(:, :, :) :: rho_K_field, G_K_field - !$acc declare create(rho_K_field, G_K_field) - -+ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_x -+ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_y -+ real(kind(0d0)), allocatable, dimension(:, :) :: fd_coeff_z -+ !$acc declare create(fd_coeff_x,fd_coeff_y,fd_coeff_z) - #endif - - contains - - subroutine s_initialize_hypoelastic_module - -- integer :: i -+ integer :: i, k, r - - @:ALLOCATE_GLOBAL(Gs(1:num_fluids)) - @:ALLOCATE_GLOBAL(rho_K_field(0:m,0:n,0:p), G_K_field(0:m,0:n,0:p)) -@@ -69,6 +80,29 @@ contains - end do - !$acc update device(Gs) - -+ @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) -+ if (n > 0) then -+ @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) -+ end if -+ if (p > 0) then -+ @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) -+ end if -+ -+ ! Computing centered finite difference coefficients -+ call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & -+ fd_number, fd_order) -+ !$acc update device(fd_coeff_x) -+ if (n > 0) then -+ call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & -+ fd_number, fd_order) -+ !$acc update device(fd_coeff_y) -+ end if -+ if (p > 0) then -+ call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & -+ fd_number, fd_order) -+ !$acc update device(fd_coeff_z) -+ end if -+ - end subroutine s_initialize_hypoelastic_module - - !> The purpose of this procedure is to compute the source terms -@@ -84,7 +118,7 @@ contains - - real(kind(0d0)) :: rho_K, G_K - -- integer :: i, k, l, q !< Loop variables -+ integer :: i, k, l, q, r !< Loop variables - integer :: ndirs !< Number of coordinate directions - - ndirs = 1; if (n > 0) ndirs = 2; if (p > 0) ndirs = 3 -@@ -97,82 +131,91 @@ contains - do q = 0, p - do l = 0, n - do k = 0, m -- du_dx(k, l, q) = & -- (q_prim_vf(momxb)%sf(k - 2, l, q) & -- - 8d0*q_prim_vf(momxb)%sf(k - 1, l, q) & -- + 8d0*q_prim_vf(momxb)%sf(k + 1, l, q) & -- - q_prim_vf(momxb)%sf(k + 2, l, q)) & -- /(12d0*dx(k)) -+ du_dx(k, l, q) = 0d0; - end do - end do - end do -+ !$acc end parallel loop -+ -+ !$acc parallel loop collapse(3) gang vector default(present) -+ do q = 0, p -+ do l = 0, n -+ do k = 0, m -+ !$acc loop seq -+ do r = -fd_number, fd_number -+ du_dx(k, l, q) = du_dx(k, l, q) & -+ + q_prim_vf(momxb)%sf(k + r, l, q)*fd_coeff_x(r, k) -+ end do -+ -+ end do -+ end do -+ end do -+ !$acc end parallel loop - - if (ndirs > 1) then - !$acc parallel loop collapse(3) gang vector default(present) - do q = 0, p -- do l = 0, n -- do k = 0, m -- du_dy(k, l, q) = & -- (q_prim_vf(momxb)%sf(k, l - 2, q) & -- - 8d0*q_prim_vf(momxb)%sf(k, l - 1, q) & -- + 8d0*q_prim_vf(momxb)%sf(k, l + 1, q) & -- - q_prim_vf(momxb)%sf(k, l + 2, q)) & -- /(12d0*dy(l)) -- dv_dx(k, l, q) = & -- (q_prim_vf(momxb + 1)%sf(k - 2, l, q) & -- - 8d0*q_prim_vf(momxb + 1)%sf(k - 1, l, q) & -- + 8d0*q_prim_vf(momxb + 1)%sf(k + 1, l, q) & -- - q_prim_vf(momxb + 1)%sf(k + 2, l, q)) & -- /(12d0*dx(k)) -- dv_dy(k, l, q) = & -- (q_prim_vf(momxb + 1)%sf(k, l - 2, q) & -- - 8d0*q_prim_vf(momxb + 1)%sf(k, l - 1, q) & -- + 8d0*q_prim_vf(momxb + 1)%sf(k, l + 1, q) & -- - q_prim_vf(momxb + 1)%sf(k, l + 2, q)) & -- /(12d0*dy(l)) -- end do -+ do l = 0, n -+ do k = 0, m -+ du_dy(k, l, q) = 0d0; dv_dx(k, l, q) = 0d0; dv_dy(k, l, q) = 0d0; - end do -+ end do -+ end do -+ !$acc end parallel loop -+ -+ !$acc parallel loop collapse(3) gang vector default(present) -+ do q = 0, p -+ do l = 0, n -+ do k = 0, m -+ !$acc loop seq -+ do r = -fd_number, fd_number -+ du_dy(k, l, q) = du_dy(k, l, q) & -+ + q_prim_vf(momxb)%sf(k, l + r, q)*fd_coeff_y(r, l) -+ dv_dx(k, l, q) = dv_dx(k, l, q) & -+ + q_prim_vf(momxb + 1)%sf(k + r, l, q)*fd_coeff_x(r, k) -+ dv_dy(k, l, q) = dv_dy(k, l, q) & -+ + q_prim_vf(momxb + 1)%sf(k, l + r, q)*fd_coeff_y(r, l) -+ end do -+ end do -+ end do - end do -+ !$acc end parallel loop - - ! 3D - if (ndirs == 3) then -+ - !$acc parallel loop collapse(3) gang vector default(present) - do q = 0, p -- do l = 0, n -- do k = 0, m -- du_dz(k, l, q) = & -- (q_prim_vf(momxb)%sf(k, l, q - 2) & -- - 8d0*q_prim_vf(momxb)%sf(k, l, q - 1) & -- + 8d0*q_prim_vf(momxb)%sf(k, l, q + 1) & -- - q_prim_vf(momxb)%sf(k, l, q + 2)) & -- /(12d0*dz(q)) -- dv_dz(k, l, q) = & -- (q_prim_vf(momxb + 1)%sf(k, l, q - 2) & -- - 8d0*q_prim_vf(momxb + 1)%sf(k, l, q - 1) & -- + 8d0*q_prim_vf(momxb + 1)%sf(k, l, q + 1) & -- - q_prim_vf(momxb + 1)%sf(k, l, q + 2)) & -- /(12d0*dz(q)) -- dw_dx(k, l, q) = & -- (q_prim_vf(momxe)%sf(k - 2, l, q) & -- - 8d0*q_prim_vf(momxe)%sf(k - 1, l, q) & -- + 8d0*q_prim_vf(momxe)%sf(k + 1, l, q) & -- - q_prim_vf(momxe)%sf(k + 2, l, q)) & -- /(12d0*dx(k)) -- dw_dy(k, l, q) = & -- (q_prim_vf(momxe)%sf(k, l - 2, q) & -- - 8d0*q_prim_vf(momxe)%sf(k, l - 1, q) & -- + 8d0*q_prim_vf(momxe)%sf(k, l + 1, q) & -- - q_prim_vf(momxe)%sf(k, l + 2, q)) & -- /(12d0*dy(l)) -- dw_dz(k, l, q) = & -- (q_prim_vf(momxe)%sf(k, l, q - 2) & -- - 8d0*q_prim_vf(momxe)%sf(k, l, q - 1) & -- + 8d0*q_prim_vf(momxe)%sf(k, l, q + 1) & -- - q_prim_vf(momxe)%sf(k, l, q + 2)) & -- /(12d0*dz(q)) -- end do -+ do l = 0, n -+ do k = 0, m -+ du_dz(k, l, q) = 0d0; dv_dz(k, l, q) = 0d0; dw_dx(k, l, q) = 0d0; -+ dw_dy(k, l, q) = 0d0; dw_dz(k, l, q) = 0d0; - end do -+ end do -+ end do -+ !$acc end parallel loop -+ -+ !$acc parallel loop collapse(3) gang vector default(present) -+ do q = 0, p -+ do l = 0, n -+ do k = 0, m -+ !$acc loop seq -+ do r = -fd_number, fd_number -+ du_dz(k, l, q) = du_dz(k, l, q) & -+ + q_prim_vf(momxb)%sf(k, l, q + r)*fd_coeff_z(r, q) -+ dv_dz(k, l, q) = dv_dz(k, l, q) & -+ + q_prim_vf(momxb + 1)%sf(k, l, q + r)*fd_coeff_z(r, q) -+ dw_dx(k, l, q) = dw_dx(k, l, q) & -+ + q_prim_vf(momxe)%sf(k + r, l, q)*fd_coeff_x(r, k) -+ dw_dy(k, l, q) = dw_dy(k, l, q) & -+ + q_prim_vf(momxe)%sf(k, l + r, q)*fd_coeff_y(r, l) -+ dw_dz(k, l, q) = dw_dz(k, l, q) & -+ + q_prim_vf(momxe)%sf(k, l, q + r)*fd_coeff_z(r, q) -+ end do -+ end do -+ end do - end do -+ !$acc end parallel loop - end if - end if - -@@ -189,7 +232,7 @@ contains - G_K_field(k, l, q) = G_K - - !TODO: take this out if not needed -- if (G_K < 1000) then -+ if (G_K < verysmall) then - G_K_field(k, l, q) = 0 - end if - end do -@@ -314,4 +357,21 @@ contains - - end subroutine s_compute_hypoelastic_rhs - -+ subroutine s_finalize_hypoelastic_module() ! -------------------- -+ -+ @:DEALLOCATE_GLOBAL(Gs) -+ @:DEALLOCATE_GLOBAL(rho_K_field, G_K_field) -+ @:DEALLOCATE_GLOBAL(du_dx) -+ @:DEALLOCATE_GLOBAL(fd_coeff_x) -+ if (n > 0) then -+ @:DEALLOCATE_GLOBAL(du_dy,dv_dx,dv_dy) -+ @:DEALLOCATE_GLOBAL(fd_coeff_y) -+ if (p > 0) then -+ @:DEALLOCATE_GLOBAL(du_dz, dv_dz, dw_dx, dw_dy, dw_dz) -+ @:DEALLOCATE_GLOBAL(fd_coeff_z) -+ end if -+ end if -+ -+ end subroutine s_finalize_hypoelastic_module -+ - end module m_hypoelastic -diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp -index a0fa5972..01c34581 100644 ---- a/src/simulation/m_ibm.fpp -+++ b/src/simulation/m_ibm.fpp -@@ -208,7 +208,7 @@ contains - - if (model_eqns /= 4) then - ! If in simulation, use acc mixture subroutines -- if (hypoelasticity) then -+ if (elasticity) then - call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv_K, alpha_IP, & - alpha_rho_IP, Re_K, j, k, l, G_K, Gs) - else if (bubbles) then -diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp -index 26700d16..513d5bec 100644 ---- a/src/simulation/m_mpi_proxy.fpp -+++ b/src/simulation/m_mpi_proxy.fpp -@@ -173,7 +173,40 @@ contains - !! available to the other processors. Then, the purpose of - !! this subroutine is to distribute the user inputs to the - !! remaining processors in the communicator. -- subroutine s_mpi_bcast_user_inputs -+ -+ subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root) -+ -+#ifdef MFC_MPI -+ -+ implicit none -+ integer, intent(in) :: counts ! Array of vector lengths for each process -+ real(kind(0d0)), intent(in), dimension(counts) :: my_vector ! Input vector on each process -+ integer, intent(in) :: root ! Rank of the root process -+ real(kind(0d0)), allocatable, intent(out) :: gathered_vector(:) ! Gathered vector on the root process -+ -+ integer :: i, offset, ierr -+ integer, allocatable :: recounts(:), displs(:) -+ -+ allocate (recounts(num_procs)) -+ -+ call MPI_GATHER(counts, 1, MPI_INTEGER, recounts, 1, MPI_INTEGER, root, & -+ MPI_COMM_WORLD, ierr) -+ -+ allocate (displs(size(recounts))) -+ -+ displs(1) = 0 -+ -+ do i = 2, size(recounts) -+ displs(i) = displs(i - 1) + recounts(i - 1) -+ end do -+ -+ allocate (gathered_vector(sum(recounts))) -+ call MPI_GATHERV(my_vector, counts, MPI_DOUBLE_PRECISION, gathered_vector, recounts, displs, MPI_DOUBLE_PRECISION, & -+ root, MPI_COMM_WORLD, ierr) -+#endif -+ end subroutine s_mpi_gather_data -+ -+ subroutine s_mpi_bcast_user_inputs() ! --------------------------------- - - #ifdef MFC_MPI - -@@ -202,7 +235,8 @@ contains - & 'parallel_io', 'hypoelasticity', 'bubbles', 'polytropic', & - & 'polydisperse', 'qbmm', 'acoustic_source', 'probe_wrt', 'integral_wrt', & - & 'prim_vars_wrt', 'weno_avg', 'file_per_process', 'relax', & -- & 'adv_n', 'adap_dt', 'ib', 'bodyForces', 'bf_x', 'bf_y', 'bf_z' ] -+ & 'adv_n', 'adap_dt', 'ib', 'bodyForces', 'bf_x', 'bf_y', 'bf_z', & -+ & 'hyperelasticity' ] - call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) - #:endfor - -@@ -212,7 +246,8 @@ contains - & 'bc_y%vb1','bc_y%vb2','bc_y%vb3','bc_y%ve1','bc_y%ve2','bc_y%ve3', & - & 'bc_z%vb1','bc_z%vb2','bc_z%vb3','bc_z%ve1','bc_z%ve2','bc_z%ve3', & - & 'x_domain%beg', 'x_domain%end', 'y_domain%beg', 'y_domain%end', & -- & 'z_domain%beg', 'z_domain%end'] -+ & 'z_domain%beg', 'z_domain%end', 'x_a', 'x_b', 'y_a', 'y_b', 'z_a', & -+ & 'z_b'] - call MPI_BCAST(${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - #:endfor - -diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp -index c2056b42..72bb1c87 100644 ---- a/src/simulation/m_rhs.fpp -+++ b/src/simulation/m_rhs.fpp -@@ -39,6 +39,8 @@ module m_rhs - - use m_hypoelastic - -+ use m_hyperelastic -+ - use m_acoustic_src - - use m_viscous -@@ -615,7 +617,6 @@ contains - if (riemann_solver /= 1) then - do l = adv_idx%beg + 1, adv_idx%end - flux_src_n(i)%vf(l)%sf => flux_src_n(i)%vf(adv_idx%beg)%sf -- - !$acc enter data attach(flux_src_n(i)%vf(l)%sf) - end do - end if -@@ -623,7 +624,6 @@ contains - do l = 1, sys_size - flux_n(i)%vf(l)%sf => flux_n(1)%vf(l)%sf - flux_src_n(i)%vf(l)%sf => flux_src_n(1)%vf(l)%sf -- - !$acc enter data attach(flux_n(i)%vf(l)%sf,flux_src_n(i)%vf(l)%sf) - end do - end if -@@ -778,7 +778,7 @@ contains - end do - end do - end if -- -+ !print *, "I got here A" - call nvtxStartRange("RHS-CONVERT") - call s_convert_conservative_to_primitive_variables( & - q_cons_qp%vf, & -@@ -786,10 +786,16 @@ contains - gm_alpha_qp%vf, & - ix, iy, iz) - call nvtxEndRange -+ !print *, "I got here B" - - call nvtxStartRange("RHS-MPI") - call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) - call nvtxEndRange -+ !print *, "I got here c" -+ -+ call nvtxStartRange("RHS-ELASTIC") -+ if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_qp%vf,q_prim_qp%vf) -+ call nvtxEndRange - - if (t_step == t_step_stop) return - ! ================================================================== -@@ -897,10 +903,8 @@ contains - end if - ix%end = m; iy%end = n; iz%end = p - ! =============================================================== -- call nvtxStartRange("RHS_riemann_solver") -- - ! Computing Riemann Solver Flux and Source Flux ================= -- -+ call nvtxStartRange("RHS_riemann_solver") - call s_riemann_solver(qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, & - dqR_prim_dx_n(id)%vf, & - dqR_prim_dy_n(id)%vf, & -@@ -917,9 +921,10 @@ contains - flux_gsrc_n(id)%vf, & - id, ix, iy, iz) - call nvtxEndRange -+ !print *, "I got here e" - -- ! Additional physics and source terms ============================== -- -+ ! =============================================================== -+ ! Additional physics and source terms =========================== - ! RHS addition for advection source - call nvtxStartRange("RHS_advection_source") - call s_compute_advection_source_term(id, & -@@ -935,6 +940,7 @@ contains - q_prim_qp%vf, & - rhs_vf) - call nvtxEndRange -+ !print *, "I got here f" - - ! RHS additions for viscosity - call nvtxStartRange("RHS_add_phys") -@@ -1006,6 +1012,7 @@ contains - rhs_vf) - call nvtxEndRange - ! END: Additional pphysics and source terms ============================ -+ !print *, "I got here g" - - if (run_time_info .or. probe_wrt .or. ib) then - -@@ -1033,6 +1040,7 @@ contains - time_avg = 0d0 - end if - ! ================================================================== -+ !print *, "I got here h" - - call nvtxEndRange - end subroutine s_compute_rhs -diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp -index bfca7142..16b20b02 100644 ---- a/src/simulation/m_riemann_solvers.fpp -+++ b/src/simulation/m_riemann_solvers.fpp -@@ -162,14 +162,14 @@ module m_riemann_solvers - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsx_vf, flux_src_rsx_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsy_vf, flux_src_rsy_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsz_vf, flux_src_rsz_vf) -- !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & -- !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) -+ !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & -+ !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) - #else - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsx_vf, flux_src_rsx_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsy_vf, flux_src_rsy_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsz_vf, flux_src_rsz_vf -- !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & -- !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) -+ !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & -+ !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf) - #endif - !> @} - -@@ -313,6 +313,7 @@ contains - real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R - real(kind(0d0)) :: G_L, G_R - real(kind(0d0)), dimension(2) :: Re_L, Re_R -+ real(kind(0d0)), dimension(3) :: xi_field_L, xi_field_R - - real(kind(0d0)) :: rho_avg - real(kind(0d0)), dimension(num_dims) :: vel_avg -@@ -356,8 +357,7 @@ contains - #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] - - if (norm_dir == ${NORM_DIR}$) then -- !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, & -- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S) -+ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, xi_field_L, xi_field_R) - do l = is3%beg, is3%end - do k = is2%beg, is2%end - do j = is1%beg, is1%end -@@ -440,31 +440,24 @@ contains - !$acc loop seq - do i = 1, 2 - Re_L(i) = dflt_real -- - if (Re_size(i) > 0) Re_L(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_L(i) = alpha_L(Re_idx(i, q))/Res(i, q) & - + Re_L(i) - end do -- - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) -- - end do - - !$acc loop seq - do i = 1, 2 - Re_R(i) = dflt_real -- - if (Re_size(i) > 0) Re_R(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_R(i) = alpha_R(Re_idx(i, q))/Res(i, q) & - + Re_R(i) - end do -- - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) - end do - end if -@@ -472,26 +465,17 @@ contains - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R - -- H_L = (E_L + pres_L)/rho_L -- H_R = (E_R + pres_R)/rho_R -- -+ ! elastic energy update - if (hypoelasticity) then -- !$acc loop seq -- do i = 1, strxe - strxb + 1 -- tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -- tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -- end do -- -- G_L = 0d0 -- G_R = 0d0 -- -+ G_L = 0d0; G_R = 0d0 - !$acc loop seq - do i = 1, num_fluids - G_L = G_L + alpha_L(i)*Gs(i) - G_R = G_R + alpha_R(i)*Gs(i) - end do -- - do i = 1, strxe - strxb + 1 -+ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) - ! Elastic contribution to energy if G large enough - !TODO take out if statement if stable without - if ((G_L > 1000) .and. (G_R > 1000)) then -@@ -506,19 +490,57 @@ contains - end do - end if - -+ ! elastic energy update -+ !if ( hyperelasticity ) then -+ ! G_L = 0d0 -+ ! G_R = 0d0 -+ ! -+ ! !$acc loop seq -+ ! do i = 1, num_fluids -+ ! G_L = G_L + alpha_L(i)*Gs(i) -+ ! G_R = G_R + alpha_R(i)*Gs(i) -+ ! end do -+ ! ! Elastic contribution to energy if G large enough -+ ! if ((G_L > 1d-3) .and. (G_R > 1d-3)) then -+ ! E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) -+ ! E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) -+ ! !$acc loop seq -+ ! do i = 1, b_size-1 -+ ! tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ ! tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -+ ! end do -+ ! !$acc loop seq -+ ! do i = 1, b_size-1 -+ ! tau_e_L(i) = 0d0 -+ ! tau_e_R(i) = 0d0 -+ ! end do -+ ! !$acc loop seq -+ ! do i = 1, num_dims -+ ! xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) -+ ! xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) -+ ! end do -+ ! end if -+ !end if -+ -+ ! Enthalpy with elastic energy -+ H_L = (E_L + pres_L)/rho_L -+ H_R = (E_R + pres_R)/rho_R -+ - @:compute_average_state() - - call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & -- vel_L_rms, c_L) -+ vel_L_rms, c_L, Gs) - - call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & -- vel_R_rms, c_R) -+ vel_R_rms, c_R, Gs) - - !> The computation of c_avg does not require all the variables, and therefore the non '_avg' - ! variables are placeholders to call the subroutine. - - call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & -- vel_avg_rms, c_avg) -+ vel_avg_rms, c_avg, Gs) -+ -+ !SGR added Gs to all of the above speed of sound clacs - - if (any(Re_size > 0)) then - !$acc loop seq -@@ -541,6 +563,11 @@ contains - , vel_L(dir_idx(1)) + sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + & - tau_e_L(dir_idx_tau(1)))/rho_L)) -+ else if (hyperelasticity) then -+ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L) & -+ , vel_R(dir_idx(1)) - sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R)) -+ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R) & -+ , vel_L(dir_idx(1)) + sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L)) - else - s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) - s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) -@@ -716,6 +743,18 @@ contains - /(s_M - s_P) - end do - -+ ! Xi field -+ !if ( hyperelasticity ) then -+ ! do i = 1, num_dims -+ ! flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & -+ ! (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & -+ ! - s_P*rho_L*vel_L(dir_idx(1))*xi_field_L(i) & -+ ! + s_M*s_P*(rho_L*xi_field_L(i) & -+ ! - rho_R*xi_field_R(i))) & -+ ! /(s_M - s_P) -+ ! end do -+ !end if -+ - ! Div(U)? - !$acc loop seq - do i = 1, num_dims -@@ -822,7 +861,6 @@ contains - - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf -- - type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf - - type(scalar_field), & -@@ -862,6 +900,11 @@ contains - real(kind(0d0)) :: s_L, s_R, s_M, s_P, s_S - real(kind(0d0)) :: xi_L, xi_R !< Left and right wave speeds functions - real(kind(0d0)) :: xi_M, xi_P -+ real(kind(0d0)) :: xi_MP, xi_PP -+ -+ real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R -+ real(kind(0d0)), dimension(num_dims) :: xi_field_L, xi_field_R -+ real(kind(0d0)) :: G_L, G_R - - real(kind(0d0)) :: nbub_L, nbub_R - real(kind(0d0)), dimension(nb) :: R0_L, R0_R -@@ -880,9 +923,10 @@ contains - real(kind(0d0)) :: vel_L_rms, vel_R_rms, vel_avg_rms - real(kind(0d0)) :: vel_L_tmp, vel_R_tmp - real(kind(0d0)) :: blkmod1, blkmod2 -- real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star -+ real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star, vel_K_Star - real(kind(0d0)) :: pres_SL, pres_SR, Ms_L, Ms_R - real(kind(0d0)) :: start, finish -+ real(kind(0d0)) :: flux_ene_e - real(kind(0d0)) :: zcoef, pcorr !< low Mach number correction - integer :: i, j, k, l, q !< Generic loop iterators - integer :: idx1, idxi -@@ -909,15 +953,16 @@ contains - flux_gsrc_vf, & - norm_dir, ix, iy, iz) - -+ idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 -+ - #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] - - if (norm_dir == ${NORM_DIR}$) then -+ -+ ! 6-EQUATION MODEL WITH HLLC - if (model_eqns == 3) then - !ME3 -- -- !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & -- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R) -- -+ !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R, flux_ene_e, xi_field_L, xi_field_R) - do l = is3%beg, is3%end - do k = is2%beg, is2%end - do j = is1%beg, is1%end -@@ -994,39 +1039,85 @@ contains - !$acc loop seq - do i = 1, 2 - Re_L(i) = dflt_real -- - if (Re_size(i) > 0) Re_L(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q))/Res(i, q) & - + Re_L(i) - end do -- - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) -- - end do - - !$acc loop seq - do i = 1, 2 - Re_R(i) = dflt_real -- - if (Re_size(i) > 0) Re_R(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res(i, q) & - + Re_R(i) - end do -- - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) - end do - end if - - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L -- - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R - -+ ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY -+ if (hypoelasticity) then -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -+ end do -+ G_L = 0d0; G_R = 0d0 -+ !$acc loop seq -+ do i = 1, num_fluids -+ G_L = G_L + alpha_L(i)*Gs(i) -+ G_R = G_R + alpha_R(i)*Gs(i) -+ end do -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ ! Elastic contribution to energy if G large enough -+ if ((G_L > verysmall) .and. (G_R > verysmall)) then -+ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) -+ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) -+ ! Additional terms in 2D and 3D -+ if ((i == 2) .or. (i == 4) .or. (i == 5)) then -+ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) -+ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) -+ end if -+ end if -+ end do -+ end if -+ -+ ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY -+ if (hyperelasticity) then -+ !$acc loop seq -+ do i = 1, num_dims -+ xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) -+ xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) -+ end do -+ G_L = 0d0; G_R = 0d0; -+ !$acc loop seq -+ do i = 1, num_fluids -+ ! Mixture left and right shear modulus -+ G_L = G_L + alpha_L(i)*Gs(i) -+ G_R = G_R + alpha_R(i)*Gs(i) -+ end do -+ ! Elastic contribution to energy if G large enough -+ if ( G_L > verysmall .and. G_R > verysmall ) then -+ E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) -+ E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) -+ end if -+ !$acc loop seq -+ do i = 1, b_size - 1 -+ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -+ end do -+ end if -+ - H_L = (E_L + pres_L)/rho_L - H_R = (E_R + pres_R)/rho_R - -@@ -1034,13 +1125,10 @@ contains - - call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & - vel_L_rms, c_L) -- - call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & - vel_R_rms, c_R) -- - !> The computation of c_avg does not require all the variables, and therefore the non '_avg' - ! variables are placeholders to call the subroutine. -- - call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & - vel_avg_rms, c_avg) - -@@ -1051,222 +1139,226 @@ contains - end do - end if - -+ ! COMPUTING THE DIRECT WAVE SPEEDS - if (wave_speeds == 1) then -- s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) -- s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) -+ if (elasticity) then -+ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & -+ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & -+ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) -+ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & -+ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & -+ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) -+ s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & -+ tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & -+ rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & -+ rho_R*(s_R - vel_R(idx1))) -+ else -+ s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) -+ s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) -+ s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & -+ (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & -+ /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) - -- s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & -- (s_L - vel_L(dir_idx(1))) - & -- rho_R*vel_R(dir_idx(1))* & -- (s_R - vel_R(dir_idx(1)))) & -- /(rho_L*(s_L - vel_L(dir_idx(1))) - & -- rho_R*(s_R - vel_R(dir_idx(1)))) -+ end if - elseif (wave_speeds == 2) then - pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & - (vel_L(dir_idx(1)) - & - vel_R(dir_idx(1)))) -- - pres_SR = pres_SL -- - Ms_L = max(1d0, sqrt(1d0 + ((5d-1 + gamma_L)/(1d0 + gamma_L))* & - (pres_SL/pres_L - 1d0)*pres_L/ & - ((pres_L + pi_inf_L/(1d0 + gamma_L))))) - Ms_R = max(1d0, sqrt(1d0 + ((5d-1 + gamma_R)/(1d0 + gamma_R))* & - (pres_SR/pres_R - 1d0)*pres_R/ & - ((pres_R + pi_inf_R/(1d0 + gamma_R))))) -- - s_L = vel_L(dir_idx(1)) - c_L*Ms_L - s_R = vel_R(dir_idx(1)) + c_R*Ms_R -- - s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & - (pres_L - pres_R)/ & - (rho_avg*c_avg)) - end if - -- if (s_L >= 0d0) then -- p_Star = pres_L ! Only useful to recalculate the radial momentum geometric source flux -- !$acc loop seq -- do i = 1, num_fluids -- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)*s_S -+ ! follows Einfeldt et al. -+ ! s_M/P = min/max(0.,s_L/R) -+ s_M = min(0d0, s_L); s_P = max(0d0, s_R) - -- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)*vel_L(dir_idx(1)) -+ ! goes with q_star_L/R = xi_L/R * (variable) -+ ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) ) -+ xi_L = (s_L - vel_L(idx1))/(s_L - s_S) -+ xi_R = (s_R - vel_R(idx1))/(s_R - s_S) - -- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & -- (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & -- (gammas(i)*pres_L + pi_infs(i)) + & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & -- qvs(i))*vel_L(dir_idx(1)) -- end do -- !$acc loop seq -- do i = 1, num_dims -- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & -- rho_L*vel_L(dir_idx(1))*vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*pres_L -+ ! goes with numerical star velocity in x/y/z directions -+ ! xi_P/M = 0.5 +/m sgn(0.5,s_star) -+ xi_M = (5d-1 + sign(5d-1, s_S)) -+ xi_P = (5d-1 - sign(5d-1, s_S)) - -- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & -- dir_flg(dir_idx(i))*(s_S - vel_L(dir_idx(i))) -- ! Compute the star velocities for the non-conservative terms -- end do -- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_L + pres_L)*vel_L(dir_idx(1)) -+ ! goes with the numerical velocity in x/y/z directions -+ ! xi_P/M (pressure) = min/max(0. sgn(1,sL/sR)) -+ xi_MP = -min(0d0, sign(1d0, s_L)) -+ xi_PP = max(0d0, sign(1d0, s_R)) - -- if (.not. f_is_default(sigma)) then -- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, c_idx)*s_S -- end if -+ ! COMPUTING FLUXES -+ ! MASS FLUX. -+ !$acc loop seq -+ do i = 1, contxe -+ flux_rs${XYZ}$_vf(j, k, l, i) = & -+ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & -+ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) -+ end do - -- ! Compute right solution state -- else if (s_R <= 0d0) then -- p_Star = pres_R -- ! Only useful to recalculate the radial momentum geometric source flux -- !$acc loop seq -- do i = 1, num_fluids -- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)*s_S -+ ! MOMENTUM FLUX. -+ ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) -+ !$acc loop seq -+ do i = 1, num_dims -+ !idxi = dir_idx(i) -+ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & -+ xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & -+ (1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & -+ xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & -+ (1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) -+ end do - -- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)*vel_R(dir_idx(1)) -+ ! ENERGY FLUX. -+ ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) -+ flux_rs${XYZ}$_vf(j, k, l, E_idx) = & -+ xi_M*(vel_L(idx1)*(E_L + pres_L) + & -+ s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & -+ + xi_P*(vel_R(idx1)*(E_R + pres_R) + & -+ s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) -+ -+ ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux -+ if (elasticity) then -+ flux_ene_e = 0d0; -+ !$acc loop seq -+ do i = 1, num_dims -+ ! MOMENTUM ELASTIC FLUX. -+ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & -+ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) & -+ - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) -+ ! ENERGY ELASTIC FLUX. -+ flux_ene_e = flux_ene_e - & -+ xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & -+ s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & -+ xi_P*(vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & -+ s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) -+ end do -+ flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e -+ end if - -- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & -- (qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)* & -- (gammas(i)*pres_R + pi_infs(i)) + & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)* & -- qvs(i))*vel_R(dir_idx(1)) -- end do -- !$acc loop seq -- do i = 1, num_dims -- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & -- rho_R*vel_R(dir_idx(1))*vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*pres_R -+ ! VOLUME FRACTION FLUX. -+ !$acc loop seq -+ do i = advxb, advxe -+ flux_rs${XYZ}$_vf(j, k, l, i) = & -+ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*s_S + & -+ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*s_S -+ end do - -- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & -- dir_flg(dir_idx(i))*(s_S - vel_R(dir_idx(i))) -- ! Compute the star velocities for the non-conservative terms -- end do -- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_R + pres_R)*vel_R(dir_idx(1)) -+ ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. -+ !$acc loop seq -+ do i = 1, num_dims -+ !idxi = dir_idx(i) -+ vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = & -+ xi_M*(vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_MP*(xi_L - 1) + 1) - vel_L(dir_idx(i)))) + & -+ xi_P*(vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(dir_idx(i)))) -+ end do - -- if (.not. f_is_default(sigma)) then -- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx)*s_S -- end if -+ ! INTERNAL ENERGIES ADVECTION FLUX. -+ ! K-th pressure and velocity in preparation for the internal energy flux -+ vel_K_Star = vel_L(idx1)*(1d0 - xi_MP) + xi_MP*vel_R(idx1) + & -+ xi_MP*xi_PP*(s_S - vel_R(idx1)) -+ !$acc loop seq -+ do i = 1, num_fluids -+ p_K_Star = xi_M*(xi_MP*((pres_L + pi_infs(i)/(1d0 + gammas(i)))* & -+ xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - pres_L) + pres_L) + & -+ xi_P*(xi_PP*((pres_R + pi_infs(i)/(1d0 + gammas(i)))* & -+ xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - pres_R) + pres_R) -+ -+ flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & -+ (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & -+ (gammas(i)*p_K_Star + pi_infs(i)) + & -+ qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & -+ qvs(i))*vel_K_Star -+ end do - -- ! Compute left star solution state -- else if (s_S >= 0d0) then -- xi_L = (s_L - vel_L(dir_idx(1)))/(s_L - s_S) -- rho_Star = rho_L*xi_L -- E_Star = xi_L*(E_L + (s_S - vel_L(dir_idx(1)))* & -- (rho_L*s_S + pres_L/(s_L - vel_L(dir_idx(1))))) -- p_Star = rho_L*(s_L - vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1))) + pres_L -- !$acc loop seq -- do i = 1, num_fluids -- p_K_Star = (pres_L + pi_infs(i)/(1d0 + gammas(i)))* & -- xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) -+ flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) - -- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)*s_S -+ ! HYPOELASTIC STRESS EVOLUTION FLUX. -+ if (hypoelasticity) then -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & -+ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & -+ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) -+ end do -+ end if - -- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)*xi_L*s_S -+ ! REFERENCE MAP FLUX. -+ if (hyperelasticity) then -+ !$acc loop seq -+ do i = 1, num_dims -+ flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & -+ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*xi_field_L(i) & -+ - rho_L*vel_L(idx1)*xi_field_L(i)) + & -+ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*xi_field_R(i) & -+ - rho_R*vel_R(idx1)*xi_field_R(i)) -+ end do -+ end if - -- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & -- (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & -- (gammas(i)*p_K_Star + pi_infs(i)) + & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & -- qvs(i))*s_S -- end do -- !$acc loop seq -- do i = 1, num_dims -- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & -- rho_Star*s_S*(s_S*dir_flg(dir_idx(i)) + vel_L(dir_idx(i))* & -- (1d0 - dir_flg(dir_idx(i)))) + dir_flg(dir_idx(i))*p_Star -+ ! SURFACE TENSION FLUX. need to check -+ if (.not. f_is_default(sigma)) then -+ flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -+ (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & -+ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S -+ end if - -- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & -- dir_flg(dir_idx(i))*(s_S*xi_L - vel_L(dir_idx(i))) -- ! Compute the star velocities for the non-conservative terms -- end do -- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_Star + p_Star)*s_S -+ ! correction pressure for the cylindrical terms -+ p_Star = xi_M*(pres_L + xi_MP*rho_L*(s_L - & -+ vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1)))) + & -+ xi_P*(pres_R + xi_PP*rho_R*(s_R - & -+ vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1)))) - -- if (.not. f_is_default(sigma)) then -- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, c_idx)*s_S -+ ! Geometrical source flux for cylindrical coordinates -+ #:if (NORM_DIR == 2) -+ if (cyl_coord) then -+ !Substituting the advective flux into the inviscid geometrical source flux -+ !$acc loop seq -+ do i = 1, E_idx -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) -+ end do -+ !$acc loop seq -+ do i = intxb, intxe -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) -+ end do -+ ! Recalculating the radial momentum geometric source flux -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star -+ ! Geometrical source of the void fraction(s) is zero -+ !$acc loop seq -+ do i = advxb, advxe -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 -+ end do - end if -+ #:endif -+ #:if (NORM_DIR == 3) -+ if (grid_geometry == 3) then -+ !$acc loop seq -+ do i = 1, sys_size -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 -+ end do -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star - -- ! Compute right star solution state -- else -- xi_R = (s_R - vel_R(dir_idx(1)))/(s_R - s_S) -- -- rho_Star = rho_R*xi_R -- -- E_Star = xi_R*(E_R + (s_S - vel_R(dir_idx(1)))* & -- (rho_R*s_S + pres_R/(s_R - vel_R(dir_idx(1))))) -- -- p_Star = rho_R*(s_R - vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1))) + pres_R -- !$acc loop seq -- do i = 1, num_fluids -- p_K_Star = (pres_R + pi_infs(i)/(1d0 + gammas(i)))* & -- xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) -- -- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)*s_S -- -- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)*xi_R*s_S -- -- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & -- (qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)* & -- (gammas(i)*p_K_Star + pi_infs(i)) + & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)* & -- qvs(i))*s_S -- end do -- !$acc loop seq -- do i = 1, num_dims -- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = rho_Star*s_S* & -- (s_S*dir_flg(dir_idx(i)) + vel_R(dir_idx(i))*(1d0 - dir_flg(dir_idx(i)))) + & -- dir_flg(dir_idx(i))*p_Star -- -- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & -- dir_flg(dir_idx(i))*(s_S*xi_R - vel_R(dir_idx(i))) -- ! Compute the star velocities for the non-conservative terms -- end do -- -- if (.not. f_is_default(sigma)) then -- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx)*s_S -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) - end if -- -- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_Star + p_Star)*s_S -- -- end if -- -- flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) -- -- ! Geometrical source flux for cylindrical coordinates -- if (cyl_coord .and. norm_dir == 2) then -- ! Substituting the advective flux into the inviscid geometrical source flux -- !$acc loop seq -- do i = 1, E_idx -- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) -- end do -- !$acc loop seq -- do i = intxb, intxe -- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) -- end do -- ! Recalculating the radial momentum geometric source flux (subtracting the pressure part) -- flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & -- flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star -- ! Geometrical source of the void fraction(s) is zero -- !$acc loop seq -- do i = advxb, advxe -- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 -- end do -- end if -+ #:endif - - end do - end do - end do -+ - elseif (model_eqns == 4) then - !ME4 -- !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, & -- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) -+ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) - do l = is3%beg, is3%end - do k = is2%beg, is2%end - do j = is1%beg, is1%end -@@ -1632,11 +1724,11 @@ contains - end if - - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms -- - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms - - H_L = (E_L + pres_L)/rho_L - H_R = (E_R + pres_R)/rho_R -+ - if (avg_state == 2) then - !$acc loop seq - do i = 1, nb -@@ -1749,13 +1841,11 @@ contains - - call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & - vel_L_rms, c_L) -- - call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & - vel_R_rms, c_R) - - !> The computation of c_avg does not require all the variables, and therefore the non '_avg' - ! variables are placeholders to call the subroutine. -- - call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & - vel_avg_rms, c_avg) - -@@ -1861,7 +1951,6 @@ contains - - ! Energy flux. - ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) -- - flux_rs${XYZ}$_vf(j, k, l, E_idx) = & - xi_M*(vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) + & - s_M*(xi_L*(E_L + (s_S - vel_L(dir_idx(1)))* & -@@ -1874,7 +1963,6 @@ contains - + (s_M/s_L)*(s_P/s_R)*pcorr*s_S - - ! Volume fraction flux -- - !$acc loop seq - do i = advxb, advxe - flux_rs${XYZ}$_vf(j, k, l, i) = & -@@ -1980,8 +2068,10 @@ contains - end do - !$acc end parallel loop - else -+ ! 5-EQUATION MODEL WITH HLLC, INTERFACE CAPTURING ONLY - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & -- !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp) copyin(is1,is2,is3) -+ !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, & -+ !$acc tau_e_L, tau_e_R, xi_field_L, xi_field_R, vel_L_tmp, vel_R_tmp) copyin(is1,is2,is3) - do l = is3%beg, is3%end - do k = is2%beg, is2%end - do j = is1%beg, is1%end -@@ -2064,39 +2154,85 @@ contains - !$acc loop seq - do i = 1, 2 - Re_L(i) = dflt_real -- - if (Re_size(i) > 0) Re_L(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q))/Res(i, q) & - + Re_L(i) - end do -- - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) -- - end do - - !$acc loop seq - do i = 1, 2 - Re_R(i) = dflt_real -- - if (Re_size(i) > 0) Re_R(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res(i, q) & - + Re_R(i) - end do -- - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) - end do - end if - - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L -- - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R - -+ ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY -+ if (hypoelasticity) then -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -+ end do -+ G_L = 0d0; G_R = 0d0 -+ !$acc loop seq -+ do i = 1, num_fluids -+ G_L = G_L + alpha_L(i)*Gs(i) -+ G_R = G_R + alpha_R(i)*Gs(i) -+ end do -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ ! Elastic contribution to energy if G large enough -+ if ((G_L > verysmall) .and. (G_R > verysmall)) then -+ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) -+ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) -+ ! Additional terms in 2D and 3D -+ if ((i == 2) .or. (i == 4) .or. (i == 5)) then -+ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) -+ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) -+ end if -+ end if -+ end do -+ end if -+ -+ ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY -+ if (hyperelasticity) then -+ !$acc loop seq -+ do i = 1, num_dims -+ xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) -+ xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) -+ end do -+ G_L = 0d0; G_R = 0d0; -+ !$acc loop seq -+ do i = 1, num_fluids -+ ! Mixture left and right shear modulus -+ G_L = G_L + alpha_L(i)*Gs(i) -+ G_R = G_R + alpha_R(i)*Gs(i) -+ end do -+ ! Elastic contribution to energy if G large enough -+ if ( G_L > verysmall .and. G_R > verysmall ) then -+ E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) -+ E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) -+ end if -+ !$acc loop seq -+ do i = 1, b_size - 1 -+ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -+ end do -+ end if -+ - H_L = (E_L + pres_L)/rho_L - H_R = (E_R + pres_R)/rho_R - -@@ -2110,7 +2246,6 @@ contains - - !> The computation of c_avg does not require all the variables, and therefore the non '_avg' - ! variables are placeholders to call the subroutine. -- - call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & - vel_avg_rms, c_avg) - -@@ -2126,16 +2261,25 @@ contains - end if - - if (wave_speeds == 1) then -- s_L = min(vel_L(idx1) - c_L, vel_R(idx1) - c_R) -- s_R = max(vel_R(idx1) + c_R, vel_L(idx1) + c_L) -- -- s_S = (pres_R - pres_L + rho_L*vel_L(idx1)* & -- (s_L - vel_L(idx1)) - & -- rho_R*vel_R(idx1)* & -- (s_R - vel_R(idx1))) & -- /(rho_L*(s_L - vel_L(idx1)) - & -- rho_R*(s_R - vel_R(idx1))) -+ if (elasticity) then -+ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & -+ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & -+ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) -+ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & -+ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & -+ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) -+ s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & -+ tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & -+ rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & -+ rho_R*(s_R - vel_R(idx1))) -+ else -+ s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) -+ s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) -+ s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & -+ (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & -+ /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) - -+ end if - elseif (wave_speeds == 2) then - pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & - (vel_L(idx1) - & -@@ -2172,6 +2316,8 @@ contains - xi_M = (5d-1 + sign(5d-1, s_S)) - xi_P = (5d-1 - sign(5d-1, s_S)) - -+ ! COMPUTING THE HLLC FLUXES -+ ! MASS FLUX. - if (low_Mach == 1) then - @:compute_low_Mach_correction() - else -@@ -2181,15 +2327,13 @@ contains - !$acc loop seq - do i = 1, contxe - flux_rs${XYZ}$_vf(j, k, l, i) = & -- xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & -- *(vel_L(idx1) + s_M*(xi_L - 1d0)) & -- + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & -- *(vel_R(idx1) + s_P*(xi_R - 1d0)) -+ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & -+ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) - end do - -- ! Momentum flux. -- ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w) -- !$acc loop seq -+ ! MOMENTUM FLUX. -+ ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) -+ !$acc loop seq - do i = 1, num_dims - idxi = dir_idx(i) - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & -@@ -2206,32 +2350,68 @@ contains - vel_R(idxi)) - vel_R(idxi))) + & - dir_flg(idxi)*(pres_R)) & - + (s_M/s_L)*(s_P/s_R)*dir_flg(idxi)*pcorr -+ -+ !idxi = dir_idx(i) -+ !flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & -+ ! xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & -+ !(1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & -+ ! xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & -+ !(1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) & -+ ! + (s_M/s_L)*(s_P/s_R)*dir_flg(dir_idx(i))*pcorr - end do - -- ! Energy flux. -- ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) -+ ! ENERGY FLUX. -+ ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) - flux_rs${XYZ}$_vf(j, k, l, E_idx) = & - xi_M*(vel_L(idx1)*(E_L + pres_L) + & -- s_M*(xi_L*(E_L + (s_S - vel_L(idx1))* & -- (rho_L*s_S + pres_L/ & -- (s_L - vel_L(idx1)))) - E_L)) & -+ s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & - + xi_P*(vel_R(idx1)*(E_R + pres_R) + & -- s_P*(xi_R*(E_R + (s_S - vel_R(idx1))* & -- (rho_R*s_S + pres_R/ & -- (s_R - vel_R(idx1)))) - E_R)) & -+ s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) & - + (s_M/s_L)*(s_P/s_R)*pcorr*s_S - -- ! Volume fraction flux -+ ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux -+ if (elasticity) then -+ flux_ene_e = 0d0; -+ !$acc loop seq -+ do i = 1, num_dims -+ ! MOMENTUM ELASTIC FLUX. -+ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & -+ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) & -+ - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) -+ ! ENERGY ELASTIC FLUX. -+ flux_ene_e = flux_ene_e - & -+ xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & -+ s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & -+ xi_P*(vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & -+ s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) -+ end do -+ flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e -+ end if -+ -+ ! HYPOELASTIC STRESS EVOLUTION FLUX. -+ if (hypoelasticity) then -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & -+ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & -+ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) -+ end do -+ end if -+ -+ ! VOLUME FRACTION FLUX. - !$acc loop seq - do i = advxb, advxe -- flux_rs${XYZ}$_vf(j, k, l, i) = & -- xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & -- *(vel_L(idx1) + s_M*(xi_L - 1d0)) & -- + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & -- *(vel_R(idx1) + s_P*(xi_R - 1d0)) -+ flux_rs${XYZ}$_vf(j, k, l, i) = & -+ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & -+ *(vel_L(idx1) + s_M*(xi_L - 1d0)) & -+ + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & -+ *(vel_R(idx1) + s_P*(xi_R - 1d0)) -+ !flux_rs${XYZ}$_vf(j, k, l, i) = & -+ ! xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & -+ ! xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) - end do - -- ! Source for volume fraction advection equation -+ ! VOLUME FRACTION SOURCE FLUX. - !$acc loop seq - do i = 1, num_dims - idxi = dir_idx(i) -@@ -2242,14 +2422,20 @@ contains - + xi_P*(vel_R(idxi) + & - dir_flg(idxi)* & - s_P*(xi_R - 1d0)) -- -- !if ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0d0 -+ !xi_M*(vel_L(idxi) + dir_flg(idxi)*s_M*(xi_L - 1d0)) + & -+ !xi_P*(vel_R(idxi) + dir_flg(idxi)*s_P*(xi_R - 1d0)) - end do - - flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) - -- ! Geometrical source flux for cylindrical coordinates -+ ! SURFACE TENSION FLUX. need to check -+ !if (.not. f_is_default(sigma)) then -+ ! flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -+ ! (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & -+ ! xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S -+ !end if - -+ ! Geometrical source flux for cylindrical coordinates - #:if (NORM_DIR == 2) - if (cyl_coord) then - !Substituting the advective flux into the inviscid geometrical source flux -@@ -2544,7 +2730,7 @@ contains - - !$acc update device(is1, is2, is3) - -- if (hypoelasticity) then -+ if (elasticity) then - if (norm_dir == 1) then - dir_idx_tau = (/1, 2, 4/) - else if (norm_dir == 2) then -diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp -index 5e1c6f6e..10158e8e 100644 ---- a/src/simulation/m_start_up.fpp -+++ b/src/simulation/m_start_up.fpp -@@ -46,9 +46,10 @@ module m_start_up - - use m_derived_variables !< Procedures used to compute quantities derived - !! from the conservative and primitive variables -- - use m_hypoelastic - -+ use m_hyperelastic -+ - use m_phase_change !< Phase-change module - - use m_viscous -@@ -139,6 +140,7 @@ contains - teno_CT, mp_weno, weno_avg, & - riemann_solver, low_Mach, wave_speeds, avg_state, & - bc_x, bc_y, bc_z, & -+ x_a, y_a, z_a, x_b, y_b, z_b, & - x_domain, y_domain, z_domain, & - hypoelasticity, & - ib, num_ibs, patch_ib, & -@@ -146,8 +148,8 @@ contains - fd_order, probe, num_probes, t_step_old, & - alt_soundspeed, mixture_err, weno_Re_flux, & - null_weights, precision, parallel_io, cyl_coord, & -- rhoref, pref, bubbles, bubble_model, & -- R0ref, & -+ rhoref, pref, bubbles, bubble_model, & -+ - #:if not MFC_CASE_OPTIMIZATION - nb, mapped_weno, wenoz, teno, weno_order, num_fluids, & - #:endif -@@ -161,7 +163,7 @@ contains - R0_type, file_per_process, sigma, & - pi_fac, adv_n, adap_dt, bf_x, bf_y, bf_z, & - k_x, k_y, k_z, w_x, w_y, w_z, p_x, p_y, p_z, & -- g_x, g_y, g_z -+ g_x, g_y, g_z, hyperelasticity, R0ref - - ! Checking that an input file has been provided by the user. If it - ! has, then the input file is read in, otherwise, simulation exits. -@@ -359,7 +361,7 @@ contains - end if - end do - -- if ((bubbles .eqv. .true.) .or. (hypoelasticity .eqv. .true.)) then -+ if ((bubbles .eqv. .true.) .or. (elasticity .eqv. .true.)) then - ! Read pb and mv for non-polytropic qbmm - if (qbmm .and. .not. polytropic) then - do i = 1, nb -@@ -589,7 +591,7 @@ contains - NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) - - ! Read the data for each variable -- if (bubbles .or. hypoelasticity) then -+ if ( bubbles .or. elasticity ) then - - do i = 1, sys_size!adv_idx%end - var_MOK = int(i, MPI_OFFSET_KIND) -@@ -614,6 +616,7 @@ contains - MPI_DOUBLE_PRECISION, status, ierr) - end do - end if -+ - - call s_mpi_barrier() - -@@ -679,9 +682,9 @@ contains - NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) - - ! Read the data for each variable -- if (bubbles .or. hypoelasticity) then -+ if ( bubbles .or. elasticity ) then - -- do i = 1, sys_size!adv_idx%end -+ do i = 1, sys_size !adv_idx%end - var_MOK = int(i, MPI_OFFSET_KIND) - ! Initial displacement to skip at beginning of file - disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) -@@ -1120,7 +1123,7 @@ contains - ! Time-stepping loop controls - if ((mytime + dt) >= finaltime) dt = finaltime - mytime - t_step = t_step + 1 -- -+ - end subroutine s_perform_time_step - - subroutine s_save_performance_metrics(t_step, time_avg, time_final, io_time_avg, io_time_final, proc_time, io_proc_time, file_exists, start, finish, nt) -@@ -1272,7 +1275,6 @@ contains - call acc_present_dump() - #endif - -- if (hypoelasticity) call s_initialize_hypoelastic_module() - if (relax) call s_initialize_phasechange_module() - call s_initialize_data_output_module() - call s_initialize_derived_variables_module() -@@ -1312,9 +1314,11 @@ contains - #endif - - call s_initialize_cbc_module() -- - call s_initialize_derived_variables() - -+ if (hypoelasticity) call s_initialize_hypoelastic_module() -+ if (hyperelasticity) call s_initialize_hyperelastic_module() -+ - end subroutine s_initialize_modules - - subroutine s_initialize_mpi_domain -@@ -1395,6 +1399,7 @@ contains - do i = 1, sys_size - !$acc update device(q_cons_ts(1)%vf(i)%sf) - end do -+ - if (qbmm .and. .not. polytropic) then - !$acc update device(pb_ts(1)%sf, mv_ts(1)%sf) - end if -@@ -1410,7 +1415,6 @@ contains - !$acc update device(bc_y%vb1, bc_y%vb2, bc_y%vb3, bc_y%ve1, bc_y%ve2, bc_y%ve3) - !$acc update device(bc_z%vb1, bc_z%vb2, bc_z%vb3, bc_z%ve1, bc_z%ve2, bc_z%ve3) - -- - !$acc update device(relax, relax_model) - if (relax) then - !$acc update device(palpha_eps, ptgalpha_eps) -@@ -1428,6 +1432,8 @@ contains - s_write_data_files => null() - - call s_finalize_time_steppers_module() -+ if (hypoelasticity) call s_finalize_hypoelastic_module() -+ if (hyperelasticity) call s_finalize_hyperelastic_module() - call s_finalize_derived_variables_module() - call s_finalize_data_output_module() - call s_finalize_rhs_module() -diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp -index 2e9ca8fe..b5faba05 100644 ---- a/src/simulation/m_surface_tension.fpp -+++ b/src/simulation/m_surface_tension.fpp -@@ -1,7 +1,7 @@ - #:include 'macros.fpp' - #:include 'inline_capillary.fpp' - --!> @brief This module is used to compute source terms for hypoelastic model -+!> @brief This module is used to compute source terms for surface tension model - module m_surface_tension - - ! Dependencies ============================================================= -diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp -index d34c1fc0..b940bdc8 100644 ---- a/src/simulation/m_time_steppers.fpp -+++ b/src/simulation/m_time_steppers.fpp -@@ -25,6 +25,8 @@ module m_time_steppers - - use m_ibm - -+ use m_hyperelastic -+ - use m_mpi_proxy !< Message passing interface (MPI) module proxy - - use m_boundary_conditions -@@ -181,8 +183,7 @@ contains - end if - end if - -- if (hypoelasticity) then -- -+ if (elasticity) then - do i = stress_idx%beg, stress_idx%end - @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & - iy_t%beg:iy_t%end, & -@@ -191,6 +192,15 @@ contains - end do - end if - -+ if (hyperelasticity) then -+ do i = xibeg, xiend + 1 -+ @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & -+ iy_t%beg:iy_t%end, & -+ iz_t%beg:iz_t%end)) -+ @:ACC_SETUP_SFs(q_prim_vf(i)) -+ end do -+ end if -+ - if (model_eqns == 3) then - do i = internalEnergies_idx%beg, internalEnergies_idx%end - @:ALLOCATE(q_prim_vf(i)%sf(ix_t%beg:ix_t%end, & -@@ -812,6 +822,10 @@ contains - call s_pressure_relaxation_procedure(q_cons_ts(1)%vf) - end if - -+ call nvtxStartRange("RHS-ELASTIC") -+ if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_ts(1)%vf, q_prim_vf) -+ call nvtxEndRange -+ - if (adv_n) call s_comp_alpha_from_n(q_cons_ts(1)%vf) - - if (ib) then -@@ -829,7 +843,6 @@ contains - time = time + (finish - start) - end if - ! ================================================================== -- - end subroutine s_3rd_order_tvd_rk - - !> Strang splitting scheme with 3rd order TVD RK time-stepping algorithm for -@@ -959,6 +972,7 @@ contains - end if - - end subroutine s_time_step_cycling -+ - !> Module deallocation and/or disassociation procedures - subroutine s_finalize_time_steppers_module - -@@ -993,12 +1007,18 @@ contains - @:DEALLOCATE(q_prim_vf(i)%sf) - end do - -- if (hypoelasticity) then -+ if (elasticity) then - do i = stress_idx%beg, stress_idx%end - @:DEALLOCATE(q_prim_vf(i)%sf) - end do - end if - -+ if (hyperelasticity) then -+ do i = xibeg, xiend + 1 -+ @:DEALLOCATE(q_prim_vf(i)%sf) -+ end do -+ end if -+ - if (bubbles) then - do i = bub_idx%beg, bub_idx%end - @:DEALLOCATE(q_prim_vf(i)%sf) -diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp -index 0019779e..5bdf4b84 100644 ---- a/src/simulation/m_viscous.fpp -+++ b/src/simulation/m_viscous.fpp -@@ -12,8 +12,6 @@ module m_viscous - use m_global_parameters !< Definitions of the global parameters - - use m_weno -- -- use m_helper - ! ========================================================================== - - private; public s_get_viscous, & -diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp -index 3f0e885c..8f24a5fe 100644 ---- a/src/simulation/p_main.fpp -+++ b/src/simulation/p_main.fpp -@@ -36,7 +36,6 @@ program p_main - - !Initialize MPI - call s_initialize_mpi_domain() -- - !Initialize Modules - call s_initialize_modules() - -diff --git a/submit_gpu.sh b/submit_gpu.sh -new file mode 100755 -index 00000000..2c77cc92 ---- /dev/null -+++ b/submit_gpu.sh -@@ -0,0 +1,49 @@ -+#!/bin/bash -+ -+### A100s -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwex_pre -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta -+ -+### A40s -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwex_pre -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# test -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 03:00:00 -# test_sim -t simulation -a bciv-delta-gpu -c delta -+ -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# bwex_post -t post_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# test_post -t post_process -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 02:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -+ -+./mfc.sh run tests/6FC6A809/case.py -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -+./mfc.sh run tests/6FC6A809/case.py -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -+ -diff --git a/submit_hyper.sh b/submit_hyper.sh -new file mode 100755 -index 00000000..ba197a99 ---- /dev/null -+++ b/submit_hyper.sh -@@ -0,0 +1,7 @@ -+#!/bin/bash -+ -+./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -+./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -+ -+ -diff --git a/submit_pc.sh b/submit_pc.sh -new file mode 100755 -index 00000000..e45b98db ---- /dev/null -+++ b/submit_pc.sh -@@ -0,0 +1,9 @@ -+#!/bin/bash -+ -+#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -+#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar -+#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -+ -+./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t pre_process -c delta -+./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t simulation -c delta -+ -diff --git a/submit_test.sh b/submit_test.sh -new file mode 100755 -index 00000000..69b80bbe ---- /dev/null -+++ b/submit_test.sh -@@ -0,0 +1,52 @@ -+#!/bin/bash -+ -+#./mfc.sh run ./examples/3D_phasechange_bubble/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -+#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -+#./mfc.sh run ./examples/3D_phasechange_bubble/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+ -+#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -+#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -+#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+ -+#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -+#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -+#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+ -+#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 00:10:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 04:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.3/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 01:00:00 -# pre_bubingel -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# sim_bubingel -t simulation -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# pre_bubinwater -t pre_process -a bciv-delta-gpu -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# sim_bubinwater -t simulation -a bciv-delta-gpu -c delta -+ -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -+#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -+./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+ -+ -+#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -+#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 02:00:00 -# test1 -t simulation -c oscar -+#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar -+ -+ -+#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/finalruns/elcom/bubliq/25wv/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/finalruns/elcom/bubliq/75wv/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -+ -diff --git a/toolchain/bootstrap/docker.sh b/toolchain/bootstrap/docker.sh -index 73e61372..60e34d92 100644 ---- a/toolchain/bootstrap/docker.sh -+++ b/toolchain/bootstrap/docker.sh -@@ -30,4 +30,4 @@ if (($?)); then - error "Error running Docker container with $@." - - exit 1 --fi -\ No newline at end of file -+fi -diff --git a/toolchain/bootstrap/modules.sh b/toolchain/bootstrap/modules.sh -index 097dca13..b437157f 100644 ---- a/toolchain/bootstrap/modules.sh -+++ b/toolchain/bootstrap/modules.sh -@@ -23,8 +23,9 @@ if [ -v $u_c ]; then - log "$C""ACCESS$W: Bridges2 (b) | Expanse (e) | Delta (d)" - log "$Y""Gatech$W: Phoenix (p)" - log "$R""Caltech$W: Richardson (r)" -+ log "$BR""Brown$W: Oscar (o)" - log "$B""DoD$W: Carpenter (c) | Nautilus (n)" -- log_n "($G""a$W/$G""f$W/$G""s$W/$G""w$W/$C""b$W/$C""e$CR/$C""d$CR/$Y""p$CR/$R""r$CR/$B""c$CR/$B""n$CR): " -+ log_n "($G""a$W/$G""f$W/$G""s$W/$G""w$W/$C""b$W/$C""e$CR/$C""d$CR/$Y""p$CR/$R""r$CR/$B""c$CR/$B""n$CR/$BR""o"$CR"): " - read u_c - log - fi -diff --git a/toolchain/mfc/bench.py b/toolchain/mfc/bench.py -index 52792f26..98e34309 100644 ---- a/toolchain/mfc/bench.py -+++ b/toolchain/mfc/bench.py -@@ -16,7 +16,6 @@ class BenchCase: - path: str - args: typing.List[str] - -- - def bench(targets = None): - if targets is None: - targets = ARG("targets") -diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py -index b39507d3..4658d6b6 100644 ---- a/toolchain/mfc/run/case_dicts.py -+++ b/toolchain/mfc/run/case_dicts.py -@@ -19,6 +19,7 @@ class ParamType(Enum): - - COMMON = { - 'hypoelasticity': ParamType.LOG, -+ 'hyperelasticity': ParamType.LOG, - 'cyl_coord': ParamType.LOG, - 'pref': ParamType.REAL, - 'p': ParamType.INT, -@@ -47,6 +48,7 @@ COMMON = { - 'relax_model': ParamType.INT, - 'sigma': ParamType.REAL, - 'adv_n': ParamType.LOG, -+ 'hyperelasticity': ParamType.LOG, - } - - PRE_PROCESS = COMMON.copy() -@@ -75,6 +77,7 @@ PRE_PROCESS.update({ - 'pi_fac': ParamType.REAL, - 'ib': ParamType.LOG, - 'num_ibs': ParamType.INT, -+ 'pre_stress': ParamType.LOG, - }) - - for ib_id in range(1, 10+1): -@@ -112,9 +115,11 @@ for p_id in range(1, 10+1): - ("smooth_patch_id", ParamType.INT), ("hcid", ParamType.INT)]: - PRE_PROCESS[f"patch_icpp({p_id})%{attribute}"] = ty - -- for real_attr in ["radius", "radii", "epsilon", "beta", "normal", "alpha_rho", -- "smooth_coeff", "rho", "vel", "alpha", "gamma", -+ for real_attr in ["radius", "radii", "epsilon", "beta", "normal", "alpha_rho", "a2", -+ "a3", "a4", "a5", "a6", "a7","a8", "a9", "a10", "a11", "a12", 'non_axis_sym', -+ "normal", "smooth_coeff", "rho", "vel", "pres", "alpha", "gamma", - "pi_inf", "r0", "v0", "p0", "m0", "cv", "qv", "qvp", "cf_val"]: -+ - PRE_PROCESS[f"patch_icpp({p_id})%{real_attr}"] = ParamType.REAL - PRE_PROCESS[f"patch_icpp({p_id})%pres"] = ParamType.REAL.analytic() - -@@ -279,7 +284,6 @@ for f_id in range(1,10+1): - SIMULATION[f"integral({int_id})%{cmp}min"] = ParamType.REAL - SIMULATION[f"integral({int_id})%{cmp}max"] = ParamType.REAL - -- - # Removed: 'fourier_modes%beg', 'fourier_modes%end', 'chem_wrt' - # Feel free to return them if they are needed once more. - POST_PROCESS = COMMON.copy() -@@ -314,6 +318,7 @@ POST_PROCESS.update({ - 'qbmm': ParamType.LOG, - 'qm_wrt': ParamType.LOG, - 'cf_wrt': ParamType.LOG, -+ 'sim_data': ParamType.LOG, - 'ib': ParamType.LOG - }) - -diff --git a/toolchain/modules b/toolchain/modules -index 178d9966..bc0566a3 100644 ---- a/toolchain/modules -+++ b/toolchain/modules -@@ -60,6 +60,12 @@ d-cpu gcc/11.4.0 openmpi - d-gpu nvhpc/22.11 openmpi+cuda/4.1.5+cuda cmake - d-gpu CC=nvc CXX=nvc++ FC=nvfortran - -+o Brown Oscar -+o-all python -+o-cpu hpcx-mpi -+o-gpu nvhpc cuda/12.3.0 cmake/3.26.3 -+o-gpu CC=nvc CXX=nvc++ FC=nvfortran -+ - c DoD Carpenter - c-all python/3.12.1 - c-cpu compiler-rt/2024.2.0 ifort/2024.2.0 icc/2023.1.0 mpi/latest cmake/3.28.1-intel-2023.0.0 -@@ -70,3 +76,4 @@ n-all slurm - n-cpu penguin/openmpi/4.1.5/gcc-8.5.0 - n-gpu penguin/openmpi/4.1.5/nvhpc-22.3 nvidia/nvhpc/22.3 cuda/cuda-11.6 - n-gpu CC=nvc CXX=nvc++ FC=nvfortran -+ -diff --git a/toolchain/templates/oscar.mako b/toolchain/templates/oscar.mako -new file mode 100644 -index 00000000..158a217c ---- /dev/null -+++ b/toolchain/templates/oscar.mako -@@ -0,0 +1,56 @@ -+#!/usr/bin/env bash -+ -+<%namespace name="helpers" file="helpers.mako"/> -+ -+% if engine == 'batch': -+#SBATCH --nodes=${nodes} -+#SBATCH --ntasks-per-node=${tasks_per_node} -+#SBATCH --cpus-per-task=1 -+#SBATCH --job-name="${name}" -+#SBATCH --time=${walltime} -+% if partition: -+#SBATCH --partition=${partition} -+% endif -+% if account: -+#SBATCH --account="${account}" -+% endif -+% if gpu: -+#SBATCH --gpus-per-node=${tasks_per_node} -+#SBATCH --mem=64G -+#SBATCH --gpu-bind=closest -+% endif -+#SBATCH --output="${name}.out" -+#SBATCH --error="${name}.err" -+#SBATCH --export=ALL -+% if email: -+#SBATCH --mail-user=${email} -+#SBATCH --mail-type="BEGIN, END, FAIL" -+% endif -+% endif -+ -+${helpers.template_prologue()} -+ -+ok ":) Loading modules:\n" -+cd "${MFC_ROOTDIR}" -+. ./mfc.sh load -c o -m ${'g' if gpu else 'c'} -+cd - > /dev/null -+echo -+ -+% for target in targets: -+ ${helpers.run_prologue(target)} -+ -+ % if not mpi: -+ (set -x; ${profiler} "${target.get_install_binpath(case)}") -+ % else: -+ (set -x; ${profiler} \ -+ mpirun -np ${nodes*tasks_per_node} \ -+ ${' '.join([f"'{x}'" for x in ARG('--') ])} \ -+ "${target.get_install_binpath(case)}") -+ % endif -+ -+ ${helpers.run_epilogue(target)} -+ -+ echo -+% endfor -+ -+${helpers.template_epilogue()} -diff --git a/toolchain/util.sh b/toolchain/util.sh -index c67c9cad..fddbe22a 100644 ---- a/toolchain/util.sh -+++ b/toolchain/util.sh -@@ -1,10 +1,10 @@ - #!/bin/bash - - if [ -t 1 ]; then -- RED="\x1B[31m"; CYAN="\x1B[36m"; GREEN="\x1B[32m" -+ RED="\x1B[31m"; CYAN="\x1B[36m"; GREEN="\x1B[32m"; BROWN="\x1B[38;5;58m" - YELLOW="\x1B[33m"; MAGENTA="\x1B[35m"; BLUE="\x1B[34m"; COLOR_RESET="\033[m" - -- R=$RED; C=$CYAN; G=$GREEN -+ R=$RED; C=$CYAN; G=$GREEN; BR=$BROWN - Y=$YELLOW; M=$MAGENTA; B=$BLUE; CR=$COLOR_RESET; W=$CR - fi - From 0d9e4e79204070b597c40f2b19f347ab3e51a142 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 5 Aug 2024 10:40:43 -0500 Subject: [PATCH 276/380] attempting to fix hllc for 3D --- diff.txt | 1095 ++++++++++++++++++++++++++ src/simulation/m_riemann_solvers.fpp | 169 ++-- 2 files changed, 1188 insertions(+), 76 deletions(-) create mode 100644 diff.txt diff --git a/diff.txt b/diff.txt new file mode 100644 index 0000000000..526b0d4eef --- /dev/null +++ b/diff.txt @@ -0,0 +1,1095 @@ +diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp +index bfca7142..16b20b02 100644 +--- a/src/simulation/m_riemann_solvers.fpp ++++ b/src/simulation/m_riemann_solvers.fpp +@@ -162,14 +162,14 @@ module m_riemann_solvers + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsx_vf, flux_src_rsx_vf) + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsy_vf, flux_src_rsy_vf) + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsz_vf, flux_src_rsz_vf) +- !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & +- !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) ++ !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & ++ !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) + #else + real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsx_vf, flux_src_rsx_vf + real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsy_vf, flux_src_rsy_vf + real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsz_vf, flux_src_rsz_vf +- !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & +- !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) ++ !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & ++ !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf) + #endif + !> @} + +@@ -313,6 +313,7 @@ contains + real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R + real(kind(0d0)) :: G_L, G_R + real(kind(0d0)), dimension(2) :: Re_L, Re_R ++ real(kind(0d0)), dimension(3) :: xi_field_L, xi_field_R + + real(kind(0d0)) :: rho_avg + real(kind(0d0)), dimension(num_dims) :: vel_avg +@@ -356,8 +357,7 @@ contains + #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] + + if (norm_dir == ${NORM_DIR}$) then +- !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, & +- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S) ++ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, xi_field_L, xi_field_R) + do l = is3%beg, is3%end + do k = is2%beg, is2%end + do j = is1%beg, is1%end +@@ -440,31 +440,24 @@ contains + !$acc loop seq + do i = 1, 2 + Re_L(i) = dflt_real +- + if (Re_size(i) > 0) Re_L(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_L(i) = alpha_L(Re_idx(i, q))/Res(i, q) & + + Re_L(i) + end do +- + Re_L(i) = 1d0/max(Re_L(i), sgm_eps) +- + end do + + !$acc loop seq + do i = 1, 2 + Re_R(i) = dflt_real +- + if (Re_size(i) > 0) Re_R(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_R(i) = alpha_R(Re_idx(i, q))/Res(i, q) & + + Re_R(i) + end do +- + Re_R(i) = 1d0/max(Re_R(i), sgm_eps) + end do + end if +@@ -472,26 +465,17 @@ contains + E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L + E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R + +- H_L = (E_L + pres_L)/rho_L +- H_R = (E_R + pres_R)/rho_R +- ++ ! elastic energy update + if (hypoelasticity) then +- !$acc loop seq +- do i = 1, strxe - strxb + 1 +- tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) +- tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) +- end do +- +- G_L = 0d0 +- G_R = 0d0 +- ++ G_L = 0d0; G_R = 0d0 + !$acc loop seq + do i = 1, num_fluids + G_L = G_L + alpha_L(i)*Gs(i) + G_R = G_R + alpha_R(i)*Gs(i) + end do +- + do i = 1, strxe - strxb + 1 ++ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + ! Elastic contribution to energy if G large enough + !TODO take out if statement if stable without + if ((G_L > 1000) .and. (G_R > 1000)) then +@@ -506,19 +490,57 @@ contains + end do + end if + ++ ! elastic energy update ++ !if ( hyperelasticity ) then ++ ! G_L = 0d0 ++ ! G_R = 0d0 ++ ! ++ ! !$acc loop seq ++ ! do i = 1, num_fluids ++ ! G_L = G_L + alpha_L(i)*Gs(i) ++ ! G_R = G_R + alpha_R(i)*Gs(i) ++ ! end do ++ ! ! Elastic contribution to energy if G large enough ++ ! if ((G_L > 1d-3) .and. (G_R > 1d-3)) then ++ ! E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) ++ ! E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) ++ ! !$acc loop seq ++ ! do i = 1, b_size-1 ++ ! tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ ! tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ++ ! end do ++ ! !$acc loop seq ++ ! do i = 1, b_size-1 ++ ! tau_e_L(i) = 0d0 ++ ! tau_e_R(i) = 0d0 ++ ! end do ++ ! !$acc loop seq ++ ! do i = 1, num_dims ++ ! xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) ++ ! xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) ++ ! end do ++ ! end if ++ !end if ++ ++ ! Enthalpy with elastic energy ++ H_L = (E_L + pres_L)/rho_L ++ H_R = (E_R + pres_R)/rho_R ++ + @:compute_average_state() + + call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & +- vel_L_rms, c_L) ++ vel_L_rms, c_L, Gs) + + call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & +- vel_R_rms, c_R) ++ vel_R_rms, c_R, Gs) + + !> The computation of c_avg does not require all the variables, and therefore the non '_avg' + ! variables are placeholders to call the subroutine. + + call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & +- vel_avg_rms, c_avg) ++ vel_avg_rms, c_avg, Gs) ++ ++ !SGR added Gs to all of the above speed of sound clacs + + if (any(Re_size > 0)) then + !$acc loop seq +@@ -541,6 +563,11 @@ contains + , vel_L(dir_idx(1)) + sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + & + tau_e_L(dir_idx_tau(1)))/rho_L)) ++ else if (hyperelasticity) then ++ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L) & ++ , vel_R(dir_idx(1)) - sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R)) ++ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R) & ++ , vel_L(dir_idx(1)) + sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L)) + else + s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) + s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) +@@ -716,6 +743,18 @@ contains + /(s_M - s_P) + end do + ++ ! Xi field ++ !if ( hyperelasticity ) then ++ ! do i = 1, num_dims ++ ! flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & ++ ! (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & ++ ! - s_P*rho_L*vel_L(dir_idx(1))*xi_field_L(i) & ++ ! + s_M*s_P*(rho_L*xi_field_L(i) & ++ ! - rho_R*xi_field_R(i))) & ++ ! /(s_M - s_P) ++ ! end do ++ !end if ++ + ! Div(U)? + !$acc loop seq + do i = 1, num_dims +@@ -822,7 +861,6 @@ contains + + real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf + type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf +- + type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf + + type(scalar_field), & +@@ -862,6 +900,11 @@ contains + real(kind(0d0)) :: s_L, s_R, s_M, s_P, s_S + real(kind(0d0)) :: xi_L, xi_R !< Left and right wave speeds functions + real(kind(0d0)) :: xi_M, xi_P ++ real(kind(0d0)) :: xi_MP, xi_PP ++ ++ real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R ++ real(kind(0d0)), dimension(num_dims) :: xi_field_L, xi_field_R ++ real(kind(0d0)) :: G_L, G_R + + real(kind(0d0)) :: nbub_L, nbub_R + real(kind(0d0)), dimension(nb) :: R0_L, R0_R +@@ -880,9 +923,10 @@ contains + real(kind(0d0)) :: vel_L_rms, vel_R_rms, vel_avg_rms + real(kind(0d0)) :: vel_L_tmp, vel_R_tmp + real(kind(0d0)) :: blkmod1, blkmod2 +- real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star ++ real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star, vel_K_Star + real(kind(0d0)) :: pres_SL, pres_SR, Ms_L, Ms_R + real(kind(0d0)) :: start, finish ++ real(kind(0d0)) :: flux_ene_e + real(kind(0d0)) :: zcoef, pcorr !< low Mach number correction + integer :: i, j, k, l, q !< Generic loop iterators + integer :: idx1, idxi +@@ -909,15 +953,16 @@ contains + flux_gsrc_vf, & + norm_dir, ix, iy, iz) + ++ idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 ++ + #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] + + if (norm_dir == ${NORM_DIR}$) then ++ ++ ! 6-EQUATION MODEL WITH HLLC + if (model_eqns == 3) then + !ME3 +- +- !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & +- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R) +- ++ !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R, flux_ene_e, xi_field_L, xi_field_R) + do l = is3%beg, is3%end + do k = is2%beg, is2%end + do j = is1%beg, is1%end +@@ -994,39 +1039,85 @@ contains + !$acc loop seq + do i = 1, 2 + Re_L(i) = dflt_real +- + if (Re_size(i) > 0) Re_L(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + + Re_L(i) + end do +- + Re_L(i) = 1d0/max(Re_L(i), sgm_eps) +- + end do + + !$acc loop seq + do i = 1, 2 + Re_R(i) = dflt_real +- + if (Re_size(i) > 0) Re_R(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + + Re_R(i) + end do +- + Re_R(i) = 1d0/max(Re_R(i), sgm_eps) + end do + end if + + E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L +- + E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R + ++ ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY ++ if (hypoelasticity) then ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ++ end do ++ G_L = 0d0; G_R = 0d0 ++ !$acc loop seq ++ do i = 1, num_fluids ++ G_L = G_L + alpha_L(i)*Gs(i) ++ G_R = G_R + alpha_R(i)*Gs(i) ++ end do ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ ! Elastic contribution to energy if G large enough ++ if ((G_L > verysmall) .and. (G_R > verysmall)) then ++ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) ++ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) ++ ! Additional terms in 2D and 3D ++ if ((i == 2) .or. (i == 4) .or. (i == 5)) then ++ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) ++ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) ++ end if ++ end if ++ end do ++ end if ++ ++ ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY ++ if (hyperelasticity) then ++ !$acc loop seq ++ do i = 1, num_dims ++ xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) ++ xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) ++ end do ++ G_L = 0d0; G_R = 0d0; ++ !$acc loop seq ++ do i = 1, num_fluids ++ ! Mixture left and right shear modulus ++ G_L = G_L + alpha_L(i)*Gs(i) ++ G_R = G_R + alpha_R(i)*Gs(i) ++ end do ++ ! Elastic contribution to energy if G large enough ++ if ( G_L > verysmall .and. G_R > verysmall ) then ++ E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) ++ E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) ++ end if ++ !$acc loop seq ++ do i = 1, b_size - 1 ++ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ++ end do ++ end if ++ + H_L = (E_L + pres_L)/rho_L + H_R = (E_R + pres_R)/rho_R + +@@ -1034,13 +1125,10 @@ contains + + call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & + vel_L_rms, c_L) +- + call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & + vel_R_rms, c_R) +- + !> The computation of c_avg does not require all the variables, and therefore the non '_avg' + ! variables are placeholders to call the subroutine. +- + call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & + vel_avg_rms, c_avg) + +@@ -1051,222 +1139,226 @@ contains + end do + end if + ++ ! COMPUTING THE DIRECT WAVE SPEEDS + if (wave_speeds == 1) then +- s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) +- s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) ++ if (elasticity) then ++ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & ++ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & ++ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) ++ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & ++ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & ++ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) ++ s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & ++ tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & ++ rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & ++ rho_R*(s_R - vel_R(idx1))) ++ else ++ s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) ++ s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) ++ s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & ++ (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & ++ /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) + +- s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & +- (s_L - vel_L(dir_idx(1))) - & +- rho_R*vel_R(dir_idx(1))* & +- (s_R - vel_R(dir_idx(1)))) & +- /(rho_L*(s_L - vel_L(dir_idx(1))) - & +- rho_R*(s_R - vel_R(dir_idx(1)))) ++ end if + elseif (wave_speeds == 2) then + pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & + (vel_L(dir_idx(1)) - & + vel_R(dir_idx(1)))) +- + pres_SR = pres_SL +- + Ms_L = max(1d0, sqrt(1d0 + ((5d-1 + gamma_L)/(1d0 + gamma_L))* & + (pres_SL/pres_L - 1d0)*pres_L/ & + ((pres_L + pi_inf_L/(1d0 + gamma_L))))) + Ms_R = max(1d0, sqrt(1d0 + ((5d-1 + gamma_R)/(1d0 + gamma_R))* & + (pres_SR/pres_R - 1d0)*pres_R/ & + ((pres_R + pi_inf_R/(1d0 + gamma_R))))) +- + s_L = vel_L(dir_idx(1)) - c_L*Ms_L + s_R = vel_R(dir_idx(1)) + c_R*Ms_R +- + s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & + (pres_L - pres_R)/ & + (rho_avg*c_avg)) + end if + +- if (s_L >= 0d0) then +- p_Star = pres_L ! Only useful to recalculate the radial momentum geometric source flux +- !$acc loop seq +- do i = 1, num_fluids +- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)*s_S ++ ! follows Einfeldt et al. ++ ! s_M/P = min/max(0.,s_L/R) ++ s_M = min(0d0, s_L); s_P = max(0d0, s_R) + +- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)*vel_L(dir_idx(1)) ++ ! goes with q_star_L/R = xi_L/R * (variable) ++ ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) ) ++ xi_L = (s_L - vel_L(idx1))/(s_L - s_S) ++ xi_R = (s_R - vel_R(idx1))/(s_R - s_S) + +- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & +- (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & +- (gammas(i)*pres_L + pi_infs(i)) + & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & +- qvs(i))*vel_L(dir_idx(1)) +- end do +- !$acc loop seq +- do i = 1, num_dims +- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & +- rho_L*vel_L(dir_idx(1))*vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*pres_L ++ ! goes with numerical star velocity in x/y/z directions ++ ! xi_P/M = 0.5 +/m sgn(0.5,s_star) ++ xi_M = (5d-1 + sign(5d-1, s_S)) ++ xi_P = (5d-1 - sign(5d-1, s_S)) + +- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & +- dir_flg(dir_idx(i))*(s_S - vel_L(dir_idx(i))) +- ! Compute the star velocities for the non-conservative terms +- end do +- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_L + pres_L)*vel_L(dir_idx(1)) ++ ! goes with the numerical velocity in x/y/z directions ++ ! xi_P/M (pressure) = min/max(0. sgn(1,sL/sR)) ++ xi_MP = -min(0d0, sign(1d0, s_L)) ++ xi_PP = max(0d0, sign(1d0, s_R)) + +- if (.not. f_is_default(sigma)) then +- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, c_idx)*s_S +- end if ++ ! COMPUTING FLUXES ++ ! MASS FLUX. ++ !$acc loop seq ++ do i = 1, contxe ++ flux_rs${XYZ}$_vf(j, k, l, i) = & ++ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & ++ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) ++ end do + +- ! Compute right solution state +- else if (s_R <= 0d0) then +- p_Star = pres_R +- ! Only useful to recalculate the radial momentum geometric source flux +- !$acc loop seq +- do i = 1, num_fluids +- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)*s_S ++ ! MOMENTUM FLUX. ++ ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) ++ !$acc loop seq ++ do i = 1, num_dims ++ !idxi = dir_idx(i) ++ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & ++ xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & ++ (1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & ++ xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & ++ (1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) ++ end do + +- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)*vel_R(dir_idx(1)) ++ ! ENERGY FLUX. ++ ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) ++ flux_rs${XYZ}$_vf(j, k, l, E_idx) = & ++ xi_M*(vel_L(idx1)*(E_L + pres_L) + & ++ s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & ++ + xi_P*(vel_R(idx1)*(E_R + pres_R) + & ++ s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) ++ ++ ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux ++ if (elasticity) then ++ flux_ene_e = 0d0; ++ !$acc loop seq ++ do i = 1, num_dims ++ ! MOMENTUM ELASTIC FLUX. ++ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & ++ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) & ++ - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) ++ ! ENERGY ELASTIC FLUX. ++ flux_ene_e = flux_ene_e - & ++ xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & ++ s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & ++ xi_P*(vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & ++ s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) ++ end do ++ flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e ++ end if + +- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & +- (qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)* & +- (gammas(i)*pres_R + pi_infs(i)) + & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)* & +- qvs(i))*vel_R(dir_idx(1)) +- end do +- !$acc loop seq +- do i = 1, num_dims +- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & +- rho_R*vel_R(dir_idx(1))*vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*pres_R ++ ! VOLUME FRACTION FLUX. ++ !$acc loop seq ++ do i = advxb, advxe ++ flux_rs${XYZ}$_vf(j, k, l, i) = & ++ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*s_S + & ++ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*s_S ++ end do + +- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & +- dir_flg(dir_idx(i))*(s_S - vel_R(dir_idx(i))) +- ! Compute the star velocities for the non-conservative terms +- end do +- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_R + pres_R)*vel_R(dir_idx(1)) ++ ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. ++ !$acc loop seq ++ do i = 1, num_dims ++ !idxi = dir_idx(i) ++ vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = & ++ xi_M*(vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_MP*(xi_L - 1) + 1) - vel_L(dir_idx(i)))) + & ++ xi_P*(vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(dir_idx(i)))) ++ end do + +- if (.not. f_is_default(sigma)) then +- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx)*s_S +- end if ++ ! INTERNAL ENERGIES ADVECTION FLUX. ++ ! K-th pressure and velocity in preparation for the internal energy flux ++ vel_K_Star = vel_L(idx1)*(1d0 - xi_MP) + xi_MP*vel_R(idx1) + & ++ xi_MP*xi_PP*(s_S - vel_R(idx1)) ++ !$acc loop seq ++ do i = 1, num_fluids ++ p_K_Star = xi_M*(xi_MP*((pres_L + pi_infs(i)/(1d0 + gammas(i)))* & ++ xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - pres_L) + pres_L) + & ++ xi_P*(xi_PP*((pres_R + pi_infs(i)/(1d0 + gammas(i)))* & ++ xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - pres_R) + pres_R) ++ ++ flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & ++ (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & ++ (gammas(i)*p_K_Star + pi_infs(i)) + & ++ qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & ++ qvs(i))*vel_K_Star ++ end do + +- ! Compute left star solution state +- else if (s_S >= 0d0) then +- xi_L = (s_L - vel_L(dir_idx(1)))/(s_L - s_S) +- rho_Star = rho_L*xi_L +- E_Star = xi_L*(E_L + (s_S - vel_L(dir_idx(1)))* & +- (rho_L*s_S + pres_L/(s_L - vel_L(dir_idx(1))))) +- p_Star = rho_L*(s_L - vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1))) + pres_L +- !$acc loop seq +- do i = 1, num_fluids +- p_K_Star = (pres_L + pi_infs(i)/(1d0 + gammas(i)))* & +- xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) ++ flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) + +- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)*s_S ++ ! HYPOELASTIC STRESS EVOLUTION FLUX. ++ if (hypoelasticity) then ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & ++ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & ++ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) ++ end do ++ end if + +- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)*xi_L*s_S ++ ! REFERENCE MAP FLUX. ++ if (hyperelasticity) then ++ !$acc loop seq ++ do i = 1, num_dims ++ flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & ++ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*xi_field_L(i) & ++ - rho_L*vel_L(idx1)*xi_field_L(i)) + & ++ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*xi_field_R(i) & ++ - rho_R*vel_R(idx1)*xi_field_R(i)) ++ end do ++ end if + +- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & +- (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & +- (gammas(i)*p_K_Star + pi_infs(i)) + & +- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & +- qvs(i))*s_S +- end do +- !$acc loop seq +- do i = 1, num_dims +- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & +- rho_Star*s_S*(s_S*dir_flg(dir_idx(i)) + vel_L(dir_idx(i))* & +- (1d0 - dir_flg(dir_idx(i)))) + dir_flg(dir_idx(i))*p_Star ++ ! SURFACE TENSION FLUX. need to check ++ if (.not. f_is_default(sigma)) then ++ flux_rs${XYZ}$_vf(j, k, l, c_idx) = & ++ (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & ++ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S ++ end if + +- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & +- dir_flg(dir_idx(i))*(s_S*xi_L - vel_L(dir_idx(i))) +- ! Compute the star velocities for the non-conservative terms +- end do +- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_Star + p_Star)*s_S ++ ! correction pressure for the cylindrical terms ++ p_Star = xi_M*(pres_L + xi_MP*rho_L*(s_L - & ++ vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1)))) + & ++ xi_P*(pres_R + xi_PP*rho_R*(s_R - & ++ vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1)))) + +- if (.not. f_is_default(sigma)) then +- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & +- qL_prim_rs${XYZ}$_vf(j, k, l, c_idx)*s_S ++ ! Geometrical source flux for cylindrical coordinates ++ #:if (NORM_DIR == 2) ++ if (cyl_coord) then ++ !Substituting the advective flux into the inviscid geometrical source flux ++ !$acc loop seq ++ do i = 1, E_idx ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) ++ end do ++ !$acc loop seq ++ do i = intxb, intxe ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) ++ end do ++ ! Recalculating the radial momentum geometric source flux ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star ++ ! Geometrical source of the void fraction(s) is zero ++ !$acc loop seq ++ do i = advxb, advxe ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 ++ end do + end if ++ #:endif ++ #:if (NORM_DIR == 3) ++ if (grid_geometry == 3) then ++ !$acc loop seq ++ do i = 1, sys_size ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 ++ end do ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star + +- ! Compute right star solution state +- else +- xi_R = (s_R - vel_R(dir_idx(1)))/(s_R - s_S) +- +- rho_Star = rho_R*xi_R +- +- E_Star = xi_R*(E_R + (s_S - vel_R(dir_idx(1)))* & +- (rho_R*s_S + pres_R/(s_R - vel_R(dir_idx(1))))) +- +- p_Star = rho_R*(s_R - vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1))) + pres_R +- !$acc loop seq +- do i = 1, num_fluids +- p_K_Star = (pres_R + pi_infs(i)/(1d0 + gammas(i)))* & +- xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) +- +- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)*s_S +- +- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)*xi_R*s_S +- +- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & +- (qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)* & +- (gammas(i)*p_K_Star + pi_infs(i)) + & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)* & +- qvs(i))*s_S +- end do +- !$acc loop seq +- do i = 1, num_dims +- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = rho_Star*s_S* & +- (s_S*dir_flg(dir_idx(i)) + vel_R(dir_idx(i))*(1d0 - dir_flg(dir_idx(i)))) + & +- dir_flg(dir_idx(i))*p_Star +- +- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & +- dir_flg(dir_idx(i))*(s_S*xi_R - vel_R(dir_idx(i))) +- ! Compute the star velocities for the non-conservative terms +- end do +- +- if (.not. f_is_default(sigma)) then +- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & +- qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx)*s_S ++ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) + end if +- +- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_Star + p_Star)*s_S +- +- end if +- +- flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) +- +- ! Geometrical source flux for cylindrical coordinates +- if (cyl_coord .and. norm_dir == 2) then +- ! Substituting the advective flux into the inviscid geometrical source flux +- !$acc loop seq +- do i = 1, E_idx +- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) +- end do +- !$acc loop seq +- do i = intxb, intxe +- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) +- end do +- ! Recalculating the radial momentum geometric source flux (subtracting the pressure part) +- flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & +- flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star +- ! Geometrical source of the void fraction(s) is zero +- !$acc loop seq +- do i = advxb, advxe +- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 +- end do +- end if ++ #:endif + + end do + end do + end do ++ + elseif (model_eqns == 4) then + !ME4 +- !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, & +- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) ++ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) + do l = is3%beg, is3%end + do k = is2%beg, is2%end + do j = is1%beg, is1%end +@@ -1632,11 +1724,11 @@ contains + end if + + E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms +- + E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + + H_L = (E_L + pres_L)/rho_L + H_R = (E_R + pres_R)/rho_R ++ + if (avg_state == 2) then + !$acc loop seq + do i = 1, nb +@@ -1749,13 +1841,11 @@ contains + + call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & + vel_L_rms, c_L) +- + call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & + vel_R_rms, c_R) + + !> The computation of c_avg does not require all the variables, and therefore the non '_avg' + ! variables are placeholders to call the subroutine. +- + call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & + vel_avg_rms, c_avg) + +@@ -1861,7 +1951,6 @@ contains + + ! Energy flux. + ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) +- + flux_rs${XYZ}$_vf(j, k, l, E_idx) = & + xi_M*(vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) + & + s_M*(xi_L*(E_L + (s_S - vel_L(dir_idx(1)))* & +@@ -1874,7 +1963,6 @@ contains + + (s_M/s_L)*(s_P/s_R)*pcorr*s_S + + ! Volume fraction flux +- + !$acc loop seq + do i = advxb, advxe + flux_rs${XYZ}$_vf(j, k, l, i) = & +@@ -1980,8 +2068,10 @@ contains + end do + !$acc end parallel loop + else ++ ! 5-EQUATION MODEL WITH HLLC, INTERFACE CAPTURING ONLY + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & +- !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp) copyin(is1,is2,is3) ++ !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, & ++ !$acc tau_e_L, tau_e_R, xi_field_L, xi_field_R, vel_L_tmp, vel_R_tmp) copyin(is1,is2,is3) + do l = is3%beg, is3%end + do k = is2%beg, is2%end + do j = is1%beg, is1%end +@@ -2064,39 +2154,85 @@ contains + !$acc loop seq + do i = 1, 2 + Re_L(i) = dflt_real +- + if (Re_size(i) > 0) Re_L(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + + Re_L(i) + end do +- + Re_L(i) = 1d0/max(Re_L(i), sgm_eps) +- + end do + + !$acc loop seq + do i = 1, 2 + Re_R(i) = dflt_real +- + if (Re_size(i) > 0) Re_R(i) = 0d0 +- + !$acc loop seq + do q = 1, Re_size(i) + Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res(i, q) & + + Re_R(i) + end do +- + Re_R(i) = 1d0/max(Re_R(i), sgm_eps) + end do + end if + + E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L +- + E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R + ++ ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY ++ if (hypoelasticity) then ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ++ end do ++ G_L = 0d0; G_R = 0d0 ++ !$acc loop seq ++ do i = 1, num_fluids ++ G_L = G_L + alpha_L(i)*Gs(i) ++ G_R = G_R + alpha_R(i)*Gs(i) ++ end do ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ ! Elastic contribution to energy if G large enough ++ if ((G_L > verysmall) .and. (G_R > verysmall)) then ++ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) ++ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) ++ ! Additional terms in 2D and 3D ++ if ((i == 2) .or. (i == 4) .or. (i == 5)) then ++ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) ++ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) ++ end if ++ end if ++ end do ++ end if ++ ++ ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY ++ if (hyperelasticity) then ++ !$acc loop seq ++ do i = 1, num_dims ++ xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) ++ xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) ++ end do ++ G_L = 0d0; G_R = 0d0; ++ !$acc loop seq ++ do i = 1, num_fluids ++ ! Mixture left and right shear modulus ++ G_L = G_L + alpha_L(i)*Gs(i) ++ G_R = G_R + alpha_R(i)*Gs(i) ++ end do ++ ! Elastic contribution to energy if G large enough ++ if ( G_L > verysmall .and. G_R > verysmall ) then ++ E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) ++ E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) ++ end if ++ !$acc loop seq ++ do i = 1, b_size - 1 ++ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) ++ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ++ end do ++ end if ++ + H_L = (E_L + pres_L)/rho_L + H_R = (E_R + pres_R)/rho_R + +@@ -2110,7 +2246,6 @@ contains + + !> The computation of c_avg does not require all the variables, and therefore the non '_avg' + ! variables are placeholders to call the subroutine. +- + call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & + vel_avg_rms, c_avg) + +@@ -2126,16 +2261,25 @@ contains + end if + + if (wave_speeds == 1) then +- s_L = min(vel_L(idx1) - c_L, vel_R(idx1) - c_R) +- s_R = max(vel_R(idx1) + c_R, vel_L(idx1) + c_L) +- +- s_S = (pres_R - pres_L + rho_L*vel_L(idx1)* & +- (s_L - vel_L(idx1)) - & +- rho_R*vel_R(idx1)* & +- (s_R - vel_R(idx1))) & +- /(rho_L*(s_L - vel_L(idx1)) - & +- rho_R*(s_R - vel_R(idx1))) ++ if (elasticity) then ++ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & ++ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & ++ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) ++ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & ++ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & ++ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) ++ s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & ++ tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & ++ rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & ++ rho_R*(s_R - vel_R(idx1))) ++ else ++ s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) ++ s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) ++ s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & ++ (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & ++ /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) + ++ end if + elseif (wave_speeds == 2) then + pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & + (vel_L(idx1) - & +@@ -2172,6 +2316,8 @@ contains + xi_M = (5d-1 + sign(5d-1, s_S)) + xi_P = (5d-1 - sign(5d-1, s_S)) + ++ ! COMPUTING THE HLLC FLUXES ++ ! MASS FLUX. + if (low_Mach == 1) then + @:compute_low_Mach_correction() + else +@@ -2181,15 +2327,13 @@ contains + !$acc loop seq + do i = 1, contxe + flux_rs${XYZ}$_vf(j, k, l, i) = & +- xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & +- *(vel_L(idx1) + s_M*(xi_L - 1d0)) & +- + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & +- *(vel_R(idx1) + s_P*(xi_R - 1d0)) ++ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & ++ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) + end do + +- ! Momentum flux. +- ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w) +- !$acc loop seq ++ ! MOMENTUM FLUX. ++ ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) ++ !$acc loop seq + do i = 1, num_dims + idxi = dir_idx(i) + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & +@@ -2206,32 +2350,68 @@ contains + vel_R(idxi)) - vel_R(idxi))) + & + dir_flg(idxi)*(pres_R)) & + + (s_M/s_L)*(s_P/s_R)*dir_flg(idxi)*pcorr ++ ++ !idxi = dir_idx(i) ++ !flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & ++ ! xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & ++ !(1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & ++ ! xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & ++ !(1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) & ++ ! + (s_M/s_L)*(s_P/s_R)*dir_flg(dir_idx(i))*pcorr + end do + +- ! Energy flux. +- ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) ++ ! ENERGY FLUX. ++ ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) + flux_rs${XYZ}$_vf(j, k, l, E_idx) = & + xi_M*(vel_L(idx1)*(E_L + pres_L) + & +- s_M*(xi_L*(E_L + (s_S - vel_L(idx1))* & +- (rho_L*s_S + pres_L/ & +- (s_L - vel_L(idx1)))) - E_L)) & ++ s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & + + xi_P*(vel_R(idx1)*(E_R + pres_R) + & +- s_P*(xi_R*(E_R + (s_S - vel_R(idx1))* & +- (rho_R*s_S + pres_R/ & +- (s_R - vel_R(idx1)))) - E_R)) & ++ s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) & + + (s_M/s_L)*(s_P/s_R)*pcorr*s_S + +- ! Volume fraction flux ++ ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux ++ if (elasticity) then ++ flux_ene_e = 0d0; ++ !$acc loop seq ++ do i = 1, num_dims ++ ! MOMENTUM ELASTIC FLUX. ++ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & ++ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) & ++ - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) ++ ! ENERGY ELASTIC FLUX. ++ flux_ene_e = flux_ene_e - & ++ xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & ++ s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & ++ xi_P*(vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & ++ s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) ++ end do ++ flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e ++ end if ++ ++ ! HYPOELASTIC STRESS EVOLUTION FLUX. ++ if (hypoelasticity) then ++ !$acc loop seq ++ do i = 1, strxe - strxb + 1 ++ flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & ++ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & ++ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) ++ end do ++ end if ++ ++ ! VOLUME FRACTION FLUX. + !$acc loop seq + do i = advxb, advxe +- flux_rs${XYZ}$_vf(j, k, l, i) = & +- xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & +- *(vel_L(idx1) + s_M*(xi_L - 1d0)) & +- + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & +- *(vel_R(idx1) + s_P*(xi_R - 1d0)) ++ flux_rs${XYZ}$_vf(j, k, l, i) = & ++ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & ++ *(vel_L(idx1) + s_M*(xi_L - 1d0)) & ++ + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & ++ *(vel_R(idx1) + s_P*(xi_R - 1d0)) ++ !flux_rs${XYZ}$_vf(j, k, l, i) = & ++ ! xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & ++ ! xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) + end do + +- ! Source for volume fraction advection equation ++ ! VOLUME FRACTION SOURCE FLUX. + !$acc loop seq + do i = 1, num_dims + idxi = dir_idx(i) +@@ -2242,14 +2422,20 @@ contains + + xi_P*(vel_R(idxi) + & + dir_flg(idxi)* & + s_P*(xi_R - 1d0)) +- +- !if ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0d0 ++ !xi_M*(vel_L(idxi) + dir_flg(idxi)*s_M*(xi_L - 1d0)) + & ++ !xi_P*(vel_R(idxi) + dir_flg(idxi)*s_P*(xi_R - 1d0)) + end do + + flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) + +- ! Geometrical source flux for cylindrical coordinates ++ ! SURFACE TENSION FLUX. need to check ++ !if (.not. f_is_default(sigma)) then ++ ! flux_rs${XYZ}$_vf(j, k, l, c_idx) = & ++ ! (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & ++ ! xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S ++ !end if + ++ ! Geometrical source flux for cylindrical coordinates + #:if (NORM_DIR == 2) + if (cyl_coord) then + !Substituting the advective flux into the inviscid geometrical source flux +@@ -2544,7 +2730,7 @@ contains + + !$acc update device(is1, is2, is3) + +- if (hypoelasticity) then ++ if (elasticity) then + if (norm_dir == 1) then + dir_idx_tau = (/1, 2, 4/) + else if (norm_dir == 2) then diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 16b20b02f3..93582783d3 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -2069,9 +2069,7 @@ contains !$acc end parallel loop else ! 5-EQUATION MODEL WITH HLLC, INTERFACE CAPTURING ONLY - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & - !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, & - !$acc tau_e_L, tau_e_R, xi_field_L, xi_field_R, vel_L_tmp, vel_R_tmp) copyin(is1,is2,is3) + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, tau_e_L, tau_e_R, xi_field_L, xi_field_R, vel_L_tmp, vel_R_tmp) copyin(is1,is2,is3) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -2180,58 +2178,58 @@ contains E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY - if (hypoelasticity) then - !$acc loop seq - do i = 1, strxe - strxb + 1 - tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) - end do - G_L = 0d0; G_R = 0d0 - !$acc loop seq - do i = 1, num_fluids - G_L = G_L + alpha_L(i)*Gs(i) - G_R = G_R + alpha_R(i)*Gs(i) - end do - !$acc loop seq - do i = 1, strxe - strxb + 1 - ! Elastic contribution to energy if G large enough - if ((G_L > verysmall) .and. (G_R > verysmall)) then - E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) - E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) - ! Additional terms in 2D and 3D - if ((i == 2) .or. (i == 4) .or. (i == 5)) then - E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) - E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) - end if - end if - end do - end if + !if (hypoelasticity) then + ! !$acc loop seq + ! do i = 1, strxe - strxb + 1 + ! tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + ! tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + ! end do + ! G_L = 0d0; G_R = 0d0 + ! !$acc loop seq + ! do i = 1, num_fluids + ! G_L = G_L + alpha_L(i)*Gs(i) + ! G_R = G_R + alpha_R(i)*Gs(i) + ! end do + ! !$acc loop seq + ! do i = 1, strxe - strxb + 1 + ! ! Elastic contribution to energy if G large enough + ! if ((G_L > verysmall) .and. (G_R > verysmall)) then + ! E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) + ! E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) + ! ! Additional terms in 2D and 3D + ! if ((i == 2) .or. (i == 4) .or. (i == 5)) then + ! E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) + ! E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) + ! end if + ! end if + ! end do + !end if ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY - if (hyperelasticity) then - !$acc loop seq - do i = 1, num_dims - xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) - xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) - end do - G_L = 0d0; G_R = 0d0; - !$acc loop seq - do i = 1, num_fluids - ! Mixture left and right shear modulus - G_L = G_L + alpha_L(i)*Gs(i) - G_R = G_R + alpha_R(i)*Gs(i) - end do - ! Elastic contribution to energy if G large enough - if ( G_L > verysmall .and. G_R > verysmall ) then - E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) - E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) - end if - !$acc loop seq - do i = 1, b_size - 1 - tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) - end do - end if + !if (hyperelasticity) then + ! !$acc loop seq + ! do i = 1, num_dims + ! xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) + ! xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) + ! end do + ! G_L = 0d0; G_R = 0d0; + ! !$acc loop seq + ! do i = 1, num_fluids + ! ! Mixture left and right shear modulus + ! G_L = G_L + alpha_L(i)*Gs(i) + ! G_R = G_R + alpha_R(i)*Gs(i) + ! end do + ! ! Elastic contribution to energy if G large enough + ! if ( G_L > verysmall .and. G_R > verysmall ) then + ! E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) + ! E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) + ! end if + ! !$acc loop seq + ! do i = 1, b_size - 1 + ! tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + ! tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + ! end do + !end if H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -2261,25 +2259,34 @@ contains end if if (wave_speeds == 1) then - if (elasticity) then - s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & - (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) - s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & - (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) - s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & - tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & - rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & - rho_R*(s_R - vel_R(idx1))) - else - s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) - s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) - s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & - (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & - /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) - - end if + s_L = min(vel_L(idx1) - c_L, vel_R(idx1) - c_R) + s_R = max(vel_R(idx1) + c_R, vel_L(idx1) + c_L) + s_S = (pres_R - pres_L + rho_L*vel_L(idx1)* & + (s_L - vel_L(idx1)) - & + rho_R*vel_R(idx1)* & + (s_R - vel_R(idx1))) & + /(rho_L*(s_L - vel_L(idx1)) - & + rho_R*(s_R - vel_R(idx1))) + + !if (elasticity) then + ! s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & + ! (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & + ! (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) + ! s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & + ! (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & + ! (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) + ! s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & + ! tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & + ! rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & + ! rho_R*(s_R - vel_R(idx1))) + !else + ! s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) + ! s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) + ! s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & + ! (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & + ! /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) + ! + !end if elseif (wave_speeds == 2) then pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(idx1) - & @@ -2327,8 +2334,12 @@ contains !$acc loop seq do i = 1, contxe flux_rs${XYZ}$_vf(j, k, l, i) = & - xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & - xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) + xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & + *(vel_L(idx1) + s_M*(xi_L - 1d0)) & + + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & + *(vel_R(idx1) + s_P*(xi_R - 1d0)) + !xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & + !xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) end do ! MOMENTUM FLUX. @@ -2364,9 +2375,15 @@ contains ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) flux_rs${XYZ}$_vf(j, k, l, E_idx) = & xi_M*(vel_L(idx1)*(E_L + pres_L) + & - s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & + s_M*(xi_L*(E_L + (s_S - vel_L(idx1))* & + (rho_L*s_S + pres_L/ & + (s_L - vel_L(idx1)))) - E_L)) & + ! s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & + xi_P*(vel_R(idx1)*(E_R + pres_R) + & - s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) & + s_P*(xi_R*(E_R + (s_S - vel_R(idx1))* & + (rho_R*s_S + pres_R/ & + (s_R - vel_R(idx1)))) - E_R)) & + ! s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) & + (s_M/s_L)*(s_P/s_R)*pcorr*s_S ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux From 378f7f29b66bc3c63ccf0ceb371b7b63987b106a Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 5 Aug 2024 19:00:14 -0500 Subject: [PATCH 277/380] working code, cleaning up the code --- diff.txt | 1095 -------------------------- src/simulation/m_riemann_solvers.fpp | 187 +++-- 2 files changed, 102 insertions(+), 1180 deletions(-) delete mode 100644 diff.txt diff --git a/diff.txt b/diff.txt deleted file mode 100644 index 526b0d4eef..0000000000 --- a/diff.txt +++ /dev/null @@ -1,1095 +0,0 @@ -diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp -index bfca7142..16b20b02 100644 ---- a/src/simulation/m_riemann_solvers.fpp -+++ b/src/simulation/m_riemann_solvers.fpp -@@ -162,14 +162,14 @@ module m_riemann_solvers - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsx_vf, flux_src_rsx_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsy_vf, flux_src_rsy_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsz_vf, flux_src_rsz_vf) -- !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & -- !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) -+ !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & -+ !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) - #else - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsx_vf, flux_src_rsx_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsy_vf, flux_src_rsy_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsz_vf, flux_src_rsz_vf -- !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & -- !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) -+ !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & -+ !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf) - #endif - !> @} - -@@ -313,6 +313,7 @@ contains - real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R - real(kind(0d0)) :: G_L, G_R - real(kind(0d0)), dimension(2) :: Re_L, Re_R -+ real(kind(0d0)), dimension(3) :: xi_field_L, xi_field_R - - real(kind(0d0)) :: rho_avg - real(kind(0d0)), dimension(num_dims) :: vel_avg -@@ -356,8 +357,7 @@ contains - #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] - - if (norm_dir == ${NORM_DIR}$) then -- !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, & -- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S) -+ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, xi_field_L, xi_field_R) - do l = is3%beg, is3%end - do k = is2%beg, is2%end - do j = is1%beg, is1%end -@@ -440,31 +440,24 @@ contains - !$acc loop seq - do i = 1, 2 - Re_L(i) = dflt_real -- - if (Re_size(i) > 0) Re_L(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_L(i) = alpha_L(Re_idx(i, q))/Res(i, q) & - + Re_L(i) - end do -- - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) -- - end do - - !$acc loop seq - do i = 1, 2 - Re_R(i) = dflt_real -- - if (Re_size(i) > 0) Re_R(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_R(i) = alpha_R(Re_idx(i, q))/Res(i, q) & - + Re_R(i) - end do -- - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) - end do - end if -@@ -472,26 +465,17 @@ contains - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R - -- H_L = (E_L + pres_L)/rho_L -- H_R = (E_R + pres_R)/rho_R -- -+ ! elastic energy update - if (hypoelasticity) then -- !$acc loop seq -- do i = 1, strxe - strxb + 1 -- tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -- tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -- end do -- -- G_L = 0d0 -- G_R = 0d0 -- -+ G_L = 0d0; G_R = 0d0 - !$acc loop seq - do i = 1, num_fluids - G_L = G_L + alpha_L(i)*Gs(i) - G_R = G_R + alpha_R(i)*Gs(i) - end do -- - do i = 1, strxe - strxb + 1 -+ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) - ! Elastic contribution to energy if G large enough - !TODO take out if statement if stable without - if ((G_L > 1000) .and. (G_R > 1000)) then -@@ -506,19 +490,57 @@ contains - end do - end if - -+ ! elastic energy update -+ !if ( hyperelasticity ) then -+ ! G_L = 0d0 -+ ! G_R = 0d0 -+ ! -+ ! !$acc loop seq -+ ! do i = 1, num_fluids -+ ! G_L = G_L + alpha_L(i)*Gs(i) -+ ! G_R = G_R + alpha_R(i)*Gs(i) -+ ! end do -+ ! ! Elastic contribution to energy if G large enough -+ ! if ((G_L > 1d-3) .and. (G_R > 1d-3)) then -+ ! E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) -+ ! E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) -+ ! !$acc loop seq -+ ! do i = 1, b_size-1 -+ ! tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ ! tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -+ ! end do -+ ! !$acc loop seq -+ ! do i = 1, b_size-1 -+ ! tau_e_L(i) = 0d0 -+ ! tau_e_R(i) = 0d0 -+ ! end do -+ ! !$acc loop seq -+ ! do i = 1, num_dims -+ ! xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) -+ ! xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) -+ ! end do -+ ! end if -+ !end if -+ -+ ! Enthalpy with elastic energy -+ H_L = (E_L + pres_L)/rho_L -+ H_R = (E_R + pres_R)/rho_R -+ - @:compute_average_state() - - call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & -- vel_L_rms, c_L) -+ vel_L_rms, c_L, Gs) - - call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & -- vel_R_rms, c_R) -+ vel_R_rms, c_R, Gs) - - !> The computation of c_avg does not require all the variables, and therefore the non '_avg' - ! variables are placeholders to call the subroutine. - - call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & -- vel_avg_rms, c_avg) -+ vel_avg_rms, c_avg, Gs) -+ -+ !SGR added Gs to all of the above speed of sound clacs - - if (any(Re_size > 0)) then - !$acc loop seq -@@ -541,6 +563,11 @@ contains - , vel_L(dir_idx(1)) + sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + & - tau_e_L(dir_idx_tau(1)))/rho_L)) -+ else if (hyperelasticity) then -+ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L) & -+ , vel_R(dir_idx(1)) - sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R)) -+ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + (4d0*G_R/3d0)/rho_R) & -+ , vel_L(dir_idx(1)) + sqrt(c_L*c_L + (4d0*G_L/3d0)/rho_L)) - else - s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) - s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) -@@ -716,6 +743,18 @@ contains - /(s_M - s_P) - end do - -+ ! Xi field -+ !if ( hyperelasticity ) then -+ ! do i = 1, num_dims -+ ! flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & -+ ! (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & -+ ! - s_P*rho_L*vel_L(dir_idx(1))*xi_field_L(i) & -+ ! + s_M*s_P*(rho_L*xi_field_L(i) & -+ ! - rho_R*xi_field_R(i))) & -+ ! /(s_M - s_P) -+ ! end do -+ !end if -+ - ! Div(U)? - !$acc loop seq - do i = 1, num_dims -@@ -822,7 +861,6 @@ contains - - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf - type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf -- - type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf - - type(scalar_field), & -@@ -862,6 +900,11 @@ contains - real(kind(0d0)) :: s_L, s_R, s_M, s_P, s_S - real(kind(0d0)) :: xi_L, xi_R !< Left and right wave speeds functions - real(kind(0d0)) :: xi_M, xi_P -+ real(kind(0d0)) :: xi_MP, xi_PP -+ -+ real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R -+ real(kind(0d0)), dimension(num_dims) :: xi_field_L, xi_field_R -+ real(kind(0d0)) :: G_L, G_R - - real(kind(0d0)) :: nbub_L, nbub_R - real(kind(0d0)), dimension(nb) :: R0_L, R0_R -@@ -880,9 +923,10 @@ contains - real(kind(0d0)) :: vel_L_rms, vel_R_rms, vel_avg_rms - real(kind(0d0)) :: vel_L_tmp, vel_R_tmp - real(kind(0d0)) :: blkmod1, blkmod2 -- real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star -+ real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star, vel_K_Star - real(kind(0d0)) :: pres_SL, pres_SR, Ms_L, Ms_R - real(kind(0d0)) :: start, finish -+ real(kind(0d0)) :: flux_ene_e - real(kind(0d0)) :: zcoef, pcorr !< low Mach number correction - integer :: i, j, k, l, q !< Generic loop iterators - integer :: idx1, idxi -@@ -909,15 +953,16 @@ contains - flux_gsrc_vf, & - norm_dir, ix, iy, iz) - -+ idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 -+ - #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] - - if (norm_dir == ${NORM_DIR}$) then -+ -+ ! 6-EQUATION MODEL WITH HLLC - if (model_eqns == 3) then - !ME3 -- -- !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & -- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R) -- -+ !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R, flux_ene_e, xi_field_L, xi_field_R) - do l = is3%beg, is3%end - do k = is2%beg, is2%end - do j = is1%beg, is1%end -@@ -994,39 +1039,85 @@ contains - !$acc loop seq - do i = 1, 2 - Re_L(i) = dflt_real -- - if (Re_size(i) > 0) Re_L(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q))/Res(i, q) & - + Re_L(i) - end do -- - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) -- - end do - - !$acc loop seq - do i = 1, 2 - Re_R(i) = dflt_real -- - if (Re_size(i) > 0) Re_R(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res(i, q) & - + Re_R(i) - end do -- - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) - end do - end if - - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L -- - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R - -+ ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY -+ if (hypoelasticity) then -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -+ end do -+ G_L = 0d0; G_R = 0d0 -+ !$acc loop seq -+ do i = 1, num_fluids -+ G_L = G_L + alpha_L(i)*Gs(i) -+ G_R = G_R + alpha_R(i)*Gs(i) -+ end do -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ ! Elastic contribution to energy if G large enough -+ if ((G_L > verysmall) .and. (G_R > verysmall)) then -+ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) -+ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) -+ ! Additional terms in 2D and 3D -+ if ((i == 2) .or. (i == 4) .or. (i == 5)) then -+ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) -+ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) -+ end if -+ end if -+ end do -+ end if -+ -+ ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY -+ if (hyperelasticity) then -+ !$acc loop seq -+ do i = 1, num_dims -+ xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) -+ xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) -+ end do -+ G_L = 0d0; G_R = 0d0; -+ !$acc loop seq -+ do i = 1, num_fluids -+ ! Mixture left and right shear modulus -+ G_L = G_L + alpha_L(i)*Gs(i) -+ G_R = G_R + alpha_R(i)*Gs(i) -+ end do -+ ! Elastic contribution to energy if G large enough -+ if ( G_L > verysmall .and. G_R > verysmall ) then -+ E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) -+ E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) -+ end if -+ !$acc loop seq -+ do i = 1, b_size - 1 -+ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -+ end do -+ end if -+ - H_L = (E_L + pres_L)/rho_L - H_R = (E_R + pres_R)/rho_R - -@@ -1034,13 +1125,10 @@ contains - - call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & - vel_L_rms, c_L) -- - call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & - vel_R_rms, c_R) -- - !> The computation of c_avg does not require all the variables, and therefore the non '_avg' - ! variables are placeholders to call the subroutine. -- - call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & - vel_avg_rms, c_avg) - -@@ -1051,222 +1139,226 @@ contains - end do - end if - -+ ! COMPUTING THE DIRECT WAVE SPEEDS - if (wave_speeds == 1) then -- s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) -- s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) -+ if (elasticity) then -+ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & -+ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & -+ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) -+ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & -+ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & -+ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) -+ s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & -+ tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & -+ rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & -+ rho_R*(s_R - vel_R(idx1))) -+ else -+ s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) -+ s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) -+ s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & -+ (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & -+ /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) - -- s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & -- (s_L - vel_L(dir_idx(1))) - & -- rho_R*vel_R(dir_idx(1))* & -- (s_R - vel_R(dir_idx(1)))) & -- /(rho_L*(s_L - vel_L(dir_idx(1))) - & -- rho_R*(s_R - vel_R(dir_idx(1)))) -+ end if - elseif (wave_speeds == 2) then - pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & - (vel_L(dir_idx(1)) - & - vel_R(dir_idx(1)))) -- - pres_SR = pres_SL -- - Ms_L = max(1d0, sqrt(1d0 + ((5d-1 + gamma_L)/(1d0 + gamma_L))* & - (pres_SL/pres_L - 1d0)*pres_L/ & - ((pres_L + pi_inf_L/(1d0 + gamma_L))))) - Ms_R = max(1d0, sqrt(1d0 + ((5d-1 + gamma_R)/(1d0 + gamma_R))* & - (pres_SR/pres_R - 1d0)*pres_R/ & - ((pres_R + pi_inf_R/(1d0 + gamma_R))))) -- - s_L = vel_L(dir_idx(1)) - c_L*Ms_L - s_R = vel_R(dir_idx(1)) + c_R*Ms_R -- - s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & - (pres_L - pres_R)/ & - (rho_avg*c_avg)) - end if - -- if (s_L >= 0d0) then -- p_Star = pres_L ! Only useful to recalculate the radial momentum geometric source flux -- !$acc loop seq -- do i = 1, num_fluids -- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)*s_S -+ ! follows Einfeldt et al. -+ ! s_M/P = min/max(0.,s_L/R) -+ s_M = min(0d0, s_L); s_P = max(0d0, s_R) - -- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)*vel_L(dir_idx(1)) -+ ! goes with q_star_L/R = xi_L/R * (variable) -+ ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) ) -+ xi_L = (s_L - vel_L(idx1))/(s_L - s_S) -+ xi_R = (s_R - vel_R(idx1))/(s_R - s_S) - -- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & -- (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & -- (gammas(i)*pres_L + pi_infs(i)) + & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & -- qvs(i))*vel_L(dir_idx(1)) -- end do -- !$acc loop seq -- do i = 1, num_dims -- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & -- rho_L*vel_L(dir_idx(1))*vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*pres_L -+ ! goes with numerical star velocity in x/y/z directions -+ ! xi_P/M = 0.5 +/m sgn(0.5,s_star) -+ xi_M = (5d-1 + sign(5d-1, s_S)) -+ xi_P = (5d-1 - sign(5d-1, s_S)) - -- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & -- dir_flg(dir_idx(i))*(s_S - vel_L(dir_idx(i))) -- ! Compute the star velocities for the non-conservative terms -- end do -- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_L + pres_L)*vel_L(dir_idx(1)) -+ ! goes with the numerical velocity in x/y/z directions -+ ! xi_P/M (pressure) = min/max(0. sgn(1,sL/sR)) -+ xi_MP = -min(0d0, sign(1d0, s_L)) -+ xi_PP = max(0d0, sign(1d0, s_R)) - -- if (.not. f_is_default(sigma)) then -- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, c_idx)*s_S -- end if -+ ! COMPUTING FLUXES -+ ! MASS FLUX. -+ !$acc loop seq -+ do i = 1, contxe -+ flux_rs${XYZ}$_vf(j, k, l, i) = & -+ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & -+ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) -+ end do - -- ! Compute right solution state -- else if (s_R <= 0d0) then -- p_Star = pres_R -- ! Only useful to recalculate the radial momentum geometric source flux -- !$acc loop seq -- do i = 1, num_fluids -- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)*s_S -+ ! MOMENTUM FLUX. -+ ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) -+ !$acc loop seq -+ do i = 1, num_dims -+ !idxi = dir_idx(i) -+ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & -+ xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & -+ (1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & -+ xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & -+ (1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) -+ end do - -- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)*vel_R(dir_idx(1)) -+ ! ENERGY FLUX. -+ ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) -+ flux_rs${XYZ}$_vf(j, k, l, E_idx) = & -+ xi_M*(vel_L(idx1)*(E_L + pres_L) + & -+ s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & -+ + xi_P*(vel_R(idx1)*(E_R + pres_R) + & -+ s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) -+ -+ ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux -+ if (elasticity) then -+ flux_ene_e = 0d0; -+ !$acc loop seq -+ do i = 1, num_dims -+ ! MOMENTUM ELASTIC FLUX. -+ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & -+ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) & -+ - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) -+ ! ENERGY ELASTIC FLUX. -+ flux_ene_e = flux_ene_e - & -+ xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & -+ s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & -+ xi_P*(vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & -+ s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) -+ end do -+ flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e -+ end if - -- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & -- (qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)* & -- (gammas(i)*pres_R + pi_infs(i)) + & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)* & -- qvs(i))*vel_R(dir_idx(1)) -- end do -- !$acc loop seq -- do i = 1, num_dims -- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & -- rho_R*vel_R(dir_idx(1))*vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*pres_R -+ ! VOLUME FRACTION FLUX. -+ !$acc loop seq -+ do i = advxb, advxe -+ flux_rs${XYZ}$_vf(j, k, l, i) = & -+ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*s_S + & -+ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*s_S -+ end do - -- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & -- dir_flg(dir_idx(i))*(s_S - vel_R(dir_idx(i))) -- ! Compute the star velocities for the non-conservative terms -- end do -- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_R + pres_R)*vel_R(dir_idx(1)) -+ ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. -+ !$acc loop seq -+ do i = 1, num_dims -+ !idxi = dir_idx(i) -+ vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = & -+ xi_M*(vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_MP*(xi_L - 1) + 1) - vel_L(dir_idx(i)))) + & -+ xi_P*(vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(dir_idx(i)))) -+ end do - -- if (.not. f_is_default(sigma)) then -- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx)*s_S -- end if -+ ! INTERNAL ENERGIES ADVECTION FLUX. -+ ! K-th pressure and velocity in preparation for the internal energy flux -+ vel_K_Star = vel_L(idx1)*(1d0 - xi_MP) + xi_MP*vel_R(idx1) + & -+ xi_MP*xi_PP*(s_S - vel_R(idx1)) -+ !$acc loop seq -+ do i = 1, num_fluids -+ p_K_Star = xi_M*(xi_MP*((pres_L + pi_infs(i)/(1d0 + gammas(i)))* & -+ xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - pres_L) + pres_L) + & -+ xi_P*(xi_PP*((pres_R + pi_infs(i)/(1d0 + gammas(i)))* & -+ xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) - pres_R) + pres_R) -+ -+ flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & -+ (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & -+ (gammas(i)*p_K_Star + pi_infs(i)) + & -+ qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & -+ qvs(i))*vel_K_Star -+ end do - -- ! Compute left star solution state -- else if (s_S >= 0d0) then -- xi_L = (s_L - vel_L(dir_idx(1)))/(s_L - s_S) -- rho_Star = rho_L*xi_L -- E_Star = xi_L*(E_L + (s_S - vel_L(dir_idx(1)))* & -- (rho_L*s_S + pres_L/(s_L - vel_L(dir_idx(1))))) -- p_Star = rho_L*(s_L - vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1))) + pres_L -- !$acc loop seq -- do i = 1, num_fluids -- p_K_Star = (pres_L + pi_infs(i)/(1d0 + gammas(i)))* & -- xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) -+ flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) - -- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)*s_S -+ ! HYPOELASTIC STRESS EVOLUTION FLUX. -+ if (hypoelasticity) then -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & -+ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & -+ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) -+ end do -+ end if - -- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)*xi_L*s_S -+ ! REFERENCE MAP FLUX. -+ if (hyperelasticity) then -+ !$acc loop seq -+ do i = 1, num_dims -+ flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & -+ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*xi_field_L(i) & -+ - rho_L*vel_L(idx1)*xi_field_L(i)) + & -+ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*xi_field_R(i) & -+ - rho_R*vel_R(idx1)*xi_field_R(i)) -+ end do -+ end if - -- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & -- (qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)* & -- (gammas(i)*p_K_Star + pi_infs(i)) + & -- qL_prim_rs${XYZ}$_vf(j, k, l, i + contxb - 1)* & -- qvs(i))*s_S -- end do -- !$acc loop seq -- do i = 1, num_dims -- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & -- rho_Star*s_S*(s_S*dir_flg(dir_idx(i)) + vel_L(dir_idx(i))* & -- (1d0 - dir_flg(dir_idx(i)))) + dir_flg(dir_idx(i))*p_Star -+ ! SURFACE TENSION FLUX. need to check -+ if (.not. f_is_default(sigma)) then -+ flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -+ (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & -+ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S -+ end if - -- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & -- dir_flg(dir_idx(i))*(s_S*xi_L - vel_L(dir_idx(i))) -- ! Compute the star velocities for the non-conservative terms -- end do -- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_Star + p_Star)*s_S -+ ! correction pressure for the cylindrical terms -+ p_Star = xi_M*(pres_L + xi_MP*rho_L*(s_L - & -+ vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1)))) + & -+ xi_P*(pres_R + xi_PP*rho_R*(s_R - & -+ vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1)))) - -- if (.not. f_is_default(sigma)) then -- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -- qL_prim_rs${XYZ}$_vf(j, k, l, c_idx)*s_S -+ ! Geometrical source flux for cylindrical coordinates -+ #:if (NORM_DIR == 2) -+ if (cyl_coord) then -+ !Substituting the advective flux into the inviscid geometrical source flux -+ !$acc loop seq -+ do i = 1, E_idx -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) -+ end do -+ !$acc loop seq -+ do i = intxb, intxe -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) -+ end do -+ ! Recalculating the radial momentum geometric source flux -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star -+ ! Geometrical source of the void fraction(s) is zero -+ !$acc loop seq -+ do i = advxb, advxe -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 -+ end do - end if -+ #:endif -+ #:if (NORM_DIR == 3) -+ if (grid_geometry == 3) then -+ !$acc loop seq -+ do i = 1, sys_size -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 -+ end do -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star - -- ! Compute right star solution state -- else -- xi_R = (s_R - vel_R(dir_idx(1)))/(s_R - s_S) -- -- rho_Star = rho_R*xi_R -- -- E_Star = xi_R*(E_R + (s_S - vel_R(dir_idx(1)))* & -- (rho_R*s_S + pres_R/(s_R - vel_R(dir_idx(1))))) -- -- p_Star = rho_R*(s_R - vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1))) + pres_R -- !$acc loop seq -- do i = 1, num_fluids -- p_K_Star = (pres_R + pi_infs(i)/(1d0 + gammas(i)))* & -- xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) -- -- flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)*s_S -- -- flux_rs${XYZ}$_vf(j, k, l, i + contxb - 1) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)*xi_R*s_S -- -- flux_rs${XYZ}$_vf(j, k, l, i + intxb - 1) = & -- (qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)* & -- (gammas(i)*p_K_Star + pi_infs(i)) + & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + contxb - 1)* & -- qvs(i))*s_S -- end do -- !$acc loop seq -- do i = 1, num_dims -- flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = rho_Star*s_S* & -- (s_S*dir_flg(dir_idx(i)) + vel_R(dir_idx(i))*(1d0 - dir_flg(dir_idx(i)))) + & -- dir_flg(dir_idx(i))*p_Star -- -- vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & -- dir_flg(dir_idx(i))*(s_S*xi_R - vel_R(dir_idx(i))) -- ! Compute the star velocities for the non-conservative terms -- end do -- -- if (.not. f_is_default(sigma)) then -- flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -- qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx)*s_S -+ flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) - end if -- -- flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_Star + p_Star)*s_S -- -- end if -- -- flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) -- -- ! Geometrical source flux for cylindrical coordinates -- if (cyl_coord .and. norm_dir == 2) then -- ! Substituting the advective flux into the inviscid geometrical source flux -- !$acc loop seq -- do i = 1, E_idx -- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) -- end do -- !$acc loop seq -- do i = intxb, intxe -- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = flux_rs${XYZ}$_vf(j, k, l, i) -- end do -- ! Recalculating the radial momentum geometric source flux (subtracting the pressure part) -- flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) = & -- flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_Star -- ! Geometrical source of the void fraction(s) is zero -- !$acc loop seq -- do i = advxb, advxe -- flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 -- end do -- end if -+ #:endif - - end do - end do - end do -+ - elseif (model_eqns == 4) then - !ME4 -- !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, & -- !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) -+ !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) - do l = is3%beg, is3%end - do k = is2%beg, is2%end - do j = is1%beg, is1%end -@@ -1632,11 +1724,11 @@ contains - end if - - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms -- - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms - - H_L = (E_L + pres_L)/rho_L - H_R = (E_R + pres_R)/rho_R -+ - if (avg_state == 2) then - !$acc loop seq - do i = 1, nb -@@ -1749,13 +1841,11 @@ contains - - call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & - vel_L_rms, c_L) -- - call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & - vel_R_rms, c_R) - - !> The computation of c_avg does not require all the variables, and therefore the non '_avg' - ! variables are placeholders to call the subroutine. -- - call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & - vel_avg_rms, c_avg) - -@@ -1861,7 +1951,6 @@ contains - - ! Energy flux. - ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) -- - flux_rs${XYZ}$_vf(j, k, l, E_idx) = & - xi_M*(vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) + & - s_M*(xi_L*(E_L + (s_S - vel_L(dir_idx(1)))* & -@@ -1874,7 +1963,6 @@ contains - + (s_M/s_L)*(s_P/s_R)*pcorr*s_S - - ! Volume fraction flux -- - !$acc loop seq - do i = advxb, advxe - flux_rs${XYZ}$_vf(j, k, l, i) = & -@@ -1980,8 +2068,10 @@ contains - end do - !$acc end parallel loop - else -+ ! 5-EQUATION MODEL WITH HLLC, INTERFACE CAPTURING ONLY - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & -- !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp) copyin(is1,is2,is3) -+ !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, & -+ !$acc tau_e_L, tau_e_R, xi_field_L, xi_field_R, vel_L_tmp, vel_R_tmp) copyin(is1,is2,is3) - do l = is3%beg, is3%end - do k = is2%beg, is2%end - do j = is1%beg, is1%end -@@ -2064,39 +2154,85 @@ contains - !$acc loop seq - do i = 1, 2 - Re_L(i) = dflt_real -- - if (Re_size(i) > 0) Re_L(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q))/Res(i, q) & - + Re_L(i) - end do -- - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) -- - end do - - !$acc loop seq - do i = 1, 2 - Re_R(i) = dflt_real -- - if (Re_size(i) > 0) Re_R(i) = 0d0 -- - !$acc loop seq - do q = 1, Re_size(i) - Re_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q))/Res(i, q) & - + Re_R(i) - end do -- - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) - end do - end if - - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L -- - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R - -+ ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY -+ if (hypoelasticity) then -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -+ end do -+ G_L = 0d0; G_R = 0d0 -+ !$acc loop seq -+ do i = 1, num_fluids -+ G_L = G_L + alpha_L(i)*Gs(i) -+ G_R = G_R + alpha_R(i)*Gs(i) -+ end do -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ ! Elastic contribution to energy if G large enough -+ if ((G_L > verysmall) .and. (G_R > verysmall)) then -+ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) -+ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) -+ ! Additional terms in 2D and 3D -+ if ((i == 2) .or. (i == 4) .or. (i == 5)) then -+ E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) -+ E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) -+ end if -+ end if -+ end do -+ end if -+ -+ ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY -+ if (hyperelasticity) then -+ !$acc loop seq -+ do i = 1, num_dims -+ xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) -+ xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) -+ end do -+ G_L = 0d0; G_R = 0d0; -+ !$acc loop seq -+ do i = 1, num_fluids -+ ! Mixture left and right shear modulus -+ G_L = G_L + alpha_L(i)*Gs(i) -+ G_R = G_R + alpha_R(i)*Gs(i) -+ end do -+ ! Elastic contribution to energy if G large enough -+ if ( G_L > verysmall .and. G_R > verysmall ) then -+ E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) -+ E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) -+ end if -+ !$acc loop seq -+ do i = 1, b_size - 1 -+ tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) -+ tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) -+ end do -+ end if -+ - H_L = (E_L + pres_L)/rho_L - H_R = (E_R + pres_R)/rho_R - -@@ -2110,7 +2246,6 @@ contains - - !> The computation of c_avg does not require all the variables, and therefore the non '_avg' - ! variables are placeholders to call the subroutine. -- - call s_compute_speed_of_sound(pres_R, rho_avg, gamma_avg, pi_inf_R, H_avg, alpha_R, & - vel_avg_rms, c_avg) - -@@ -2126,16 +2261,25 @@ contains - end if - - if (wave_speeds == 1) then -- s_L = min(vel_L(idx1) - c_L, vel_R(idx1) - c_R) -- s_R = max(vel_R(idx1) + c_R, vel_L(idx1) + c_L) -- -- s_S = (pres_R - pres_L + rho_L*vel_L(idx1)* & -- (s_L - vel_L(idx1)) - & -- rho_R*vel_R(idx1)* & -- (s_R - vel_R(idx1))) & -- /(rho_L*(s_L - vel_L(idx1)) - & -- rho_R*(s_R - vel_R(idx1))) -+ if (elasticity) then -+ s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & -+ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & -+ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) -+ s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & -+ (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & -+ (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) -+ s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & -+ tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & -+ rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & -+ rho_R*(s_R - vel_R(idx1))) -+ else -+ s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) -+ s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) -+ s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & -+ (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & -+ /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) - -+ end if - elseif (wave_speeds == 2) then - pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & - (vel_L(idx1) - & -@@ -2172,6 +2316,8 @@ contains - xi_M = (5d-1 + sign(5d-1, s_S)) - xi_P = (5d-1 - sign(5d-1, s_S)) - -+ ! COMPUTING THE HLLC FLUXES -+ ! MASS FLUX. - if (low_Mach == 1) then - @:compute_low_Mach_correction() - else -@@ -2181,15 +2327,13 @@ contains - !$acc loop seq - do i = 1, contxe - flux_rs${XYZ}$_vf(j, k, l, i) = & -- xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & -- *(vel_L(idx1) + s_M*(xi_L - 1d0)) & -- + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & -- *(vel_R(idx1) + s_P*(xi_R - 1d0)) -+ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & -+ xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) - end do - -- ! Momentum flux. -- ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w) -- !$acc loop seq -+ ! MOMENTUM FLUX. -+ ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) -+ !$acc loop seq - do i = 1, num_dims - idxi = dir_idx(i) - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & -@@ -2206,32 +2350,68 @@ contains - vel_R(idxi)) - vel_R(idxi))) + & - dir_flg(idxi)*(pres_R)) & - + (s_M/s_L)*(s_P/s_R)*dir_flg(idxi)*pcorr -+ -+ !idxi = dir_idx(i) -+ !flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & -+ ! xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & -+ !(1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & -+ ! xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & -+ !(1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) & -+ ! + (s_M/s_L)*(s_P/s_R)*dir_flg(dir_idx(i))*pcorr - end do - -- ! Energy flux. -- ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u)) -+ ! ENERGY FLUX. -+ ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) - flux_rs${XYZ}$_vf(j, k, l, E_idx) = & - xi_M*(vel_L(idx1)*(E_L + pres_L) + & -- s_M*(xi_L*(E_L + (s_S - vel_L(idx1))* & -- (rho_L*s_S + pres_L/ & -- (s_L - vel_L(idx1)))) - E_L)) & -+ s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & - + xi_P*(vel_R(idx1)*(E_R + pres_R) + & -- s_P*(xi_R*(E_R + (s_S - vel_R(idx1))* & -- (rho_R*s_S + pres_R/ & -- (s_R - vel_R(idx1)))) - E_R)) & -+ s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) & - + (s_M/s_L)*(s_P/s_R)*pcorr*s_S - -- ! Volume fraction flux -+ ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux -+ if (elasticity) then -+ flux_ene_e = 0d0; -+ !$acc loop seq -+ do i = 1, num_dims -+ ! MOMENTUM ELASTIC FLUX. -+ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & -+ flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) & -+ - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) -+ ! ENERGY ELASTIC FLUX. -+ flux_ene_e = flux_ene_e - & -+ xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & -+ s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & -+ xi_P*(vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & -+ s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) -+ end do -+ flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e -+ end if -+ -+ ! HYPOELASTIC STRESS EVOLUTION FLUX. -+ if (hypoelasticity) then -+ !$acc loop seq -+ do i = 1, strxe - strxb + 1 -+ flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & -+ xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & -+ xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) -+ end do -+ end if -+ -+ ! VOLUME FRACTION FLUX. - !$acc loop seq - do i = advxb, advxe -- flux_rs${XYZ}$_vf(j, k, l, i) = & -- xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & -- *(vel_L(idx1) + s_M*(xi_L - 1d0)) & -- + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & -- *(vel_R(idx1) + s_P*(xi_R - 1d0)) -+ flux_rs${XYZ}$_vf(j, k, l, i) = & -+ xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & -+ *(vel_L(idx1) + s_M*(xi_L - 1d0)) & -+ + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & -+ *(vel_R(idx1) + s_P*(xi_R - 1d0)) -+ !flux_rs${XYZ}$_vf(j, k, l, i) = & -+ ! xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & -+ ! xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) - end do - -- ! Source for volume fraction advection equation -+ ! VOLUME FRACTION SOURCE FLUX. - !$acc loop seq - do i = 1, num_dims - idxi = dir_idx(i) -@@ -2242,14 +2422,20 @@ contains - + xi_P*(vel_R(idxi) + & - dir_flg(idxi)* & - s_P*(xi_R - 1d0)) -- -- !if ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0d0 -+ !xi_M*(vel_L(idxi) + dir_flg(idxi)*s_M*(xi_L - 1d0)) + & -+ !xi_P*(vel_R(idxi) + dir_flg(idxi)*s_P*(xi_R - 1d0)) - end do - - flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) - -- ! Geometrical source flux for cylindrical coordinates -+ ! SURFACE TENSION FLUX. need to check -+ !if (.not. f_is_default(sigma)) then -+ ! flux_rs${XYZ}$_vf(j, k, l, c_idx) = & -+ ! (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & -+ ! xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S -+ !end if - -+ ! Geometrical source flux for cylindrical coordinates - #:if (NORM_DIR == 2) - if (cyl_coord) then - !Substituting the advective flux into the inviscid geometrical source flux -@@ -2544,7 +2730,7 @@ contains - - !$acc update device(is1, is2, is3) - -- if (hypoelasticity) then -+ if (elasticity) then - if (norm_dir == 1) then - dir_idx_tau = (/1, 2, 4/) - else if (norm_dir == 2) then diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 93582783d3..8e30c38b57 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -2069,7 +2069,9 @@ contains !$acc end parallel loop else ! 5-EQUATION MODEL WITH HLLC, INTERFACE CAPTURING ONLY - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, tau_e_L, tau_e_R, xi_field_L, xi_field_R, vel_L_tmp, vel_R_tmp) copyin(is1,is2,is3) + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & + !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, & + !$acc tau_e_L, tau_e_R, vel_L_tmp, vel_R_tmp, xi_field_L, xi_field_R) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -2178,58 +2180,61 @@ contains E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY - !if (hypoelasticity) then - ! !$acc loop seq - ! do i = 1, strxe - strxb + 1 - ! tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - ! tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) - ! end do - ! G_L = 0d0; G_R = 0d0 - ! !$acc loop seq - ! do i = 1, num_fluids - ! G_L = G_L + alpha_L(i)*Gs(i) - ! G_R = G_R + alpha_R(i)*Gs(i) - ! end do - ! !$acc loop seq - ! do i = 1, strxe - strxb + 1 - ! ! Elastic contribution to energy if G large enough - ! if ((G_L > verysmall) .and. (G_R > verysmall)) then - ! E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) - ! E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) - ! ! Additional terms in 2D and 3D - ! if ((i == 2) .or. (i == 4) .or. (i == 5)) then - ! E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) - ! E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) - ! end if - ! end if - ! end do - !end if + if (hypoelasticity) then + !$acc loop seq + do i = 1, strxe - strxb + 1 + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + end do + G_L = 0d0 + G_R = 0d0 + !$acc loop seq + do i = 1, num_fluids + G_L = G_L + alpha_L(i)*Gs(i) + G_R = G_R + alpha_R(i)*Gs(i) + end do + !$acc loop seq + do i = 1, strxe - strxb + 1 + ! Elastic contribution to energy if G large enough + if ((G_L > verysmall) .and. (G_R > verysmall)) then + E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) + E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) + ! Additional terms in 2D and 3D + if ((i == 2) .or. (i == 4) .or. (i == 5)) then + E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) + E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) + end if + end if + end do + end if ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY - !if (hyperelasticity) then - ! !$acc loop seq - ! do i = 1, num_dims - ! xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) - ! xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) - ! end do - ! G_L = 0d0; G_R = 0d0; - ! !$acc loop seq - ! do i = 1, num_fluids - ! ! Mixture left and right shear modulus - ! G_L = G_L + alpha_L(i)*Gs(i) - ! G_R = G_R + alpha_R(i)*Gs(i) - ! end do - ! ! Elastic contribution to energy if G large enough - ! if ( G_L > verysmall .and. G_R > verysmall ) then - ! E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) - ! E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) - ! end if - ! !$acc loop seq - ! do i = 1, b_size - 1 - ! tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - ! tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) - ! end do - !end if + if (hyperelasticity) then + !$acc loop seq + do i = 1, num_dims + xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) + xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) + end do + G_L = 0d0 + G_R = 0d0 + !$acc loop seq + do i = 1, num_fluids + ! Mixture left and right shear modulus + G_L = G_L + alpha_L(i)*Gs(i) + G_R = G_R + alpha_R(i)*Gs(i) + end do + ! Elastic contribution to energy if G large enough + if ( G_L > verysmall .and. G_R > verysmall ) then + E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) + E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) + end if + !$acc loop seq + do i = 1, b_size - 1 + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + end do + !print *, 'I was here!' + end if H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -2259,34 +2264,34 @@ contains end if if (wave_speeds == 1) then - s_L = min(vel_L(idx1) - c_L, vel_R(idx1) - c_R) - s_R = max(vel_R(idx1) + c_R, vel_L(idx1) + c_L) - s_S = (pres_R - pres_L + rho_L*vel_L(idx1)* & - (s_L - vel_L(idx1)) - & - rho_R*vel_R(idx1)* & - (s_R - vel_R(idx1))) & - /(rho_L*(s_L - vel_L(idx1)) - & - rho_R*(s_R - vel_R(idx1))) - - !if (elasticity) then - ! s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & - ! (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & - ! (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) - ! s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & - ! (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & - ! (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) - ! s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & - ! tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & - ! rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & - ! rho_R*(s_R - vel_R(idx1))) - !else - ! s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) - ! s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) - ! s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & - ! (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & - ! /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) - ! - !end if + !s_L = min(vel_L(idx1) - c_L, vel_R(idx1) - c_R) + !s_R = max(vel_R(idx1) + c_R, vel_L(idx1) + c_L) + !s_S = (pres_R - pres_L + rho_L*vel_L(idx1)* & + ! (s_L - vel_L(idx1)) - & + ! rho_R*vel_R(idx1)* & + ! (s_R - vel_R(idx1))) & + ! /(rho_L*(s_L - vel_L(idx1)) - & + ! rho_R*(s_R - vel_R(idx1))) + + if (elasticity) then + s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) + s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) + s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & + tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & + rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & + rho_R*(s_R - vel_R(idx1))) + else + s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) + s_R = max(vel_R(dir_idx(1)) + c_R, vel_L(dir_idx(1)) + c_L) + s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & + (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & + /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) + + end if elseif (wave_speeds == 2) then pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(idx1) - & @@ -2388,7 +2393,7 @@ contains ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux if (elasticity) then - flux_ene_e = 0d0; + flux_ene_e = 0d0 !$acc loop seq do i = 1, num_dims ! MOMENTUM ELASTIC FLUX. @@ -2443,14 +2448,26 @@ contains !xi_P*(vel_R(idxi) + dir_flg(idxi)*s_P*(xi_R - 1d0)) end do + ! REFERENCE MAP FLUX. + if (hyperelasticity) then + !$acc loop seq + do i = 1, num_dims + flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & + xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*xi_field_L(i) & + - rho_L*vel_L(idx1)*xi_field_L(i)) + & + xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*xi_field_R(i) & + - rho_R*vel_R(idx1)*xi_field_R(i)) + end do + end if + flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) ! SURFACE TENSION FLUX. need to check - !if (.not. f_is_default(sigma)) then - ! flux_rs${XYZ}$_vf(j, k, l, c_idx) = & - ! (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & - ! xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S - !end if + if (.not. f_is_default(sigma)) then + flux_rs${XYZ}$_vf(j, k, l, c_idx) = & + (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, c_idx))*s_S + end if ! Geometrical source flux for cylindrical coordinates #:if (NORM_DIR == 2) From 2445604a08f70b0dea0e92e092c527a58b306bc9 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 5 Aug 2024 19:37:01 -0500 Subject: [PATCH 278/380] code passes test suite, hyper should be checked --- src/simulation/m_riemann_solvers.fpp | 78 ++++++++++------------------ 1 file changed, 27 insertions(+), 51 deletions(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 8e30c38b57..c1257964e0 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -962,7 +962,9 @@ contains ! 6-EQUATION MODEL WITH HLLC if (model_eqns == 3) then !ME3 - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R, flux_ene_e, xi_field_L, xi_field_R) + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & + !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, & + !$acc G_L, G_R, flux_ene_e, xi_field_L, xi_field_R) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -1210,12 +1212,12 @@ contains ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) !$acc loop seq do i = 1, num_dims - !idxi = dir_idx(i) - flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & - xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & - (1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & - xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & - (1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) + idxi = dir_idx(i) + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & + xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi) + s_M*(xi_L*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))*vel_L(idxi)) - vel_L(idxi))) + dir_flg(idxi)*(pres_L)) + & + xi_P*(rho_R*(vel_R(idx1)*vel_R(idxi) + s_P*(xi_R*(dir_flg(idxi)*s_S + & + (1d0 - dir_flg(idxi))*vel_R(idxi)) - vel_R(idxi))) + dir_flg(idxi)*(pres_R)) end do ! ENERGY FLUX. @@ -1231,15 +1233,16 @@ contains flux_ene_e = 0d0; !$acc loop seq do i = 1, num_dims + idxi = dir_idx(i) ! MOMENTUM ELASTIC FLUX. - flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & - flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) & + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) ! ENERGY ELASTIC FLUX. flux_ene_e = flux_ene_e - & - xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & + xi_M*(vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & - xi_P*(vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & + xi_P*(vel_R(idxi)*tau_e_R(dir_idx_tau(i)) + & s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) end do flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e @@ -1256,10 +1259,10 @@ contains ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. !$acc loop seq do i = 1, num_dims - !idxi = dir_idx(i) - vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = & - xi_M*(vel_L(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_MP*(xi_L - 1) + 1) - vel_L(dir_idx(i)))) + & - xi_P*(vel_R(dir_idx(i)) + dir_flg(dir_idx(i))*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(dir_idx(i)))) + idxi = dir_idx(i) + vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & + xi_M*(vel_L(idxi) + dir_flg(idxi)*(s_S*(xi_MP*(xi_L - 1) + 1) - vel_L(idxi))) + & + xi_P*(vel_R(idxi) + dir_flg(idxi)*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(idxi))) end do ! INTERNAL ENERGIES ADVECTION FLUX. @@ -1358,7 +1361,9 @@ contains elseif (model_eqns == 4) then !ME4 - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, & + !$acc vel_L, vel_R, alpha_L, alpha_R, vel_avg, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, & + !$acc vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -1606,8 +1611,10 @@ contains end do !$acc end parallel loop elseif (model_eqns == 2 .and. bubbles) then - !$acc parallel loop collapse(3) gang vector default(present) private(R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, & - !$acc rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, s_L, s_R, s_S, nbub_L, nbub_R, ptilde_L, ptilde_R, vel_avg_rms, Re_L, Re_R, pcorr, zcoef, vel_L_tmp, vel_R_tmp) + !$acc parallel loop collapse(3) gang vector default(present) private(R0_L, R0_R, V0_L, V0_R, & + !$acc P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, & + !$acc s_L, s_R, s_S, nbub_L, nbub_R, ptilde_L, ptilde_R, vel_avg_rms, Re_L, Re_R, & + !$acc pcorr, zcoef, vel_L_tmp, vel_R_tmp) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -2076,7 +2083,7 @@ contains do k = is2%beg, is2%end do j = is1%beg, is1%end - idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 + !idx1 = 1; if (dir_idx(1) == 2) idx1 = 2; if (dir_idx(1) == 3) idx1 = 3 !$acc loop seq do i = 1, num_fluids @@ -2233,7 +2240,6 @@ contains tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do - !print *, 'I was here!' end if H_L = (E_L + pres_L)/rho_L @@ -2264,15 +2270,6 @@ contains end if if (wave_speeds == 1) then - !s_L = min(vel_L(idx1) - c_L, vel_R(idx1) - c_R) - !s_R = max(vel_R(idx1) + c_R, vel_L(idx1) + c_L) - !s_S = (pres_R - pres_L + rho_L*vel_L(idx1)* & - ! (s_L - vel_L(idx1)) - & - ! rho_R*vel_R(idx1)* & - ! (s_R - vel_R(idx1))) & - ! /(rho_L*(s_L - vel_L(idx1)) - & - ! rho_R*(s_R - vel_R(idx1))) - if (elasticity) then s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & @@ -2296,19 +2293,15 @@ contains pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(idx1) - & vel_R(idx1))) - pres_SR = pres_SL - Ms_L = max(1d0, sqrt(1d0 + ((5d-1 + gamma_L)/(1d0 + gamma_L))* & (pres_SL/pres_L - 1d0)*pres_L/ & ((pres_L + pi_inf_L/(1d0 + gamma_L))))) Ms_R = max(1d0, sqrt(1d0 + ((5d-1 + gamma_R)/(1d0 + gamma_R))* & (pres_SR/pres_R - 1d0)*pres_R/ & ((pres_R + pi_inf_R/(1d0 + gamma_R))))) - s_L = vel_L(idx1) - c_L*Ms_L s_R = vel_R(idx1) + c_R*Ms_R - s_S = 5d-1*((vel_L(idx1) + vel_R(idx1)) + & (pres_L - pres_R)/ & (rho_avg*c_avg)) @@ -2343,8 +2336,6 @@ contains *(vel_L(idx1) + s_M*(xi_L - 1d0)) & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & *(vel_R(idx1) + s_P*(xi_R - 1d0)) - !xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & - !xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) end do ! MOMENTUM FLUX. @@ -2366,15 +2357,7 @@ contains vel_R(idxi)) - vel_R(idxi))) + & dir_flg(idxi)*(pres_R)) & + (s_M/s_L)*(s_P/s_R)*dir_flg(idxi)*pcorr - - !idxi = dir_idx(i) - !flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & - ! xi_M*(rho_L*(vel_L(idx1)*vel_L(dir_idx(i)) + s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & - !(1d0 - dir_flg(dir_idx(i)))*vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_L)) + & - ! xi_P*(rho_R*(vel_R(idx1)*vel_R(dir_idx(i)) + s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & - !(1d0 - dir_flg(dir_idx(i)))*vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_R)) & - ! + (s_M/s_L)*(s_P/s_R)*dir_flg(dir_idx(i))*pcorr - end do + end do ! ENERGY FLUX. ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) @@ -2383,12 +2366,10 @@ contains s_M*(xi_L*(E_L + (s_S - vel_L(idx1))* & (rho_L*s_S + pres_L/ & (s_L - vel_L(idx1)))) - E_L)) & - ! s_M*(xi_L*(E_L + (s_S - vel_L(idx1))*(rho_L*s_S + pres_L/(s_L - vel_L(idx1)))) - E_L)) & + xi_P*(vel_R(idx1)*(E_R + pres_R) + & s_P*(xi_R*(E_R + (s_S - vel_R(idx1))* & (rho_R*s_S + pres_R/ & (s_R - vel_R(idx1)))) - E_R)) & - ! s_P*(xi_R*(E_R + (s_S - vel_R(idx1))*(rho_R*s_S + pres_R/(s_R - vel_R(idx1)))) - E_R)) & + (s_M/s_L)*(s_P/s_R)*pcorr*s_S ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux @@ -2428,9 +2409,6 @@ contains *(vel_L(idx1) + s_M*(xi_L - 1d0)) & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & *(vel_R(idx1) + s_P*(xi_R - 1d0)) - !flux_rs${XYZ}$_vf(j, k, l, i) = & - ! xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i)*(vel_L(idx1) + s_M*(xi_L - 1d0)) + & - ! xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1d0)) end do ! VOLUME FRACTION SOURCE FLUX. @@ -2444,8 +2422,6 @@ contains + xi_P*(vel_R(idxi) + & dir_flg(idxi)* & s_P*(xi_R - 1d0)) - !xi_M*(vel_L(idxi) + dir_flg(idxi)*s_M*(xi_L - 1d0)) + & - !xi_P*(vel_R(idxi) + dir_flg(idxi)*s_P*(xi_R - 1d0)) end do ! REFERENCE MAP FLUX. From f37d3ed31237f82b50e60617279e8fc3c24875d8 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 5 Aug 2024 20:05:47 -0500 Subject: [PATCH 279/380] 5-eq HLLC with hyperelasticity, passes test suite on Delta --- src/common/m_checker_common.fpp | 6 +- src/common/m_helper.fpp | 4 +- src/common/m_variables_conversion.fpp | 36 +-- src/post_process/m_data_output.fpp | 12 +- src/post_process/m_global_parameters.fpp | 10 +- src/pre_process/include/3dHardcodedIC.fpp | 6 +- src/pre_process/m_assign_variables.f90 | 2 +- src/simulation/m_boundary_conditions.fpp | 40 +-- src/simulation/m_checker.fpp | 8 +- src/simulation/m_data_output.fpp | 2 +- src/simulation/m_global_parameters.fpp | 22 +- src/simulation/m_hyperelastic.fpp | 305 +++++++++++----------- src/simulation/m_hypoelastic.fpp | 112 ++++---- src/simulation/m_rhs.fpp | 2 +- src/simulation/m_riemann_solvers.fpp | 230 ++++++++-------- src/simulation/m_time_steppers.fpp | 2 +- 16 files changed, 397 insertions(+), 402 deletions(-) diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index 386a844cd3..b4506a01f1 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -186,12 +186,12 @@ contains end if end subroutine s_check_inputs_hypoelasticity - !> Checks constraints on the hyperelasticity parameters. + !> Checks constraints on the hyperelasticity parameters. !! Called by s_check_inputs_common for pre-processing and simulation subroutine s_check_inputs_hyperelasticity if (model_eqns /= 3) then - call s_mpi_abort('hyperelasticity requires '// & - '6-equation model (model_eqns = 3). Exiting ...') + call s_mpi_abort('hyperelasticity requires '// & + '6-equation model (model_eqns = 3). Exiting ...') end if end subroutine s_check_inputs_hyperelasticity diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp index a2b770828d..df0fdcc185 100644 --- a/src/common/m_helper.fpp +++ b/src/common/m_helper.fpp @@ -73,8 +73,8 @@ contains lE = q end if - if (allocated(fd_coeff_s)) deallocate(fd_coeff_s) - allocate(fd_coeff_s(-fd_number_in:fd_number_in, lb:lE)) + if (allocated(fd_coeff_s)) deallocate (fd_coeff_s) + allocate (fd_coeff_s(-fd_number_in:fd_number_in, lb:lE)) ! Computing the 1st order finite-difference coefficients if (fd_order_in == 1) then diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 5652470ac6..a5a6164d07 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -985,7 +985,7 @@ contains qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & /rho_K ! subtracting elastic contribution for pressure calculation - if (G_K .gt. verysmall) then !TODO: check if stable for >0 + if (G_K > verysmall) then !TODO: check if stable for >0 qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K ! extra terms in 2 and 3D @@ -1000,14 +1000,14 @@ contains end if if (hyperelasticity) then - !$acc loop seq - do i = strxb, strxe + !$acc loop seq + do i = strxb, strxe + qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K + end do + !$acc loop seq + do i = xibeg, xiend qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K - end do - !$acc loop seq - do i = xibeg, xiend - qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K - end do + end do end if !$acc loop seq @@ -1152,7 +1152,7 @@ contains do i = strxb, strxe q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) ! adding elastic contribution - if (G .gt. verysmall) then + if (G > verysmall) then q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) ! extra terms in 2 and 3D @@ -1168,15 +1168,15 @@ contains ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 if (hyperelasticity) then - ! adding the elastic contribution - ! Multiply \tau to \rho \tau - do i = strxb, strxe - q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) - end do - ! Multiply \xi to \rho \xi - do i = xibeg, xiend - q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) - end do + ! adding the elastic contribution + ! Multiply \tau to \rho \tau + do i = strxb, strxe + q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) + end do + ! Multiply \xi to \rho \xi + do i = xibeg, xiend + q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) + end do end if if (.not. f_is_default(sigma)) then diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index e68c021bdd..024d5f3483 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -1006,13 +1006,13 @@ contains call s_mpi_allreduce_max(maxalph_loc, maxalph_glb) if (p > 0) then - do l = 0, p - if (z_cc(l) < dz(l) .and. z_cc(l) > 0) then - cent = l - end if - end do + do l = 0, p + if (z_cc(l) < dz(l) .and. z_cc(l) > 0) then + cent = l + end if + end do else - cent = 0 + cent = 0 end if thres = 0.9d0*maxalph_glb diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index fa6941cb21..1a4d6d96a5 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -541,11 +541,11 @@ contains alf_idx = 1 ! dummy, cannot actually have a void fraction if (hypoelasticity .or. hyperelasticity) then - elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D - sys_size = stress_idx%end + elasticity = .true. + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end end if if (hyperelasticity) then diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp index 4088fcc29f..7b75101514 100644 --- a/src/pre_process/include/3dHardcodedIC.fpp +++ b/src/pre_process/include/3dHardcodedIC.fpp @@ -42,12 +42,12 @@ pInt = pref + rhoH*9.81*(1.2 - intH) q_prim_vf(E_idx)%sf(i, j, k) = pInt + rhoL*9.81*(intH - y_cc(j)) end if - + case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|) h = 0.0 lam = 1.0 amp = patch_icpp(patch_id)%a2 - intH = amp*ABS((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h) + intH = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h) if (x_cc(i) > intH) then q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1) q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2) @@ -55,7 +55,7 @@ q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1) q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2) end if - + ! Put your variable assignments here case default call s_int_to_str(patch_id, iStr) diff --git a/src/pre_process/m_assign_variables.f90 b/src/pre_process/m_assign_variables.f90 index 4a49c46abe..37f41c83f3 100644 --- a/src/pre_process/m_assign_variables.f90 +++ b/src/pre_process/m_assign_variables.f90 @@ -479,7 +479,7 @@ subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & ! assigning the reference map to the q_prim vector field do i = 1, num_dims q_prim_vf(i + xibeg - 1)%sf(j, k, l) = eta*xi_cart(i) + & - (1d0 - eta)*orig_prim_vf(i + xibeg - 1) + (1d0 - eta)*orig_prim_vf(i + xibeg - 1) end do end if diff --git a/src/simulation/m_boundary_conditions.fpp b/src/simulation/m_boundary_conditions.fpp index 2b9eee16e8..cccad32fbf 100644 --- a/src/simulation/m_boundary_conditions.fpp +++ b/src/simulation/m_boundary_conditions.fpp @@ -357,10 +357,10 @@ contains q_prim_vf(i)%sf(-j, k, l) = & q_prim_vf(i)%sf(j - 1, k, l) end do - - if(hyperelasticity) then - q_prim_vf(xibeg)%sf(-j, k, l) = & - -q_prim_vf(xibeg)%sf(j - 1, k, l) + + if (hyperelasticity) then + q_prim_vf(xibeg)%sf(-j, k, l) = & + -q_prim_vf(xibeg)%sf(j - 1, k, l) end if end do @@ -407,9 +407,9 @@ contains q_prim_vf(i)%sf(m - (j - 1), k, l) end do - if(hyperelasticity) then - q_prim_vf(xibeg)%sf(m + j, k, l) = & - -q_prim_vf(xibeg)%sf(m - (j - 1), k, l) + if (hyperelasticity) then + q_prim_vf(xibeg)%sf(m + j, k, l) = & + -q_prim_vf(xibeg)%sf(m - (j - 1), k, l) end if end do @@ -460,9 +460,9 @@ contains q_prim_vf(i)%sf(l, j - 1, k) end do - if(hyperelasticity) then - q_prim_vf(xibeg + 1)%sf(l, -j, k) = & - -q_prim_vf(xibeg + 1)%sf(l, j - 1, k) + if (hyperelasticity) then + q_prim_vf(xibeg + 1)%sf(l, -j, k) = & + -q_prim_vf(xibeg + 1)%sf(l, j - 1, k) end if end do end do @@ -507,9 +507,9 @@ contains q_prim_vf(i)%sf(l, n - (j - 1), k) end do - if(hyperelasticity) then - q_prim_vf(xibeg + 1)%sf(l, n + j, k) = & - -q_prim_vf(xibeg + 1)%sf(l, n - (j - 1), k) + if (hyperelasticity) then + q_prim_vf(xibeg + 1)%sf(l, n + j, k) = & + -q_prim_vf(xibeg + 1)%sf(l, n - (j - 1), k) end if end do end do @@ -559,10 +559,10 @@ contains q_prim_vf(i)%sf(k, l, j - 1) end do - if(hyperelasticity) then - q_prim_vf(xiend)%sf(k, l, -j) = & - -q_prim_vf(xiend)%sf(k, l, j - 1) - end if + if (hyperelasticity) then + q_prim_vf(xiend)%sf(k, l, -j) = & + -q_prim_vf(xiend)%sf(k, l, j - 1) + end if end do end do end do @@ -606,9 +606,9 @@ contains q_prim_vf(i)%sf(k, l, p - (j - 1)) end do - if(hyperelasticity) then - q_prim_vf(xiend)%sf(k, l, p + j) = & - -q_prim_vf(xiend)%sf(k, l, p - (j - 1)) + if (hyperelasticity) then + q_prim_vf(xiend)%sf(k, l, p + j) = & + -q_prim_vf(xiend)%sf(k, l, p - (j - 1)) end if end do end do diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index c3523ec9a1..84fcbbaa45 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -375,13 +375,13 @@ contains 'Exiting ...') end if end subroutine s_check_inputs_hypoelasticity - + !> Checks constraints on hyperelasticity parameters subroutine s_check_inputs_hyperelasticity if (riemann_solver /= 2) then - call s_mpi_abort('hyperelasticity requires HLLC '// & - '(riemann_solver = 2) Riemann solver. '// & - 'Exiting ...') + call s_mpi_abort('hyperelasticity requires HLLC '// & + '(riemann_solver = 2) Riemann solver. '// & + 'Exiting ...') end if end subroutine s_check_inputs_hyperelasticity diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 93637a1b93..11f4538185 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -1382,7 +1382,7 @@ contains end if end if - else ! 3D + else ! 3D if ((probe(i)%x >= x_cb(-1)) .and. (probe(i)%x <= x_cb(m))) then if ((probe(i)%y >= y_cb(-1)) .and. (probe(i)%y <= y_cb(n))) then if ((probe(i)%z >= z_cb(-1)) .and. (probe(i)%z <= z_cb(p))) then diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 539d3b5611..dd22c0b252 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -881,11 +881,11 @@ contains sys_size = internalEnergies_idx%end if (hypoelasticity .or. hyperelasticity) then - elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D - sys_size = stress_idx%end + elasticity = .true. + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end end if if (hyperelasticity) then @@ -1041,11 +1041,11 @@ contains buff_size = weno_polyn + 2 end if - if (elasticity) then - fd_order = 4 - fd_number = max(1, fd_order/2) - !buff_size = buff_size + fd_number - end if + if (elasticity) then + fd_order = 4 + fd_number = max(1, fd_order/2) + !buff_size = buff_size + fd_number + end if ! Configuring Coordinate Direction Indexes ========================= if (bubbles) then @@ -1076,7 +1076,7 @@ contains if (p > 0) then startz = -buff_size end if - + !$acc update device(fd_order,fd_number) !$acc update device(startx, starty, startz) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 9d8b6a4f49..9caa8425fc 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -4,7 +4,7 @@ #:include 'macros.fpp' -!> @brief This module consists of subroutines used in the calculation +!> @brief This module consists of subroutines used in the calculation !! of the cauchy tensor module m_hyperelastic @@ -23,7 +23,7 @@ module m_hyperelastic implicit none - private; public :: s_hyperelastic_rmt_stress_update, & + private; public :: s_hyperelastic_rmt_stress_update, & s_initialize_hyperelastic_module, & s_finalize_hyperelastic_module @@ -40,20 +40,20 @@ module m_hyperelastic type(scalar_field), dimension(b_size), intent(inout) :: btensor real(kind(0d0)), intent(in) :: G integer, intent(in) :: j, k, l - + end subroutine s_abstract_hyperelastic_solver !> @} end interface !> @} - procedure(s_abstract_hyperelastic_solver), & - pointer :: s_compute_cauchy_solver => null() + procedure(s_abstract_hyperelastic_solver), & + pointer :: s_compute_cauchy_solver => null() !! The btensor at the cell-interior Gaussian quadrature points. !! These tensor is needed to be calculated once and make the code DRY. type(vector_field) :: btensor !< - !$acc declare create(btensor) +!$acc declare create(btensor) #ifdef CRAY_ACC_WAR @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), allocatable, dimension(:, :), fd_coeff_x, fd_coeff_y, fd_coeff_z) @@ -71,7 +71,7 @@ module m_hyperelastic contains - !> The following subroutine handles the calculation of the btensor. + !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. !! @param q_prim_vf Primitive variables !! @param btensor is the output @@ -79,12 +79,12 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_initialize_hyperelastic_module() + subroutine s_initialize_hyperelastic_module() integer :: i !< generic iterator - + @:ALLOCATE(btensor%vf(1:b_size)) do i = 1, b_size - @:ALLOCATE(btensor%vf(i)%sf(0:m, 0:n, 0:p)) + @:ALLOCATE(btensor%vf(i)%sf(0:m, 0:n, 0:p)) end do @:ACC_SETUP_VFs(btensor) @@ -105,30 +105,30 @@ contains @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) if (n > 0) then - @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) + @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) end if if (p > 0) then - @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) + @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) end if ! Computing centered finite difference coefficients call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & - fd_number, fd_order) + fd_number, fd_order) !$acc update device(fd_coeff_x) if (n > 0) then - call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & - fd_number, fd_order) - !$acc update device(fd_coeff_y) + call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & + fd_number, fd_order) + !$acc update device(fd_coeff_y) end if if (p > 0) then call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & fd_number, fd_order) - !$acc update device(fd_coeff_z) + !$acc update device(fd_coeff_z) end if - end subroutine s_initialize_hyperelastic_module + end subroutine s_initialize_hyperelastic_module - !> The following subroutine handles the calculation of the btensor. + !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. !! @param q_prim_vf Primitive variables !! @param btensor is the output @@ -136,7 +136,7 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_hyperelastic_rmt_stress_update(q_cons_vf,q_prim_vf) + subroutine s_hyperelastic_rmt_stress_update(q_cons_vf, q_prim_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf @@ -145,118 +145,118 @@ contains real(kind(0d0)), dimension(num_fluids) :: alpha_K, alpha_rho_K real(kind(0d0)), dimension(2) :: Re_K real(kind(0d0)) :: rho_K, gamma_K, pi_inf_K, qv_K - real(kind(0d0)) :: G_K + real(kind(0d0)) :: G_K integer :: j, k, l, i, r !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,Re_K, tensora, tensorb) - do l = 0, p-2 - do k = 0, n-2 - do j = 2, m-2 - !$acc loop seq - do i = 1, num_fluids - alpha_rho_K(i) = q_cons_vf(i)%sf(j, k, l) - alpha_K(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) - end do - ! If in simulation, use acc mixture subroutines - call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & - alpha_rho_K, Re_K, j, k, l, G_K, Gs) - rho_K = max(rho_K, sgm_eps) - if ( G_K .le. verysmall ) G_K = 0d0 - - if ( G_K .gt. 20d0 ) then - !$acc loop seq - do i = 1, tensor_size - tensora(i) = 0d0 - end do - ! STEP 1: computing the grad_xi tensor using finite differences - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - !$acc loop seq - do r = -fd_number, fd_number - ! derivatives in the x-direction - tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) - tensora(2) = tensora(2) + q_prim_vf(xibeg+1)%sf(j + r, k, l)*fd_coeff_x(r, j) - tensora(3) = tensora(3) + q_prim_vf(xiend)%sf(j + r, k, l)*fd_coeff_x(r, j) - ! derivatives in the y-direction - tensora(4) = tensora(4) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) - tensora(5) = tensora(5) + q_prim_vf(xibeg+1)%sf(j, k + r, l)*fd_coeff_y(r, k) - tensora(6) = tensora(6) + q_prim_vf(xiend)%sf(j, k + r, l)*fd_coeff_y(r, k) - ! derivatives in the z-direction - tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_z(r, l) - tensora(8) = tensora(8) + q_prim_vf(xibeg+1)%sf(j, k, l + r)*fd_coeff_z(r, l) - tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_z(r, l) - end do - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) - tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) - tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) - tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) - tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) - tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) - tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) - tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) - tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) - - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & - + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - - if (tensorb(tensor_size) > 0d0) then - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes F + do l = 0, p - 2 + do k = 0, n - 2 + do j = 2, m - 2 !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) + do i = 1, num_fluids + alpha_rho_K(i) = q_cons_vf(i)%sf(j, k, l) + alpha_K(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) end do - - ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) - tensorb(tensor_size) = 1d0/tensorb(tensor_size) - - ! STEP 3: computing F tranpose F - tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 - tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 - tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) - tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) - tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) - ! STEP 4: update the btensor, this is consistent with Riemann solvers - ! \tau_xx - btensor%vf(1)%sf(j, k, l) = tensorb(1) - ! \tau_xy - btensor%vf(2)%sf(j, k, l) = tensorb(2) - ! \tau_yy - btensor%vf(3)%sf(j, k, l) = tensorb(5) - ! \tau_xz - btensor%vf(4)%sf(j, k, l) = tensorb(3) - ! \tau_yz - btensor%vf(5)%sf(j, k, l) = tensorb(6) - ! \tau_zz - btensor%vf(6)%sf(j, k, l) = tensorb(9) - ! store the determinant at the last entry of the btensor - btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) - ! STEP 5a: updating the Cauchy stress primitive scalar field - call s_compute_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) - ! STEP 5b: updating the pressure field - q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & - G_K*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma_K - ! STEP 5c: updating the Cauchy stress conservative scalar field - !$acc loop seq - do i = 1, b_size - 1 - q_cons_vf(strxb + i - 1)%sf(j, k, l) = & - rho_K*q_prim_vf(strxb + i - 1)%sf(j, k, l) - end do - end if - end if + ! If in simulation, use acc mixture subroutines + call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & + alpha_rho_K, Re_K, j, k, l, G_K, Gs) + rho_K = max(rho_K, sgm_eps) + if (G_K <= verysmall) G_K = 0d0 + + if (G_K > 20d0) then + !$acc loop seq + do i = 1, tensor_size + tensora(i) = 0d0 + end do + ! STEP 1: computing the grad_xi tensor using finite differences + ! grad_xi definition / organization + ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx + ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy + ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz + !$acc loop seq + do r = -fd_number, fd_number + ! derivatives in the x-direction + tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) + tensora(2) = tensora(2) + q_prim_vf(xibeg + 1)%sf(j + r, k, l)*fd_coeff_x(r, j) + tensora(3) = tensora(3) + q_prim_vf(xiend)%sf(j + r, k, l)*fd_coeff_x(r, j) + ! derivatives in the y-direction + tensora(4) = tensora(4) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) + tensora(5) = tensora(5) + q_prim_vf(xibeg + 1)%sf(j, k + r, l)*fd_coeff_y(r, k) + tensora(6) = tensora(6) + q_prim_vf(xiend)%sf(j, k + r, l)*fd_coeff_y(r, k) + ! derivatives in the z-direction + tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_z(r, l) + tensora(8) = tensora(8) + q_prim_vf(xibeg + 1)%sf(j, k, l + r)*fd_coeff_z(r, l) + tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_z(r, l) + end do + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) + tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) + tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) + tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) + tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) + tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) + tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) + tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) + tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) + + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + + if (tensorb(tensor_size) > 0d0) then + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes F + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do + + ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) + tensorb(tensor_size) = 1d0/tensorb(tensor_size) + + ! STEP 3: computing F tranpose F + tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 + tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 + tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) + tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) + tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) + ! STEP 4: update the btensor, this is consistent with Riemann solvers + ! \tau_xx + btensor%vf(1)%sf(j, k, l) = tensorb(1) + ! \tau_xy + btensor%vf(2)%sf(j, k, l) = tensorb(2) + ! \tau_yy + btensor%vf(3)%sf(j, k, l) = tensorb(5) + ! \tau_xz + btensor%vf(4)%sf(j, k, l) = tensorb(3) + ! \tau_yz + btensor%vf(5)%sf(j, k, l) = tensorb(6) + ! \tau_zz + btensor%vf(6)%sf(j, k, l) = tensorb(9) + ! store the determinant at the last entry of the btensor + btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) + ! STEP 5a: updating the Cauchy stress primitive scalar field + call s_compute_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) + ! STEP 5b: updating the pressure field + q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & + G_K*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma_K + ! STEP 5c: updating the Cauchy stress conservative scalar field + !$acc loop seq + do i = 1, b_size - 1 + q_cons_vf(strxb + i - 1)%sf(j, k, l) = & + rho_K*q_prim_vf(strxb + i - 1)%sf(j, k, l) + end do + end if + end if + end do end do - end do end do !$acc end parallel loop - end subroutine s_hyperelastic_rmt_stress_update + end subroutine s_hyperelastic_rmt_stress_update - !> The following subroutine handles the calculation of the btensor. + !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. !! @param q_prim_vf Primitive variables !! @param btensor is the output @@ -264,7 +264,7 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) + subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) !$acc routine seq type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor @@ -288,16 +288,16 @@ contains ! setting the tensor to the stresses for riemann solver !$acc loop seq do i = 1, b_size - 1 - q_prim_vf(strxb + i - 1)%sf(j, k, l) = & - G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + q_prim_vf(strxb + i - 1)%sf(j, k, l) = & + G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) end do ! compute the invariant without the elastic modulus - q_prim_vf(xiend + 1)%sf(j, k, l) = & - 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) + q_prim_vf(xiend + 1)%sf(j, k, l) = & + 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) - end subroutine s_neoHookean_cauchy_solver + end subroutine s_neoHookean_cauchy_solver - !> The following subroutine handles the calculation of the btensor. + !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. !! @param q_prim_vf Primitive variables !! @param btensor is the output @@ -305,7 +305,7 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_Mooney_Rivlin_cauchy_solver(btensor, q_prim_vf, G, j, k, l) + subroutine s_Mooney_Rivlin_cauchy_solver(btensor, q_prim_vf, G, j, k, l) !$acc routine seq type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor @@ -329,35 +329,34 @@ contains ! setting the tensor to the stresses for riemann solver !$acc loop seq do i = 1, b_size - 1 - q_prim_vf(strxb + i - 1)%sf(j, k, l) = & - G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + q_prim_vf(strxb + i - 1)%sf(j, k, l) = & + G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) end do ! compute the invariant without the elastic modulus - q_prim_vf(xiend + 1)%sf(j, k, l) = & - 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) + q_prim_vf(xiend + 1)%sf(j, k, l) = & + 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) - end subroutine s_Mooney_Rivlin_cauchy_solver + end subroutine s_Mooney_Rivlin_cauchy_solver + subroutine s_finalize_hyperelastic_module() - subroutine s_finalize_hyperelastic_module() + integer :: i !< iterator - integer :: i !< iterator - - ! Disassociating procedural pointer to the subroutine which was - ! utilized to calculate the solution of a given Riemann problem - s_compute_cauchy_solver => null() + ! Disassociating procedural pointer to the subroutine which was + ! utilized to calculate the solution of a given Riemann problem + s_compute_cauchy_solver => null() - ! Deallocating memory - do i = 1, b_size - @:DEALLOCATE_GLOBAL(btensor%vf(i)%sf) - end do - @:DEALLOCATE_GLOBAL(fd_coeff_x) - if (n > 0) then - @:DEALLOCATE_GLOBAL(fd_coeff_y) - if (p > 0) then - @:DEALLOCATE_GLOBAL(fd_coeff_z) - end if - end if + ! Deallocating memory + do i = 1, b_size + @:DEALLOCATE_GLOBAL(btensor%vf(i)%sf) + end do + @:DEALLOCATE_GLOBAL(fd_coeff_x) + if (n > 0) then + @:DEALLOCATE_GLOBAL(fd_coeff_y) + if (p > 0) then + @:DEALLOCATE_GLOBAL(fd_coeff_z) + end if + end if end subroutine s_finalize_hyperelastic_module diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index 7f3d54c381..47d6aaaec1 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -82,25 +82,25 @@ contains @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) if (n > 0) then - @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) + @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) end if if (p > 0) then - @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) + @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) end if ! Computing centered finite difference coefficients call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & - fd_number, fd_order) + fd_number, fd_order) !$acc update device(fd_coeff_x) if (n > 0) then - call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & - fd_number, fd_order) - !$acc update device(fd_coeff_y) + call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & + fd_number, fd_order) + !$acc update device(fd_coeff_y) end if if (p > 0) then call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & fd_number, fd_order) - !$acc update device(fd_coeff_z) + !$acc update device(fd_coeff_z) end if end subroutine s_initialize_hypoelastic_module @@ -131,53 +131,53 @@ contains do q = 0, p do l = 0, n do k = 0, m - du_dx(k, l, q) = 0d0; + du_dx(k, l, q) = 0d0; end do end do end do !$acc end parallel loop - - !$acc parallel loop collapse(3) gang vector default(present) - do q = 0, p + + !$acc parallel loop collapse(3) gang vector default(present) + do q = 0, p do l = 0, n do k = 0, m - !$acc loop seq - do r = -fd_number, fd_number - du_dx(k, l, q) = du_dx(k, l, q) & - + q_prim_vf(momxb)%sf(k + r, l, q)*fd_coeff_x(r, k) - end do + !$acc loop seq + do r = -fd_number, fd_number + du_dx(k, l, q) = du_dx(k, l, q) & + + q_prim_vf(momxb)%sf(k + r, l, q)*fd_coeff_x(r, k) + end do end do end do - end do + end do !$acc end parallel loop if (ndirs > 1) then !$acc parallel loop collapse(3) gang vector default(present) do q = 0, p - do l = 0, n - do k = 0, m - du_dy(k, l, q) = 0d0; dv_dx(k, l, q) = 0d0; dv_dy(k, l, q) = 0d0; + do l = 0, n + do k = 0, m + du_dy(k, l, q) = 0d0; dv_dx(k, l, q) = 0d0; dv_dy(k, l, q) = 0d0; + end do end do - end do end do !$acc end parallel loop !$acc parallel loop collapse(3) gang vector default(present) do q = 0, p - do l = 0, n - do k = 0, m - !$acc loop seq - do r = -fd_number, fd_number - du_dy(k, l, q) = du_dy(k, l, q) & - + q_prim_vf(momxb)%sf(k, l + r, q)*fd_coeff_y(r, l) - dv_dx(k, l, q) = dv_dx(k, l, q) & - + q_prim_vf(momxb + 1)%sf(k + r, l, q)*fd_coeff_x(r, k) - dv_dy(k, l, q) = dv_dy(k, l, q) & - + q_prim_vf(momxb + 1)%sf(k, l + r, q)*fd_coeff_y(r, l) - end do - end do - end do + do l = 0, n + do k = 0, m + !$acc loop seq + do r = -fd_number, fd_number + du_dy(k, l, q) = du_dy(k, l, q) & + + q_prim_vf(momxb)%sf(k, l + r, q)*fd_coeff_y(r, l) + dv_dx(k, l, q) = dv_dx(k, l, q) & + + q_prim_vf(momxb + 1)%sf(k + r, l, q)*fd_coeff_x(r, k) + dv_dy(k, l, q) = dv_dy(k, l, q) & + + q_prim_vf(momxb + 1)%sf(k, l + r, q)*fd_coeff_y(r, l) + end do + end do + end do end do !$acc end parallel loop @@ -186,34 +186,34 @@ contains !$acc parallel loop collapse(3) gang vector default(present) do q = 0, p - do l = 0, n - do k = 0, m - du_dz(k, l, q) = 0d0; dv_dz(k, l, q) = 0d0; dw_dx(k, l, q) = 0d0; - dw_dy(k, l, q) = 0d0; dw_dz(k, l, q) = 0d0; + do l = 0, n + do k = 0, m + du_dz(k, l, q) = 0d0; dv_dz(k, l, q) = 0d0; dw_dx(k, l, q) = 0d0; + dw_dy(k, l, q) = 0d0; dw_dz(k, l, q) = 0d0; + end do end do - end do end do !$acc end parallel loop !$acc parallel loop collapse(3) gang vector default(present) do q = 0, p - do l = 0, n - do k = 0, m - !$acc loop seq - do r = -fd_number, fd_number - du_dz(k, l, q) = du_dz(k, l, q) & - + q_prim_vf(momxb)%sf(k, l, q + r)*fd_coeff_z(r, q) - dv_dz(k, l, q) = dv_dz(k, l, q) & - + q_prim_vf(momxb + 1)%sf(k, l, q + r)*fd_coeff_z(r, q) - dw_dx(k, l, q) = dw_dx(k, l, q) & - + q_prim_vf(momxe)%sf(k + r, l, q)*fd_coeff_x(r, k) - dw_dy(k, l, q) = dw_dy(k, l, q) & - + q_prim_vf(momxe)%sf(k, l + r, q)*fd_coeff_y(r, l) - dw_dz(k, l, q) = dw_dz(k, l, q) & - + q_prim_vf(momxe)%sf(k, l, q + r)*fd_coeff_z(r, q) - end do - end do - end do + do l = 0, n + do k = 0, m + !$acc loop seq + do r = -fd_number, fd_number + du_dz(k, l, q) = du_dz(k, l, q) & + + q_prim_vf(momxb)%sf(k, l, q + r)*fd_coeff_z(r, q) + dv_dz(k, l, q) = dv_dz(k, l, q) & + + q_prim_vf(momxb + 1)%sf(k, l, q + r)*fd_coeff_z(r, q) + dw_dx(k, l, q) = dw_dx(k, l, q) & + + q_prim_vf(momxe)%sf(k + r, l, q)*fd_coeff_x(r, k) + dw_dy(k, l, q) = dw_dy(k, l, q) & + + q_prim_vf(momxe)%sf(k, l + r, q)*fd_coeff_y(r, l) + dw_dz(k, l, q) = dw_dz(k, l, q) & + + q_prim_vf(momxe)%sf(k, l, q + r)*fd_coeff_z(r, q) + end do + end do + end do end do !$acc end parallel loop end if diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 72bb1c8757..0bfca58155 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -794,7 +794,7 @@ contains !print *, "I got here c" call nvtxStartRange("RHS-ELASTIC") - if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_qp%vf,q_prim_qp%vf) + if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_qp%vf, q_prim_qp%vf) call nvtxEndRange if (t_step == t_step_stop) return diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index c1257964e0..c5175104ce 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -162,13 +162,13 @@ module m_riemann_solvers @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsx_vf, flux_src_rsx_vf) @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsy_vf, flux_src_rsy_vf) @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsz_vf, flux_src_rsz_vf) - !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & + !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) #else real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsx_vf, flux_src_rsx_vf real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsy_vf, flux_src_rsy_vf real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsz_vf, flux_src_rsz_vf - !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & + !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf) #endif !> @} @@ -357,7 +357,9 @@ contains #:for NORM_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] if (norm_dir == ${NORM_DIR}$) then - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, xi_field_L, xi_field_R) + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, & + !$acc vel_L, vel_R, alpha_L, alpha_R, vel_avg, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, & + !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, xi_field_L, xi_field_R) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -962,8 +964,8 @@ contains ! 6-EQUATION MODEL WITH HLLC if (model_eqns == 3) then !ME3 - !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & - !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, & + !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & + !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, vel_avg_rms, alpha_L, alpha_R, tau_e_L, tau_e_R, & !$acc G_L, G_R, flux_ene_e, xi_field_L, xi_field_R) do l = is3%beg, is3%end do k = is2%beg, is2%end @@ -1098,25 +1100,25 @@ contains if (hyperelasticity) then !$acc loop seq do i = 1, num_dims - xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) - xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) + xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) + xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) end do G_L = 0d0; G_R = 0d0; - !$acc loop seq + !$acc loop seq do i = 1, num_fluids ! Mixture left and right shear modulus G_L = G_L + alpha_L(i)*Gs(i) G_R = G_R + alpha_R(i)*Gs(i) end do ! Elastic contribution to energy if G large enough - if ( G_L > verysmall .and. G_R > verysmall ) then - E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) - E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) + if (G_L > verysmall .and. G_R > verysmall) then + E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) + E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) end if !$acc loop seq do i = 1, b_size - 1 - tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do end if @@ -1145,11 +1147,11 @@ contains if (wave_speeds == 1) then if (elasticity) then s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & - (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & - (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & @@ -1210,14 +1212,14 @@ contains ! MOMENTUM FLUX. ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) - !$acc loop seq + !$acc loop seq do i = 1, num_dims idxi = dir_idx(i) flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & xi_M*(rho_L*(vel_L(idx1)*vel_L(idxi) + s_M*(xi_L*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))*vel_L(idxi)) - vel_L(idxi))) + dir_flg(idxi)*(pres_L)) + & + (1d0 - dir_flg(idxi))*vel_L(idxi)) - vel_L(idxi))) + dir_flg(idxi)*(pres_L)) + & xi_P*(rho_R*(vel_R(idx1)*vel_R(idxi) + s_P*(xi_R*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))*vel_R(idxi)) - vel_R(idxi))) + dir_flg(idxi)*(pres_R)) + (1d0 - dir_flg(idxi))*vel_R(idxi)) - vel_R(idxi))) + dir_flg(idxi)*(pres_R)) end do ! ENERGY FLUX. @@ -1230,22 +1232,22 @@ contains ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux if (elasticity) then - flux_ene_e = 0d0; - !$acc loop seq - do i = 1, num_dims - idxi = dir_idx(i) - ! MOMENTUM ELASTIC FLUX. - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & - flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & - - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) - ! ENERGY ELASTIC FLUX. - flux_ene_e = flux_ene_e - & - xi_M*(vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & - s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & - xi_P*(vel_R(idxi)*tau_e_R(dir_idx_tau(i)) + & - s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) - end do - flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e + flux_ene_e = 0d0; + !$acc loop seq + do i = 1, num_dims + idxi = dir_idx(i) + ! MOMENTUM ELASTIC FLUX. + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & + - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) + ! ENERGY ELASTIC FLUX. + flux_ene_e = flux_ene_e - & + xi_M*(vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & + s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & + xi_P*(vel_R(idxi)*tau_e_R(dir_idx_tau(i)) + & + s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) + end do + flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e end if ! VOLUME FRACTION FLUX. @@ -1257,12 +1259,12 @@ contains end do ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. - !$acc loop seq + !$acc loop seq do i = 1, num_dims idxi = dir_idx(i) vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & - xi_M*(vel_L(idxi) + dir_flg(idxi)*(s_S*(xi_MP*(xi_L - 1) + 1) - vel_L(idxi))) + & - xi_P*(vel_R(idxi) + dir_flg(idxi)*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(idxi))) + xi_M*(vel_L(idxi) + dir_flg(idxi)*(s_S*(xi_MP*(xi_L - 1) + 1) - vel_L(idxi))) + & + xi_P*(vel_R(idxi) + dir_flg(idxi)*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(idxi))) end do ! INTERNAL ENERGIES ADVECTION FLUX. @@ -1287,24 +1289,24 @@ contains ! HYPOELASTIC STRESS EVOLUTION FLUX. if (hypoelasticity) then - !$acc loop seq - do i = 1, strxe - strxb + 1 - flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & - xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & - xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) - end do + !$acc loop seq + do i = 1, strxe - strxb + 1 + flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & + xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & + xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) + end do end if ! REFERENCE MAP FLUX. if (hyperelasticity) then - !$acc loop seq - do i = 1, num_dims - flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & - xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*xi_field_L(i) & - - rho_L*vel_L(idx1)*xi_field_L(i)) + & - xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*xi_field_R(i) & - - rho_R*vel_R(idx1)*xi_field_R(i)) - end do + !$acc loop seq + do i = 1, num_dims + flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & + xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*xi_field_L(i) & + - rho_L*vel_L(idx1)*xi_field_L(i)) + & + xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*xi_field_R(i) & + - rho_R*vel_R(idx1)*xi_field_R(i)) + end do end if ! SURFACE TENSION FLUX. need to check @@ -1316,9 +1318,9 @@ contains ! correction pressure for the cylindrical terms p_Star = xi_M*(pres_L + xi_MP*rho_L*(s_L - & - vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1)))) + & - xi_P*(pres_R + xi_PP*rho_R*(s_R - & - vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1)))) + vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1)))) + & + xi_P*(pres_R + xi_PP*rho_R*(s_R - & + vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1)))) ! Geometrical source flux for cylindrical coordinates #:if (NORM_DIR == 2) @@ -1361,8 +1363,8 @@ contains elseif (model_eqns == 4) then !ME4 - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, & - !$acc vel_L, vel_R, alpha_L, alpha_R, vel_avg, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, & + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, & + !$acc vel_L, vel_R, alpha_L, alpha_R, vel_avg, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, & !$acc vel_avg_rms, nbub_L, nbub_R, ptilde_L, ptilde_R) do l = is3%beg, is3%end do k = is2%beg, is2%end @@ -1611,9 +1613,9 @@ contains end do !$acc end parallel loop elseif (model_eqns == 2 .and. bubbles) then - !$acc parallel loop collapse(3) gang vector default(present) private(R0_L, R0_R, V0_L, V0_R, & - !$acc P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, & - !$acc s_L, s_R, s_S, nbub_L, nbub_R, ptilde_L, ptilde_R, vel_avg_rms, Re_L, Re_R, & + !$acc parallel loop collapse(3) gang vector default(present) private(R0_L, R0_R, V0_L, V0_R, & + !$acc P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, & + !$acc s_L, s_R, s_S, nbub_L, nbub_R, ptilde_L, ptilde_R, vel_avg_rms, Re_L, Re_R, & !$acc pcorr, zcoef, vel_L_tmp, vel_R_tmp) do l = is3%beg, is3%end do k = is2%beg, is2%end @@ -1700,31 +1702,24 @@ contains !$acc loop seq do i = 1, 2 Re_L(i) = dflt_real - if (Re_size(i) > 0) Re_L(i) = 0d0 - !$acc loop seq do q = 1, Re_size(i) Re_L(i) = (1d0 - qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q)))/Res(i, q) & + Re_L(i) end do - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) - end do !$acc loop seq do i = 1, 2 Re_R(i) = dflt_real - if (Re_size(i) > 0) Re_R(i) = 0d0 - !$acc loop seq do q = 1, Re_size(i) Re_R(i) = (1d0 - qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q)))/Res(i, q) & + Re_R(i) end do - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) end do end if @@ -2075,10 +2070,10 @@ contains end do !$acc end parallel loop else - ! 5-EQUATION MODEL WITH HLLC, INTERFACE CAPTURING ONLY + ! 5-EQUATION MODEL WITH HLLC !$acc parallel loop collapse(3) gang vector default(present) private(vel_L, vel_R, Re_L, Re_R, & !$acc rho_avg, h_avg, gamma_avg, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, & - !$acc tau_e_L, tau_e_R, vel_L_tmp, vel_R_tmp, xi_field_L, xi_field_R) + !$acc tau_e_L, tau_e_R, vel_L_tmp, vel_R_tmp, xi_field_L, xi_field_R) do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end @@ -2193,7 +2188,7 @@ contains tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do - G_L = 0d0 + G_L = 0d0 G_R = 0d0 !$acc loop seq do i = 1, num_fluids @@ -2219,26 +2214,26 @@ contains if (hyperelasticity) then !$acc loop seq do i = 1, num_dims - xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) - xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) + xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) + xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) end do G_L = 0d0 G_R = 0d0 - !$acc loop seq + !$acc loop seq do i = 1, num_fluids ! Mixture left and right shear modulus G_L = G_L + alpha_L(i)*Gs(i) G_R = G_R + alpha_R(i)*Gs(i) end do ! Elastic contribution to energy if G large enough - if ( G_L > verysmall .and. G_R > verysmall ) then - E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) - E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) + if (G_L > verysmall .and. G_R > verysmall) then + E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) + E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) end if !$acc loop seq do i = 1, b_size - 1 - tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do end if @@ -2272,11 +2267,11 @@ contains if (wave_speeds == 1) then if (elasticity) then s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & - (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L), vel_R(dir_idx(1)) - sqrt(c_R*c_R + & + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R)) s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & - (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) + (((4d0*G_R)/3d0) + tau_e_R(dir_idx_tau(1)))/rho_R), vel_L(dir_idx(1)) + sqrt(c_L*c_L + & + (((4d0*G_L)/3d0) + tau_e_L(dir_idx_tau(1)))/rho_L)) s_S = (pres_R - tau_e_R(dir_idx_tau(1)) - pres_L + & tau_e_L(dir_idx_tau(1)) + rho_L*vel_L(idx1)*(s_L - vel_L(idx1)) - & rho_R*vel_R(idx1)*(s_R - vel_R(idx1)))/(rho_L*(s_L - vel_L(idx1)) - & @@ -2287,7 +2282,7 @@ contains s_S = (pres_R - pres_L + rho_L*vel_L(dir_idx(1))* & (s_L - vel_L(dir_idx(1))) - rho_R*vel_R(dir_idx(1))*(s_R - vel_R(dir_idx(1)))) & /(rho_L*(s_L - vel_L(dir_idx(1))) - rho_R*(s_R - vel_R(dir_idx(1)))) - + end if elseif (wave_speeds == 2) then pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & @@ -2340,7 +2335,7 @@ contains ! MOMENTUM FLUX. ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) - !$acc loop seq + !$acc loop seq do i = 1, num_dims idxi = dir_idx(i) flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & @@ -2357,7 +2352,7 @@ contains vel_R(idxi)) - vel_R(idxi))) + & dir_flg(idxi)*(pres_R)) & + (s_M/s_L)*(s_P/s_R)*dir_flg(idxi)*pcorr - end do + end do ! ENERGY FLUX. ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) @@ -2374,41 +2369,42 @@ contains ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux if (elasticity) then - flux_ene_e = 0d0 - !$acc loop seq - do i = 1, num_dims - ! MOMENTUM ELASTIC FLUX. - flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & - flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) & - - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) - ! ENERGY ELASTIC FLUX. - flux_ene_e = flux_ene_e - & - xi_M*(vel_L(dir_idx(i))*tau_e_L(dir_idx_tau(i)) + & - s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & - xi_P*(vel_R(dir_idx(i))*tau_e_R(dir_idx_tau(i)) + & - s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) - end do - flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e + flux_ene_e = 0d0 + !$acc loop seq + do i = 1, num_dims + idxi = dir_idx(i) + ! MOMENTUM ELASTIC FLUX. + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & + flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & + - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) + ! ENERGY ELASTIC FLUX. + flux_ene_e = flux_ene_e - & + xi_M*(vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & + s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & + xi_P*(vel_R(idxi)*tau_e_R(dir_idx_tau(i)) + & + s_P*(xi_R*((s_S - vel_R(i))*(tau_e_R(dir_idx_tau(i))/(s_R - vel_R(i)))))) + end do + flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e end if ! HYPOELASTIC STRESS EVOLUTION FLUX. if (hypoelasticity) then !$acc loop seq do i = 1, strxe - strxb + 1 - flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & - xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & - xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) + flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & + xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*tau_e_L(i) - rho_L*vel_L(idx1)*tau_e_L(i)) + & + xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*tau_e_R(i) - rho_R*vel_R(idx1)*tau_e_R(i)) end do end if ! VOLUME FRACTION FLUX. !$acc loop seq do i = advxb, advxe - flux_rs${XYZ}$_vf(j, k, l, i) = & - xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & - *(vel_L(idx1) + s_M*(xi_L - 1d0)) & - + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & - *(vel_R(idx1) + s_P*(xi_R - 1d0)) + flux_rs${XYZ}$_vf(j, k, l, i) = & + xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & + *(vel_L(idx1) + s_M*(xi_L - 1d0)) & + + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & + *(vel_R(idx1) + s_P*(xi_R - 1d0)) end do ! VOLUME FRACTION SOURCE FLUX. @@ -2426,14 +2422,14 @@ contains ! REFERENCE MAP FLUX. if (hyperelasticity) then - !$acc loop seq - do i = 1, num_dims - flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & - xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*xi_field_L(i) & - - rho_L*vel_L(idx1)*xi_field_L(i)) + & - xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*xi_field_R(i) & - - rho_R*vel_R(idx1)*xi_field_R(i)) - end do + !$acc loop seq + do i = 1, num_dims + flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & + xi_M*(s_S/(s_L - s_S))*(s_L*rho_L*xi_field_L(i) & + - rho_L*vel_L(idx1)*xi_field_L(i)) + & + xi_P*(s_S/(s_R - s_S))*(s_R*rho_R*xi_field_R(i) & + - rho_R*vel_R(idx1)*xi_field_R(i)) + end do end if flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index b940bdc812..7da59c360b 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -823,7 +823,7 @@ contains end if call nvtxStartRange("RHS-ELASTIC") - if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_ts(1)%vf, q_prim_vf) + if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_ts(1)%vf, q_prim_vf) call nvtxEndRange if (adv_n) call s_comp_alpha_from_n(q_cons_ts(1)%vf) From fd537f9ce1cee3f15687ee001e49465154aabedd Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 6 Aug 2024 14:21:15 -0500 Subject: [PATCH 280/380] add examples cases from CTR to the examples folder --- .../old_case.py => 3D_hyper_bubingel/case.py} | 209 ++++++------ .../case.py | 162 +++++---- examples/3D_hyperelasticity/hyper_gel.py | 312 ------------------ 3 files changed, 208 insertions(+), 475 deletions(-) rename examples/{3D_ctr_test/old_case.py => 3D_hyper_bubingel/case.py} (66%) mode change 100644 => 100755 rename examples/{3D_ctr_test => 3D_hyper_bubinwater}/case.py (75%) mode change 100644 => 100755 delete mode 100644 examples/3D_hyperelasticity/hyper_gel.py diff --git a/examples/3D_ctr_test/old_case.py b/examples/3D_hyper_bubingel/case.py old mode 100644 new mode 100755 similarity index 66% rename from examples/3D_ctr_test/old_case.py rename to examples/3D_hyper_bubingel/case.py index 092c021366..e5fbd9bfd4 --- a/examples/3D_ctr_test/old_case.py +++ b/examples/3D_hyper_bubingel/case.py @@ -90,22 +90,25 @@ # density rho0wa1 = (p01 + pia)/((gamwa-1)*cva*T01) rho0wa2 = (p02 + pia)/((gamwa-1)*cva*T02) +rho0wa3 = (p03 + pia)/((gamwa-1)*cva*T03) # Speed of sound c_a1 = math.sqrt( gamwa * ( p01 + pia ) / rho0wa1 ) c_a2 = math.sqrt( gamwa * ( p02 + pia ) / rho0wa2 ) +c_a3 = math.sqrt( gamwa * ( p03 + pia ) / rho0wa3 ) ### 3% polyacrylamide gel ### + # gamma -gamwg = 2.35 +gamwg = gamwl #2.35 # pi infty -pig = 1.0E+09 +pig = piwl #1.1754E+09 # qv -qvwg = -1167000 +qvwg = qvwl #0.0E0 # qv' -qvpwg = 0.0E0 +qvpwg = qvpwl #0.0E0 # cv -cvg = 1816 +cvg = cvwl # cp cpg = gamwg*cvg @@ -131,47 +134,58 @@ ss = Ms * c_a1 ### volume fractions for each of the patches ### -C0 = 0.1 # vapor concentration for IMR +C0 = 0.25 # vapor concentration for IMR # patch 1: liquid water -liq_wv = 1.00E-15 -liq_wg = 1.00E-15 +liq_wg = 0 liq_wa = 1.00E-15 +liq_wv = 1.00E-15 liq_wl = 1.00E00 - liq_wv - liq_wa - liq_wg # water vapor vap_wl = 1.00E-15 vap_wv = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0wa2 + 1 ) -vap_wg = 1.00E-15 vap_wa = 1.00E-15 +vap_wg = 0 vap_tot = vap_wl + vap_wv + vap_wa + vap_wg -# bub -bub_wl = 1.00E-15 +# air +air_wl = 1.00E-15 +air_wv = vap_tot +air_wg = 0 +air_wa = 1.00E00 - air_wl - air_wv - air_wg +# bubble +bub_wl = 1E-15 bub_wv = vap_tot -bub_wg = 1.00E-15 -bub_wa = 1.00E00 - bub_wl - bub_wv - bub_wg +bub_wg = 0 +bub_wa = 1 - bub_wl - bub_wv - bub_wg # gel -gel_wv = 1.00E-15 -gel_wl = 1.00E-15 -gel_wa = 1.00E-15 +gel_wl = 0 +gel_wv = 0 +gel_wa = 0 gel_wg = 1.00E00 - gel_wl - gel_wv - gel_wa +## Elasticity +Gl = 0 +Gv = 0 +Ga = 0 +Gg = 0.57E+03 + ## SIMULATION PARAMETERS # CFL -cfl = 0.50 +cfl = 0.30 # Bubble Initial Radius -R0 = 230.4E-06 +R0 = 244.8E-06 # number of elements -Nx0 = 400 -Nx = 199*2 -Ny = 199 -Nz = 199 +Nx = 249 #404 #249 +Ny = 124 #179 #124 +Nz = 124 #179 #124 +Nx0 = Nx -lref = 921.6E-6 # domain boundaries -xb = -lref +lref = 4*R0 +xb = -5*R0 xe = lref yb = 0.00 @@ -184,24 +198,18 @@ leny = ( ye - yb ) lenz = ( ze - zb ) -xcenl = (xb + xe)/2.0 -ycenl = (yb + ye)/2.0 -zcenl = (zb + ze)/2.0 +xcenl = 0. +ycenl = leny/2. +zcenl = lenz/2. #xdist = 6.51E-10 #2.17E-5 #sod = xdist/R0 -sod = -2.17 -xcenb = sod*R0 +sod = 1.39 +xcenb = sod*R0 #neg for bub in liq; pos bub in gel ycenb = 0.00 zcenb = 0.00 -xbg = 0 -xeg = xe - -lenxg = (xeg - xbg) -lenyg = leny -lenzg = lenz -xceng = (xbg + xeg)/2.0 +xceng = xe / 2. yceng = ycenl zceng = zcenl @@ -210,10 +218,14 @@ dy = ( ye - yb ) / Ny dz = ( ze - zb ) / Nz #print(dx) -# time step +PPBR_x = R0 / dx +PPBR_y = R0 / dy +PPBR_z = R0 / dz +#print(PPBR_x) +#print(PPBR_y) # save frequency = SF + 1 (because the initial state, 0.dat, is also saved) -SF = 60 +SF = 100 # Critical time-step tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) @@ -230,12 +242,13 @@ # Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) # Nt = AS * SF -Nt = int(10E3 * tend // tc * Nx / Nx0 + 1) +#Nt = int(2.5E3 * tend // tc * Nx / Nx0 + 1) +Nt = int(2.0E3 * tend // tc * Nx / Nx0 + 1) #print(Nt) dt = tend / Nt AS = int( Nt//SF ) - +tstart = 0#2184 # Total physical time # tend = Nt * dt @@ -251,34 +264,36 @@ 'y_domain%end' : ye, 'z_domain%beg' : zb, 'z_domain%end' : ze, - 'stretch_x' : 'F', + 'stretch_x' : 'T', 'loops_x' : 1, 'a_x' : 4.0E0, - 'x_a' : -2.0*R0, - 'x_b' : 2.0*R0, - 'stretch_y' : 'F', + 'x_a' : -1.75*R0*(abs(sod)+1), + 'x_b' : 5*R0, + 'stretch_y' : 'T', 'loops_y' : 1, - 'a_y' : 4.0E0, - 'y_a' : -2.0*R0, - 'y_b' : 2.0*R0, - 'stretch_z' : 'F', + 'a_y' : 1.0E0, + 'y_a' : -1.5*R0*abs(sod), + 'y_b' : 1.5*R0*abs(sod), + 'stretch_z' : 'T', 'loops_z' : 1, - 'a_z' : 4.0E0, - 'z_a' : -2.0*R0, - 'z_b' : 2.0*R0, + 'a_z' : 1.0E0, + 'z_a' : -1.5*R0*abs(sod), + 'z_b' : 1.5*R0*abs(sod), 'cyl_coord' : 'F', 'm' : Nx, 'n' : Ny, 'p' : Nz, 'dt' : dt, - 't_step_start' : 0, + 't_step_start' : tstart, 't_step_stop' : Nt, 't_step_save' : AS, # ========================================================== # Simulation Algorithm Parameters ========================== 'num_patches' : 3, 'model_eqns' : 3, - 'num_fluids' : 4, + 'num_fluids' : 4, + 'hypoelasticity' : 'F', + 'hyperelasticity' : 'T', 'adv_alphan' : 'T', 'mpp_lim' : 'T', 'mixture_err' : 'T', @@ -309,28 +324,34 @@ 'precision' : 2, 'prim_vars_wrt':'T', 'parallel_io' :'T', + 'probe_wrt' :'T', + 'fd_order' : 1, + 'num_probes' : 1, + 'probe(1)%x' : 0., + 'probe(1)%y' : 0., + 'probe(1)%z' : 0., # ========================================================== # Patch 1: High pressured water ============================ # Specify the cubic water background grid geometry 'patch_icpp(1)%geometry' : 9, - 'patch_icpp(1)%x_centroid' : xcenl, - 'patch_icpp(1)%y_centroid' : ycenl, - 'patch_icpp(1)%z_centroid' : zcenl, - 'patch_icpp(1)%length_x' : lenx, - 'patch_icpp(1)%length_y' : leny, - 'patch_icpp(1)%length_z' : lenz, + 'patch_icpp(1)%x_centroid' : 20*xcenl, + 'patch_icpp(1)%y_centroid' : 20*ycenl, + 'patch_icpp(1)%z_centroid' : 20*zcenl, + 'patch_icpp(1)%length_x' : 20*lenx, + 'patch_icpp(1)%length_y' : 20*leny, + 'patch_icpp(1)%length_z' : 20*lenz, 'patch_icpp(1)%vel(1)' : 0.0E+00, 'patch_icpp(1)%vel(2)' : 0.0E+00, 'patch_icpp(1)%vel(3)' : 0.0E+00, 'patch_icpp(1)%pres' : p01, - 'patch_icpp(1)%alpha_rho(1)' : liq_wl * rho0wl1, + 'patch_icpp(1)%alpha_rho(4)' : liq_wl * rho0wl1, 'patch_icpp(1)%alpha_rho(2)' : liq_wv * rho0wv1, 'patch_icpp(1)%alpha_rho(3)' : liq_wa * rho0wa1, - 'patch_icpp(1)%alpha_rho(4)' : liq_wg * rho0wg1, - 'patch_icpp(1)%alpha(1)' : liq_wl, + 'patch_icpp(1)%alpha_rho(1)' : liq_wg * rho0wg1, + 'patch_icpp(1)%alpha(4)' : liq_wl, 'patch_icpp(1)%alpha(2)' : liq_wv, 'patch_icpp(1)%alpha(3)' : liq_wa, - 'patch_icpp(1)%alpha(4)' : liq_wg, + 'patch_icpp(1)%alpha(1)' : liq_wg, # ========================================================== # Patch 2: (Vapor) Bubble ================================== 'patch_icpp(2)%geometry' : 8, @@ -342,58 +363,62 @@ 'patch_icpp(2)%vel(2)' : 0.0E+00, 'patch_icpp(2)%vel(3)' : 0.0E+00, 'patch_icpp(2)%pres' : p02, - 'patch_icpp(2)%alpha_rho(1)' : bub_wl * rho0wl2, - 'patch_icpp(2)%alpha_rho(2)' : bub_wv * rho0wv2, - 'patch_icpp(2)%alpha_rho(3)' : bub_wa * rho0wa2, - 'patch_icpp(2)%alpha_rho(4)' : bub_wg * rho0wg2, - 'patch_icpp(2)%alpha(1)' : bub_wl, + 'patch_icpp(2)%alpha_rho(4)' : bub_wl*rho0wl2, + 'patch_icpp(2)%alpha_rho(2)' : bub_wv*rho0wv2, + 'patch_icpp(2)%alpha_rho(3)' : bub_wa*rho0wa2, + 'patch_icpp(2)%alpha_rho(1)' : bub_wg*rho0wg2, + 'patch_icpp(2)%alpha(4)' : bub_wl, 'patch_icpp(2)%alpha(2)' : bub_wv, 'patch_icpp(2)%alpha(3)' : bub_wa, - 'patch_icpp(2)%alpha(4)' : bub_wg, + 'patch_icpp(2)%alpha(1)' : bub_wg, 'patch_icpp(2)%alter_patch(1)' : 'T', # ========================================================== # Patch 3: Gel Object ====================================== 'patch_icpp(3)%geometry' : 9, - 'patch_icpp(3)%x_centroid' : xceng, - 'patch_icpp(3)%y_centroid' : yceng, - 'patch_icpp(3)%z_centroid' : zceng, - 'patch_icpp(3)%length_x' : lenxg, - 'patch_icpp(3)%length_y' : lenyg, - 'patch_icpp(3)%length_z' : lenzg, + 'patch_icpp(3)%x_centroid' : 20*xceng, + 'patch_icpp(3)%y_centroid' : 20*yceng, + 'patch_icpp(3)%z_centroid' : 20*zceng, + 'patch_icpp(3)%length_x' : 20*xe, + 'patch_icpp(3)%length_y' : 20*leny, + 'patch_icpp(3)%length_z' : 20*lenz, 'patch_icpp(3)%vel(1)' : 0.0E+00, 'patch_icpp(3)%vel(2)' : 0.0E+00, 'patch_icpp(3)%vel(3)' : 0.0E+00, 'patch_icpp(3)%pres' : p03, - 'patch_icpp(3)%alpha_rho(1)' : gel_wl * rho0wl2, - 'patch_icpp(3)%alpha_rho(2)' : gel_wv * rho0wv2, - 'patch_icpp(3)%alpha_rho(3)' : gel_wa * rho0wa2, - 'patch_icpp(3)%alpha_rho(4)' : gel_wg * rho0wg2, - 'patch_icpp(3)%alpha(1)' : gel_wl, + 'patch_icpp(3)%alpha_rho(4)' : gel_wl * rho0wl3, + 'patch_icpp(3)%alpha_rho(2)' : gel_wv * rho0wv3, + 'patch_icpp(3)%alpha_rho(3)' : gel_wa * rho0wa3, + 'patch_icpp(3)%alpha_rho(1)' : gel_wg * rho0wg3, + 'patch_icpp(3)%alpha(4)' : gel_wl, 'patch_icpp(3)%alpha(2)' : gel_wv, 'patch_icpp(3)%alpha(3)' : gel_wa, - 'patch_icpp(3)%alpha(4)' : gel_wg, + 'patch_icpp(3)%alpha(1)' : gel_wg, 'patch_icpp(3)%alter_patch(1)' : 'T', # ========================================================== # Fluids Physical Parameters =============================== - 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), - 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), - 'fluid_pp(1)%cv' : cvwl, - 'fluid_pp(1)%qv' : qvwl, - 'fluid_pp(1)%qvp' : qvpwl, + 'fluid_pp(4)%gamma' : 1.0E+00 / ( gamwl - 1 ), + 'fluid_pp(4)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), + 'fluid_pp(4)%cv' : cvwl, + 'fluid_pp(4)%qv' : qvwl, + 'fluid_pp(4)%qvp' : qvpwl, + 'fluid_pp(4)%G' : Gl, 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), 'fluid_pp(2)%cv' : cvwv, 'fluid_pp(2)%qv' : qvwv, - 'fluid_pp(2)%qvp' : qvpwv, + 'fluid_pp(2)%qvp' : qvpwv, + 'fluid_pp(2)%G' : Gv, 'fluid_pp(3)%gamma' : 1.0E+00 / ( gamwa - 1 ), 'fluid_pp(3)%pi_inf' : gamwa * pia / ( gamwa - 1 ), 'fluid_pp(3)%cv' : cva, 'fluid_pp(3)%qv' : qvwa, 'fluid_pp(3)%qvp' : qvpwa, - 'fluid_pp(4)%gamma' : 1.0E+00 / ( gamwg - 1), - 'fluid_pp(4)%pi_inf' : gamwg * pig / ( gamwg - 1), - 'fluid_pp(4)%cv' : cvg, - 'fluid_pp(4)%qv' : qvwg, - 'fluid_pp(4)%qvp' : qvpwg, + 'fluid_pp(3)%G' : Ga, + 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwg - 1), + 'fluid_pp(1)%pi_inf' : gamwg * pig / ( gamwg - 1), + 'fluid_pp(1)%cv' : cvg, + 'fluid_pp(1)%qv' : qvwg, + 'fluid_pp(1)%qvp' : qvpwg, + 'fluid_pp(1)%G' : Gg, # ========================================================== })) diff --git a/examples/3D_ctr_test/case.py b/examples/3D_hyper_bubinwater/case.py old mode 100644 new mode 100755 similarity index 75% rename from examples/3D_ctr_test/case.py rename to examples/3D_hyper_bubinwater/case.py index aac9ec367a..2fff7d603e --- a/examples/3D_ctr_test/case.py +++ b/examples/3D_hyper_bubinwater/case.py @@ -90,22 +90,25 @@ # density rho0wa1 = (p01 + pia)/((gamwa-1)*cva*T01) rho0wa2 = (p02 + pia)/((gamwa-1)*cva*T02) +rho0wa3 = (p03 + pia)/((gamwa-1)*cva*T03) # Speed of sound c_a1 = math.sqrt( gamwa * ( p01 + pia ) / rho0wa1 ) c_a2 = math.sqrt( gamwa * ( p02 + pia ) / rho0wa2 ) +c_a3 = math.sqrt( gamwa * ( p03 + pia ) / rho0wa3 ) ### 3% polyacrylamide gel ### + # gamma -gamwg = 2.35 +gamwg = gamwl #2.35 # pi infty -pig = 1.0E+09 +pig = piwl # 1.1754E+09 # qv -qvwg = -1167000 +qvwg = qvwl # 0.0E0 # qv' -qvpwg = 0.0E0 +qvpwg = qvpwl #0.0E0 # cv -cvg = 1816 +cvg = cvwl # cp cpg = gamwg*cvg @@ -131,30 +134,41 @@ ss = Ms * c_a1 ### volume fractions for each of the patches ### -C0 = 0.5 # vapor concentration for IMR +C0 = 0.25 # vapor concentration for IMR # patch 1: liquid water -liq_wv = 1.00E-15 -liq_wg = 0. +liq_wg = 0 liq_wa = 1.00E-15 +liq_wv = 1.00E-15 liq_wl = 1.00E00 - liq_wv - liq_wa - liq_wg # water vapor vap_wl = 1.00E-15 vap_wv = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0wa2 + 1 ) -vap_wg = 0. vap_wa = 1.00E-15 +vap_wg = 0 vap_tot = vap_wl + vap_wv + vap_wa + vap_wg -# bub -bub_wl = 1.00E-15 +# air +air_wl = 1.00E-15 +air_wv = vap_tot +air_wg = 0 +air_wa = 1.00E00 - air_wl - air_wv - air_wg +# bubble +bub_wl = 1E-15 bub_wv = vap_tot -bub_wg = 0. -bub_wa = 1.00E00 - bub_wl - bub_wv - bub_wg +bub_wg = 0 +bub_wa = 1 - bub_wl - bub_wv - bub_wg # gel -gel_wv = 0. -gel_wl = 0. -gel_wa = 0. +gel_wl = 0 +gel_wv = 0 +gel_wa = 0 gel_wg = 1.00E00 - gel_wl - gel_wv - gel_wa +## Elasticity +Gl = 0 +Gv = 0 +Ga = 0 +Gg = 0.57E+03 + ## SIMULATION PARAMETERS # CFL @@ -164,14 +178,14 @@ R0 = 230.4E-06 # number of elements -Nx0 = 400 -Nx = 399 -Ny = 199 -Nz = 199 +Nx = 249 #404 #249 +Ny = 124 #179 #124 +Nz = 124 #179 #124 +Nx0 = Nx -lref = 921.6E-6 # domain boundaries -xb = -lref +lref = 4*R0 +xb = -5*R0 xe = lref yb = 0.00 @@ -184,24 +198,18 @@ leny = ( ye - yb ) lenz = ( ze - zb ) -xcenl = (xb + xe)/2.0 -ycenl = (yb + ye)/2.0 -zcenl = (zb + ze)/2.0 +xcenl = 0. +ycenl = leny/2. +zcenl = lenz/2. #xdist = 6.51E-10 #2.17E-5 #sod = xdist/R0 -sod = -2.17 -xcenb = sod*R0 +sod = 2.17 +xcenb = -sod*R0 #-sod #-sod*R0 ycenb = 0.00 zcenb = 0.00 -xbg = 0 -xeg = xe - -lenxg = (xeg - xbg) -lenyg = leny -lenzg = lenz -xceng = (xbg + xeg)/2.0 +xceng = xe / 2. yceng = ycenl zceng = zcenl @@ -213,7 +221,7 @@ # time step # save frequency = SF + 1 (because the initial state, 0.dat, is also saved) -SF = 60 +SF = 100 # Critical time-step tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) @@ -230,12 +238,12 @@ # Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) # Nt = AS * SF -Nt = int(10E3 * tend // tc * Nx / Nx0 + 1) +Nt = int(2E3 * tend // tc * Nx / Nx0 + 1) #print(Nt) dt = tend / Nt AS = int( Nt//SF ) - +tstart = 0#2304 # Total physical time # tend = Nt * dt @@ -251,34 +259,36 @@ 'y_domain%end' : ye, 'z_domain%beg' : zb, 'z_domain%end' : ze, - 'stretch_x' : 'F', + 'stretch_x' : 'T', 'loops_x' : 1, 'a_x' : 4.0E0, - 'x_a' : -2.0*R0, - 'x_b' : 2.0*R0, - 'stretch_y' : 'F', + 'x_a' : -1.75*R0*(abs(sod)+1), + 'x_b' : 5*R0, + 'stretch_y' : 'T', 'loops_y' : 1, - 'a_y' : 4.0E0, - 'y_a' : -2.0*R0, - 'y_b' : 2.0*R0, - 'stretch_z' : 'F', + 'a_y' : 1.0E0, + 'y_a' : -1.5*R0*abs(sod), + 'y_b' : 1.5*R0*abs(sod), + 'stretch_z' : 'T', 'loops_z' : 1, - 'a_z' : 4.0E0, - 'z_a' : -2.0*R0, - 'z_b' : 2.0*R0, + 'a_z' : 1.0E0, + 'z_a' : -1.5*R0*abs(sod), + 'z_b' : 1.5*R0*abs(sod), 'cyl_coord' : 'F', 'm' : Nx, 'n' : Ny, 'p' : Nz, 'dt' : dt, - 't_step_start' : 0, + 't_step_start' : tstart, 't_step_stop' : Nt, 't_step_save' : AS, # ========================================================== # Simulation Algorithm Parameters ========================== 'num_patches' : 3, 'model_eqns' : 3, - 'num_fluids' : 4, + 'num_fluids' : 4, + 'hypoelasticity' : 'F', + 'hyperelasticity' : 'T', 'adv_alphan' : 'T', 'mpp_lim' : 'T', 'mixture_err' : 'T', @@ -309,16 +319,22 @@ 'precision' : 2, 'prim_vars_wrt':'T', 'parallel_io' :'T', + 'probe_wrt' :'T', + 'fd_order' : 1, + 'num_probes' : 1, + 'probe(1)%x' : 0., + 'probe(1)%y' : 0., + 'probe(1)%z' : 0., # ========================================================== # Patch 1: High pressured water ============================ # Specify the cubic water background grid geometry 'patch_icpp(1)%geometry' : 9, - 'patch_icpp(1)%x_centroid' : xcenl, - 'patch_icpp(1)%y_centroid' : ycenl, - 'patch_icpp(1)%z_centroid' : zcenl, - 'patch_icpp(1)%length_x' : lenx, - 'patch_icpp(1)%length_y' : leny, - 'patch_icpp(1)%length_z' : lenz, + 'patch_icpp(1)%x_centroid' : 20*xcenl, + 'patch_icpp(1)%y_centroid' : 20*ycenl, + 'patch_icpp(1)%z_centroid' : 20*zcenl, + 'patch_icpp(1)%length_x' : 20*lenx, + 'patch_icpp(1)%length_y' : 20*leny, + 'patch_icpp(1)%length_z' : 20*lenz, 'patch_icpp(1)%vel(1)' : 0.0E+00, 'patch_icpp(1)%vel(2)' : 0.0E+00, 'patch_icpp(1)%vel(3)' : 0.0E+00, @@ -342,10 +358,10 @@ 'patch_icpp(2)%vel(2)' : 0.0E+00, 'patch_icpp(2)%vel(3)' : 0.0E+00, 'patch_icpp(2)%pres' : p02, - 'patch_icpp(2)%alpha_rho(1)' : bub_wl * rho0wl2, - 'patch_icpp(2)%alpha_rho(2)' : bub_wv * rho0wv2, - 'patch_icpp(2)%alpha_rho(3)' : bub_wa * rho0wa2, - 'patch_icpp(2)%alpha_rho(4)' : bub_wg * rho0wg2, + 'patch_icpp(2)%alpha_rho(1)' : bub_wl*rho0wl2, + 'patch_icpp(2)%alpha_rho(2)' : bub_wv*rho0wv2, + 'patch_icpp(2)%alpha_rho(3)' : bub_wa*rho0wa2, + 'patch_icpp(2)%alpha_rho(4)' : bub_wg*rho0wg2, 'patch_icpp(2)%alpha(1)' : bub_wl, 'patch_icpp(2)%alpha(2)' : bub_wv, 'patch_icpp(2)%alpha(3)' : bub_wa, @@ -354,20 +370,20 @@ # ========================================================== # Patch 3: Gel Object ====================================== 'patch_icpp(3)%geometry' : 9, - 'patch_icpp(3)%x_centroid' : xceng, - 'patch_icpp(3)%y_centroid' : yceng, - 'patch_icpp(3)%z_centroid' : zceng, - 'patch_icpp(3)%length_x' : lenxg, - 'patch_icpp(3)%length_y' : lenyg, - 'patch_icpp(3)%length_z' : lenzg, + 'patch_icpp(3)%x_centroid' : 20*xceng, + 'patch_icpp(3)%y_centroid' : 20*yceng, + 'patch_icpp(3)%z_centroid' : 20*zceng, + 'patch_icpp(3)%length_x' : 20*xe, + 'patch_icpp(3)%length_y' : 20*leny, + 'patch_icpp(3)%length_z' : 20*lenz, 'patch_icpp(3)%vel(1)' : 0.0E+00, 'patch_icpp(3)%vel(2)' : 0.0E+00, 'patch_icpp(3)%vel(3)' : 0.0E+00, 'patch_icpp(3)%pres' : p03, - 'patch_icpp(3)%alpha_rho(1)' : gel_wl * rho0wl2, - 'patch_icpp(3)%alpha_rho(2)' : gel_wv * rho0wv2, - 'patch_icpp(3)%alpha_rho(3)' : gel_wa * rho0wa2, - 'patch_icpp(3)%alpha_rho(4)' : gel_wg * rho0wg2, + 'patch_icpp(3)%alpha_rho(1)' : gel_wl * rho0wl3, + 'patch_icpp(3)%alpha_rho(2)' : gel_wv * rho0wv3, + 'patch_icpp(3)%alpha_rho(3)' : gel_wa * rho0wa3, + 'patch_icpp(3)%alpha_rho(4)' : gel_wg * rho0wg3, 'patch_icpp(3)%alpha(1)' : gel_wl, 'patch_icpp(3)%alpha(2)' : gel_wv, 'patch_icpp(3)%alpha(3)' : gel_wa, @@ -380,20 +396,24 @@ 'fluid_pp(1)%cv' : cvwl, 'fluid_pp(1)%qv' : qvwl, 'fluid_pp(1)%qvp' : qvpwl, + 'fluid_pp(1)%G' : Gl, 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), 'fluid_pp(2)%cv' : cvwv, 'fluid_pp(2)%qv' : qvwv, - 'fluid_pp(2)%qvp' : qvpwv, + 'fluid_pp(2)%qvp' : qvpwv, + 'fluid_pp(2)%G' : Gv, 'fluid_pp(3)%gamma' : 1.0E+00 / ( gamwa - 1 ), 'fluid_pp(3)%pi_inf' : gamwa * pia / ( gamwa - 1 ), 'fluid_pp(3)%cv' : cva, 'fluid_pp(3)%qv' : qvwa, 'fluid_pp(3)%qvp' : qvpwa, + 'fluid_pp(3)%G' : Ga, 'fluid_pp(4)%gamma' : 1.0E+00 / ( gamwg - 1), 'fluid_pp(4)%pi_inf' : gamwg * pig / ( gamwg - 1), 'fluid_pp(4)%cv' : cvg, 'fluid_pp(4)%qv' : qvwg, 'fluid_pp(4)%qvp' : qvpwg, + 'fluid_pp(4)%G' : Gg, # ========================================================== })) diff --git a/examples/3D_hyperelasticity/hyper_gel.py b/examples/3D_hyperelasticity/hyper_gel.py deleted file mode 100644 index 09782de488..0000000000 --- a/examples/3D_hyperelasticity/hyper_gel.py +++ /dev/null @@ -1,312 +0,0 @@ -import math -import json -#need quadrant and collapse near hypoelastic wall - -## Define characteristic values for the sim -Ri = 230.4E-6 -# temperature -T = (10*101325+1.0E+09)/(1000*(2.35-1)*1816) -# print("T :: ",T) -rhog = 1 -Pb = 3550 #Pb = 101325 -Pl = 101325 #Pl = 20*101325 -Po = Pl -Pi_inf_l = 1.0E+09 -Pi_inf_b = 0.0E+00 -Pi_inf_o = 1.1754E+09 - -## fluid properties -# liquid -nl = 2.35E+00 -cv_l = 1816 -rhol = (Pl+Pi_inf_l)/((nl-1)*cv_l*T) -# object -obj_rhol = rhol -cv_o = cv_l -rhoo = 1060 -no = 2.35 -#no = 1.19E+00 -muo = 0.060E+00 -# gas -ng = 1.47E+00 - -# alpha seeding fractions -bub_wl = 1.0E-12 -bub_wo = 1.0E-12 -bub_wg = 1 - bub_wl - bub_wo -liq_wo = 1.0E-12 -liq_wg = 1.0E-12 -liq_wl = 1 - liq_wo - liq_wg -obj_wl = 1.0E-12 -obj_wg = 1.0E-12 -obj_wo = 1 - obj_wl - obj_wg - -Gl = 0. -Gg = 0. -Go = 0.57E+03 #1.0933E+04 - -## mixture values in the liquid -#rhoml = (alpha1-alph_eps)*rhol+alph_eps*rhog -#pi_inf_m = (alpha1-alph_eps)*Pi_inf_l -#nml = (alpha1-alph_eps)*nl+alph_eps*ng -cl = (nl*(Pl+Pi_inf_l)/rhol)**(0.5) -rhoml = liq_wl*rhol + liq_wg*rhog + liq_wo*rhoo - -## Defining Characteristic Values -Rc = Ri -rhoc = rhol -uc = (Pl/rhol)**(0.5E+00) -ucc = (Pl/rhoml)**(0.5E+00) -# characteristic collapse time, change later to prevent horrific confusion -tc = Ri/uc -Pc = rhoc*uc**(2.0E+00) - -## Non-Dimensionalizing values using characteristic values -Rin = Ri/Rc -rholn = rhol/rhoc -rhogn = rhog/rhoc -rhoon = rhoo/rhoc -Pln = Pl/Pc -Pbn = Pb/Pc -Pon = Po/Pc -tcn = tc/tc -Pi_inf_ln = Pi_inf_l/Pc -clc = cl/uc -sod_nd = 2.17 -#clmc = clm/ucc -Pi_inf_on = Pi_inf_o/Pc - -# Un comment if dimensional -#Rin = Ri -#rholn = rhol -#rhogn = rhog -#rhoon = rhoo -#Pln = Pl -#Pbn = Pb/rhoo -#Pon = Po -#tcn = tc -#Pi_inf_ln = Pi_inf_l -#leng = domain_length -#clc = cl -#sod_nd = sod - -## Non-Dimensional Numbers -#Rel = rhol*uc*2*Rin/mulc -#Reb = rhog*uc*2*Rin/mubc -Rel = 0 -Reb = 0 -Reo = rhoo*uc*2/muo -Ma = uc/cl -Co = Pl/Go -iCo = 1/Co - -## GEOMETRY:: Grid Specifications -lengx = 8.0E+00 -lengy = 3.0E+00 -lengz = 3.0E+00 -CFL = 0.3 -PPBR = 16 #92 -x_beg = -5.0E+00 -x_end = 3.0E+00 -y_beg = 0.0E+00 -y_end = lengy -z_beg = 0.0E+00 -z_end = lengz -Nx = PPBR*lengx -Ny = PPBR*lengy -Nz = PPBR*lengz -delta_x = lengx/Nx -delta_t = CFL*delta_x/clc - -#print("NX :: ",Nx,", NY :: ",Ny,", NZ :: ",Nz) - -#delta_t_c = 0.185*delta_x/clmc -#print(delta_t_c) - -Nt = int(1.7*tcn/delta_t) -# liquid centroid, patch 1 -x_centroidl = x_beg/(2.0E+00) -y_centroidl = (y_end+y_beg)/(2.0E+00) -z_centroidl = (z_end+z_beg)/(2.0E+00) -# bubble centroid, patch 2 -x_centroidb = -sod_nd -y_centroidb = 0.0 -z_centroidb = 0.0 -# objective centroid, patch 3 -x_centroido = x_end/2 -y_centroido = (y_end+y_beg)/(2.0E+00) -z_centroido = (z_end+z_beg)/(2.0E+00) - -# Configuring case dictionary -print(json.dumps({ - # Logistics ================================================ - 'run_time_info' : 'T', - 'sim_data' : 'T', - # ========================================================== - - # Computational Domain Parameters ========================== - 'x_domain%beg' : x_beg, - 'x_domain%end' : x_end, - 'y_domain%beg' : y_beg, - 'y_domain%end' : y_end, - 'z_domain%beg' : z_beg, - 'z_domain%end' : z_end, - 'm' : int(Nx), - 'n' : int(Ny), - 'p' : int(Nz), - 'cyl_coord' : 'F', - 'dt' : delta_t, - 't_step_start' : 0, - 't_step_stop' : Nt, - 't_step_save' : int(5),#int(Nt/150), -# ========================================================== - - # Simulation Algorithm Parameters ========================== - 'num_patches' : 3, - 'model_eqns' : 2, - 'hypoelasticity' : 'F', - 'hyperelasticity' : 'T', - 'pre_stress' : 'F', - 'alt_soundspeed' : 'F', - 'num_fluids' : 3, - 'adv_alphan' : 'T', - 'mpp_lim' : 'F', - 'mixture_err' : 'T', - 'time_stepper' : 3, - 'weno_order' : 5, - 'weno_eps' : 1.E-16, - 'mapped_weno' : 'T', - 'null_weights' : 'F', - 'mp_weno' : 'T', - 'weno_Re_flux' : 'F', - 'weno_avg' : 'F', - 'riemann_solver' : 1, - 'wave_speeds' : 1, - 'avg_state' : 2, - 'bc_x%beg' : -6, #-16,#-2 - 'bc_x%end' : -6, - 'bc_y%beg' : -2, - 'bc_y%end' : -6, - 'bc_z%beg' : -2, - 'bc_z%end' : -6, - 'stretch_x' : 'F', - 'stretch_y' : 'F', - 'stretch_z' : 'F', - 'a_x' : 4.0E+00, - 'x_a' : -1.5E+00-sod_nd, - 'x_b' : 2.5E+00, - #'loops_x' : 0, - 'a_y' : 4.0E+00, - 'y_a' : -1.5E+00, - 'y_b' : 1.5E+00, - #'loops_y' : 0, - 'a_z' : 4.0E+00, - 'z_a' : -1.5E+00, - 'z_b' : 1.5E+00, - #'loops_z' : 0, - # ========================================================== - - # Formatted Database Files Structure Parameters ============ - 'format' : 1, - 'precision' : 2, - 'prim_vars_wrt' :'T', - 'parallel_io' :'T', - 'probe_wrt' :'T', - 'fd_order' : 1, - 'num_probes' : 1, - 'probe(1)%x' : 0., - 'probe(1)%y' : 0., - 'probe(1)%z' : 0., - # ========================================================== - - # Patch 1: Background ============================ - 'patch_icpp(1)%geometry' : 9,# for 3D - 'patch_icpp(1)%x_centroid' : x_centroidl, #100*x_centroidl, - 'patch_icpp(1)%y_centroid' : y_centroidl, #100*y_centroidl, - 'patch_icpp(1)%z_centroid' : z_centroidl, #100*z_centroidl, - 'patch_icpp(1)%length_x' : lengx, #200*lengx, - 'patch_icpp(1)%length_y' : lengy, #200*lengy, - 'patch_icpp(1)%length_z' : lengz, #200*lengz, - 'patch_icpp(1)%vel(1)' : 0.E+00, - 'patch_icpp(1)%vel(2)' : 0.E+00, - 'patch_icpp(1)%vel(3)' : 0.E+00, - 'patch_icpp(1)%pres' : Pln, - 'patch_icpp(1)%alpha_rho(1)' : liq_wl*rholn, - 'patch_icpp(1)%alpha_rho(2)' : liq_wg*rhogn, - 'patch_icpp(1)%alpha_rho(3)' : liq_wo*rhoon, - 'patch_icpp(1)%alpha(1)' : liq_wl, - 'patch_icpp(1)%alpha(2)' : liq_wg, - 'patch_icpp(1)%alpha(3)' : liq_wo, - # ========================================================== - # Patch 2: Bubble ====================================== - # Specify the spherical gas bubble grid geometry - 'patch_icpp(2)%geometry' : 8,# for 3D - 'patch_icpp(2)%smoothen' : 'T', - 'patch_icpp(2)%smooth_patch_id' : 1, - 'patch_icpp(2)%smooth_coeff' : 4.0E+00, - 'patch_icpp(2)%x_centroid' : x_centroidb, - 'patch_icpp(2)%y_centroid' : y_centroidb, - 'patch_icpp(2)%z_centroid' : z_centroidb, - 'patch_icpp(2)%radius' : Rin, - 'patch_icpp(2)%alter_patch(1)' : 'T', - # Specify the patch primitive variables - 'patch_icpp(2)%vel(1)' : 0.E+00, - 'patch_icpp(2)%vel(2)' : 0.E+00, - 'patch_icpp(2)%vel(3)' : 0.E+00, - 'patch_icpp(2)%pres' : Pbn, - 'patch_icpp(2)%alpha_rho(1)' : bub_wl*rholn, - 'patch_icpp(2)%alpha_rho(2)' : bub_wg*rhogn, - 'patch_icpp(2)%alpha_rho(3)' : bub_wo*rhoon, - 'patch_icpp(2)%alpha(1)' : bub_wl, - 'patch_icpp(2)%alpha(2)' : bub_wg, - 'patch_icpp(2)%alpha(3)' : bub_wo, - # ========================================================== - # Patch 3: Gel =========================================== - # Specify the gel grid geometry - 'patch_icpp(3)%geometry' : 9,# for 3D - 'patch_icpp(3)%x_centroid' : x_centroido, #100*x_centroido, - 'patch_icpp(3)%y_centroid' : y_centroido, #100*y_centroido, - 'patch_icpp(3)%z_centroid' : z_centroido, #100*z_centroido, - 'patch_icpp(3)%length_x' : 3.0E+00, #100*lengx, - 'patch_icpp(3)%length_y' : lengy, #200*lengy, - 'patch_icpp(3)%length_z' : lengz, #200*lengz, - 'patch_icpp(3)%alter_patch(1)' : 'T', - # Specify the patch primitive variables - 'patch_icpp(3)%vel(1)' : 0.E+00, - 'patch_icpp(3)%vel(2)' : 0.E+00, - 'patch_icpp(3)%vel(3)' : 0.E+00, - 'patch_icpp(3)%pres' : Pon, - 'patch_icpp(3)%alpha_rho(1)' : obj_wl*rholn, - 'patch_icpp(3)%alpha_rho(2)' : obj_wg*rhogn, - 'patch_icpp(3)%alpha_rho(3)' : obj_wo*rhoon, - 'patch_icpp(3)%alpha(1)' : obj_wl, - 'patch_icpp(3)%alpha(2)' : obj_wg, - 'patch_icpp(3)%alpha(3)' : obj_wo, - # ========================================================== - - - # Fluids Physical Parameters =============================== - 'fluid_pp(1)%gamma' : 1./(nl-1.), - 'fluid_pp(1)%pi_inf' : nl*Pi_inf_ln/(nl-1.), - 'fluid_pp(1)%G' : Gl, - 'fluid_pp(2)%gamma' : 1./(ng-1.), - 'fluid_pp(2)%pi_inf' : 0.0E+00, - 'fluid_pp(2)%G' : Gg, - 'fluid_pp(3)%gamma' : 1./(no-1.), - 'fluid_pp(3)%pi_inf' : no*Pi_inf_on/(no-1.), - 'fluid_pp(3)%G' : iCo, - 'fluid_pp(1)%qv' : 0.0E+00, - 'fluid_pp(1)%qvp' : 0.0E+00, - 'fluid_pp(2)%qv' : 0.0E+00, - 'fluid_pp(2)%qvp' : 0.0E+00, - 'fluid_pp(3)%qv' : 0.0E+00, - 'fluid_pp(3)%qvp' : 0.0E+00, -# 'fluid_pp(1)%Re(1)' : Rel, -# 'fluid_pp(2)%Re(1)' : Reb, -# 'fluid_pp(3)%Re(1)' : Reo, - # ===========++============================================= -})) - -# ============================================================================== - - From a8cbfffc18851b6743f304f9e549008abbf14301 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 6 Aug 2024 14:22:06 -0500 Subject: [PATCH 281/380] a few modifications to 3D hyperelasticity module --- src/simulation/m_hyperelastic.fpp | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 9caa8425fc..e65d770679 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -34,7 +34,6 @@ module m_hyperelastic !> @name Abstract subroutine for the infinite relaxation solver !> @{ subroutine s_abstract_hyperelastic_solver(btensor, q_prim_vf, G, j, k, l) - !$acc routine seq import :: scalar_field, sys_size, b_size type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor @@ -79,7 +78,7 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_initialize_hyperelastic_module() + subroutine s_initialize_hyperelastic_module integer :: i !< generic iterator @:ALLOCATE(btensor%vf(1:b_size)) @@ -99,7 +98,7 @@ contains ! utilized to calculate the solution of a given Riemann problem if (hyper_model == 1) then s_compute_cauchy_solver => s_neoHookean_cauchy_solver - elseif (riemann_solver == 2) then + elseif (hyper_model == 2) then s_compute_cauchy_solver => s_Mooney_Rivlin_cauchy_solver end if @@ -148,10 +147,11 @@ contains real(kind(0d0)) :: G_K integer :: j, k, l, i, r - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K,alpha_rho_K,rho_K,gamma_K,pi_inf_K,qv_K,G_K,Re_K, tensora, tensorb) - do l = 0, p - 2 - do k = 0, n - 2 - do j = 2, m - 2 + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, & + !$acc rho_K, gamma_K, pi_inf_K, qv_K, G_K, Re_K, tensora, tensorb) + do l = 0, p + do k = 0, n + do j = 0, m !$acc loop seq do i = 1, num_fluids alpha_rho_K(i) = q_cons_vf(i)%sf(j, k, l) @@ -265,7 +265,7 @@ contains !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) - !$acc routine seq + !!!$acc routine seq type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor real(kind(0d0)), intent(in) :: G @@ -306,7 +306,7 @@ contains !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space subroutine s_Mooney_Rivlin_cauchy_solver(btensor, q_prim_vf, G, j, k, l) - !$acc routine seq + !!!!$acc routine seq type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor real(kind(0d0)), intent(in) :: G From ae75475c15697f26c582c55c1343c5e049b5f1ae Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 6 Aug 2024 14:25:03 -0500 Subject: [PATCH 282/380] removed 3D_CAV simulation --- examples/3D_CAV/3D_CAV_sph_col.py | 205 ------------------------------ 1 file changed, 205 deletions(-) delete mode 100644 examples/3D_CAV/3D_CAV_sph_col.py diff --git a/examples/3D_CAV/3D_CAV_sph_col.py b/examples/3D_CAV/3D_CAV_sph_col.py deleted file mode 100644 index a54df0a5b6..0000000000 --- a/examples/3D_CAV/3D_CAV_sph_col.py +++ /dev/null @@ -1,205 +0,0 @@ -import math -import json - - -## Deine characteristic values for the sim -Ri = 50E-6 -T = 407.9 -rhog = 0.027 -Pb = 3550 -Pl = 101325 -#mulc = 9E-04 -#mubc = 1.0E-05 -domain_length = 3*Ri - - -## fluid properties -Pi_inf_l = 1.0E+09 -Pi_inf_b = 0.0E+00 -nl = 2.35 -nb = 1.47 -alpha1 = 1.0E+00 -Cv_l = 1816 -rhol = (Pl+Pi_inf_l)/((nl-1)*Cv_l*T) -alpha2 = alpha1 -cl = (nl*(Pl+Pi_inf_l)/rhol)**(0.5) - -## Defining Characteristic Values -Rc = Ri -rhoc = rhol -uc = (Pl/rhol)**(0.5E+00) -tc = Ri/uc -Pc = rhoc*uc**(2.0E+00) - -## Non-Dimensionalizing values using characteristic values -Rin = Ri/Rc -rholn = rhol/rhoc -rhogn = rhog/rhoc -Pln = Pl/Pc -Pbn = Pb/Pc -tcn = tc/tc -Pi_inf_ln = Pi_inf_l/Pc -leng = domain_length/Rc -clc = cl/uc - - -## Non-Dimensional Numbers -#Rel = rhol*uc*2*Rin/mulc -#Reb = rhog*uc*2*Rin/mubc -Ma = uc/cl - -## Grid Specifications -CFL = 0.1 -PpBr = 192 -Nx = PpBr*leng -Ny = Nx -Nz = Nx -x_beg = 0.0E+00 -x_end = leng -y_beg = 0.0E+00 -y_end = leng -z_beg = 0.0E+00 -z_end = leng -delta_x = leng/Nx -delta_t = CFL*delta_x/clc -Nt = int(1.1*tcn/delta_t) -x_centroidl = (x_end+x_beg)/(2.0E+00) -y_centroidl = (y_end+y_beg)/(2.0E+00) -z_centroidl = (z_end+z_beg)/(2.0E+00) -x_centroidb = 0.0E+00 -y_centroidb = 0.0E+00 -z_centroidb = 0.0E+00 - - -# Configuring case dictionary -print(json.dumps({ - # Logistics ================================================ - 'run_time_info' : 'T', - 'sim_data' : 'T', - # ========================================================== - - # Computational Domain Parameters ========================== - 'x_domain%beg' : x_beg, - 'x_domain%end' : x_end, - 'y_domain%beg' : y_beg, - 'y_domain%end' : y_end, - 'z_domain%beg' : z_beg, - 'z_domain%end' : z_end, - 'm' : int(Nx), - 'n' : int(Ny), - 'p' : int(Nz), - 'cyl_coord' : 'F', - 'dt' : delta_t, - 't_step_start' : 0, - 't_step_stop' : Nt, - 't_step_save' : int(Nt/360), -# ========================================================== - - # Simulation Algorithm Parameters ========================== - 'num_patches' : 2, - 'model_eqns' : 2, - 'alt_soundspeed' : 'F', - 'num_fluids' : 2, - 'adv_alphan' : 'T', - 'mpp_lim' : 'T', - 'mixture_err' : 'T', - 'time_stepper' : 3, - 'weno_order' : 5, - 'weno_eps' : 1.E-100, - 'mapped_weno' : 'T', - 'null_weights' : 'F', - 'mp_weno' : 'F', - 'weno_Re_flux' : 'F', - 'weno_avg' : 'F', - 'riemann_solver' : 2, - 'wave_speeds' : 1, - 'avg_state' : 2, - 'bc_x%beg' : -2, - 'bc_x%end' : -6, - 'bc_y%beg' : -2, - 'bc_y%end' : -6, - 'bc_z%beg' : -2, - 'bc_z%end' : -6, - 'stretch_x' : 'T', - 'stretch_y' : 'T', - 'stretch_z' : 'T', - 'a_x' : 4.0E+00, - 'x_a' : -1.5E+00, - 'x_b' : 1.5E+00, - 'a_y' : 4.0E+00, - 'y_a' : -1.5E+00, - 'y_b' : 1.5E+00, - 'a_z' : 4.0E+00, - 'z_a' : -1.5E+00, - 'z_b' : 1.5E+00, - # ========================================================== - - # Formatted Database Files Structure Parameters ============ - 'format' : 1, - 'precision' : 2, - 'prim_vars_wrt' :'T', - 'parallel_io' :'T', - 'fd_order' :'1', - 'probe_wrt' :'T', - 'num_probes' : 1, - 'probe(1)%x' : 0., - 'probe(1)%y' : 0., - 'probe(1)%z' : 0., - # ========================================================== - - # Patch 1: Background ============================ - 'patch_icpp(1)%geometry' : 9, - 'patch_icpp(1)%x_centroid' : 40*x_centroidl, - 'patch_icpp(1)%y_centroid' : 40*y_centroidl, - 'patch_icpp(1)%z_centroid' : 40*z_centroidl, - 'patch_icpp(1)%length_x' : 40*leng, - 'patch_icpp(1)%length_y' : 40*leng, - 'patch_icpp(1)%length_z' : 40*leng, - 'patch_icpp(1)%vel(1)' : 0.E+00, - 'patch_icpp(1)%vel(2)' : 0.E+00, - 'patch_icpp(1)%vel(3)' : 0.E+00, - 'patch_icpp(1)%pres' : Pln, - 'patch_icpp(1)%alpha_rho(1)' : alpha1*rholn, - 'patch_icpp(1)%alpha_rho(2)' : 0.0E+00, - 'patch_icpp(1)%alpha(1)' : alpha1, - 'patch_icpp(1)%alpha(2)' : 0.0E+00, - # ========================================================== - # Patch 2: Bubble ====================================== - 'patch_icpp(2)%geometry' : 14, - 'patch_icpp(2)%x_centroid' : x_centroidb, - 'patch_icpp(2)%y_centroid' : y_centroidb, - 'patch_icpp(2)%z_centroid' : z_centroidb, - 'patch_icpp(2)%radius' : Rin, - 'patch_icpp(2)%smoothen' : 'T', - 'patch_icpp(2)%smooth_patch_id': 1, - 'patch_icpp(2)%smooth_coeff' : 1.5E+00, - 'patch_icpp(2)%non_axis_sym' : 'F', - 'patch_icpp(2)%a2' : 0.0E+00, - 'patch_icpp(2)%a3' : 0.0E+00, - 'patch_icpp(2)%a4' : 0.0E+00, - 'patch_icpp(2)%a5' : 0.0E+00, - 'patch_icpp(2)%a6' : 0.0E+00, - 'patch_icpp(2)%a7' : 0.0E+00, - 'patch_icpp(2)%alter_patch(1)' : 'T', - 'patch_icpp(2)%vel(1)' : 0.E+00, - 'patch_icpp(2)%vel(2)' : 0.E+00, - 'patch_icpp(2)%vel(3)' : 0.E+00, - 'patch_icpp(2)%pres' : Pbn, - 'patch_icpp(2)%alpha_rho(1)' : 0.0E+00, - 'patch_icpp(2)%alpha_rho(2)' : alpha2*rhogn, - 'patch_icpp(2)%alpha(1)' : 0.0E+00, - 'patch_icpp(2)%alpha(2)' : alpha2, - # ========================================================== - - # Fluids Physical Parameters =============================== - 'fluid_pp(1)%gamma' : 1/(nl-1), - 'fluid_pp(1)%pi_inf' : nl*Pi_inf_ln/(nl-1), - 'fluid_pp(2)%gamma' : 1/(nb-1), - 'fluid_pp(2)%pi_inf' : 0.0E+00, -# 'fluid_pp(1)%Re(1)' : Rel, -# 'fluid_pp(2)%Re(1)' : Reb, - # ========================================================== -})) - -# ============================================================================== - From 64424f1bb2034808296e7fc7ae24e2a9267f9550 Mon Sep 17 00:00:00 2001 From: Nazarii Koval Date: Tue, 6 Aug 2024 14:25:24 -0500 Subject: [PATCH 283/380] 3d lung case file added --- examples/3D_lungwave/case.py | 222 +++++++++++++++++++++++++++++++++++ submit_gpu_lung.sh | 6 + 2 files changed, 228 insertions(+) create mode 100644 examples/3D_lungwave/case.py create mode 100755 submit_gpu_lung.sh diff --git a/examples/3D_lungwave/case.py b/examples/3D_lungwave/case.py new file mode 100644 index 0000000000..b5ff53dc5d --- /dev/null +++ b/examples/3D_lungwave/case.py @@ -0,0 +1,222 @@ +#!/usr/bin/env python3 + +import math +import json + +pi = 3.141592653589 +# material parameters + +#material1 :: gas +#patterson 2018 + +gammag = 1.4 #unitless +Bg =0 #pascals +rhog = 1.18 #kg/m^3 +c_g = 347.2 #m/s +G_g = 0 #pa + +#material2 :: water +gammal = 5.5 +Bl = 492.E+06 +rhol = 996.0 +c_l = 1648.7 +G_l = 1E3 + + +#primitive vartiables +patmos = 101325. #pa + +#problem specific variable +lambda_wave = 200.E-6 + +#define pulse +P_amp = 10.E+6 +P_len = 45 #length of the impulse +theta = -math.pi/2 #direction of propagation + +#non-dim + +#define characteristic density, length, time, stress material #make it liquid +rho_char = rhol +length_char = lambda_wave +c_char = c_l #should be liquid +time_char = length_char/c_char +stress_char = rho_char*c_char*c_char/gammal + +#non-dim the properties +rhog_n = rhog/rho_char +c_g_n = c_g/c_char +rhol_n = rhol/rho_char +c_l_n = c_l/c_char +Bg_n = Bg/stress_char +Bl_n = Bl/stress_char +G_g_n = G_g/stress_char +G_l_n = G_l/stress_char +patmos_n = patmos/stress_char +P_amp_n = P_amp/stress_char + +#geometry +dlengx = 20. +dlengy = 1. +dlengz = 1. +Ny = 100 +Nx = dlengx*Ny +Nz = dlengz*Ny +dx = dlengx/Nx +dy = dlengy/Ny +dz = dlengz/Nz +alphal_back = 1.0 +alphag_back = 0.0 +alphal_lung = 0.0 +alphag_lung = 1.0 + +interface_amp = 0.03 + +# time stepping requirements +time_end = 500 +cfl = 0.2 + +dt = cfl * dx/c_l_n +Nt = int(time_end/dt) +Nframes = 500 +tstart = 0 +tstop = Nt +tsave = int(Nt/Nframes) + +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================================ + 'run_time_info' : 'T', + #'sim_data' : 'T', + # ========================================================================== + + # Computational Domain Parameters ========================================== + 'x_domain%beg' : -dlengx/2., + 'x_domain%end' : dlengx/2., + 'y_domain%beg' : 0., + 'y_domain%end' : dlengy, + 'z_domain%beg' : 0., + 'z_domain%end' : dlengz, + 'm' : int(Nx), + 'n' : int(Ny), + 'p' : int(Nz), + 'stretch_x' : 'T', + 'a_x' : 4.0E+00, + 'x_a' : -5., + 'x_b' : 5., + 'loops_x' : 4, + 'dt' : dt, + 't_step_start' : tstart, + 't_step_stop' : tstop, + 't_step_save' : tsave, + # ========================================================================== + + # Simulation Algorithm Parameters ========================================== + 'num_patches' : 2, + 'model_eqns' : 3, + 'alt_soundspeed' : 'F', + 'num_fluids' : 2, + #'adv_alphan' : 'T', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'time_stepper' : 3, + 'weno_order' : 5, + 'weno_eps' : 1.E-16, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'T', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -6, + 'bc_x%end' : -6, + 'bc_y%beg' : -1, + 'bc_y%end' : -1, + 'bc_z%beg' : -1, + 'bc_z%end' : -1, + # ========================================================================== + + # Turning on Hypoelasticity ================================================ + #'hypoelasticity' : 'T', + 'hyperelasticity' : 'T', + # ========================================================================== + + # Formatted Database Files Structure Parameters ============================ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'T', + # ========================================================================== + + # acoustics setting ========================================================= + 'acoustic_source' : 'T', + 'num_source' : 1, + 'acoustic(1)%support' : 3, + 'acoustic(1)%loc(1)' : 4, + 'acoustic(1)%loc(2)' : dlengy/2, + #'acoustic(1)%loc(3)' : dlengz/2, + 'acoustic(1)%pulse' : 3, + 'acoustic(1)%npulse' : 1, + 'acoustic(1)%wavelength' : P_len, #wavelength of the signal + 'acoustic(1)%mag' : P_amp_n, + 'acoustic(1)%length' : dlengy, #length of the place ??? + 'acoustic(1)%height' : dlengz, + 'acoustic(1)%dir' : -math.pi, + #=========================================================================== + + # Patch 1: Background ====================================================== + 'patch_icpp(1)%geometry' : 9, + 'patch_icpp(1)%x_centroid' : 0., + 'patch_icpp(1)%y_centroid' : dlengy/2., + 'patch_icpp(1)%z_centroid' : dlengz/2., + 'patch_icpp(1)%length_x' : 2000, #dlengx, # + 'patch_icpp(1)%length_y' : dlengy, + 'patch_icpp(1)%length_z' : dlengz, + 'patch_icpp(1)%vel(1)' : 0.E+00, + 'patch_icpp(1)%vel(2)' : 0.E+00, + 'patch_icpp(1)%vel(3)' : 0.E+00, + 'patch_icpp(1)%pres' : patmos_n, + 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, + 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, + 'patch_icpp(1)%alpha(1)' : alphal_back, + 'patch_icpp(1)%alpha(2)' : alphag_back, + #'patch_icpp(1)%tau_e(1)' : 0.0, + + # ========================================================================== + + # Patch 2: Lung ============================================================ + 'patch_icpp(2)%geometry' : 13, + 'patch_icpp(2)%hcid' : 301, + #'patch_icpp(2)%geometry' : 9, + 'patch_icpp(2)%alter_patch(1)' : 'T', + 'patch_icpp(2)%x_centroid' : -998,#-dlengx/4., # + 'patch_icpp(2)%y_centroid' : dlengy/2., + 'patch_icpp(2)%z_centroid' : dlengz/2., + 'patch_icpp(2)%length_x' : 2000,#dlengx,#dlengx/2.+2, # + 'patch_icpp(2)%length_y' : dlengy, + 'patch_icpp(2)%length_z' : dlengz, + 'patch_icpp(2)%a2' : interface_amp, + 'patch_icpp(2)%vel(1)' : 0.E+00, + 'patch_icpp(2)%vel(2)' : 0.0, + 'patch_icpp(2)%vel(3)' : 0.0, + 'patch_icpp(2)%pres' : patmos_n, + 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, + 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, + 'patch_icpp(2)%alpha(1)' : alphal_lung, + 'patch_icpp(2)%alpha(2)' : alphag_lung, + #'patch_icpp(2)%tau_e(1)' : 0.0, + # ========================================================================== + + # Fluids Physical Parameters =============================================== + 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), + 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), + 'fluid_pp(1)%G' : G_l_n, + 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), + 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), + 'fluid_pp(2)%G' : G_g_n, + #============================================================================== +})) + +# ============================================================================== diff --git a/submit_gpu_lung.sh b/submit_gpu_lung.sh new file mode 100755 index 0000000000..b7902da8db --- /dev/null +++ b/submit_gpu_lung.sh @@ -0,0 +1,6 @@ +#!/bin/bash + +./mfc.sh run ./examples/2D_lungwave_horizontal/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +./mfc.sh run ./examples/2D_lungwave_horizontal/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta + From 38540b65de113804968e804eff6bd2ef1bf19014 Mon Sep 17 00:00:00 2001 From: Avery Trevino Date: Tue, 6 Aug 2024 14:55:25 -0500 Subject: [PATCH 284/380] Adding 3d_bubble_channel --- run_mfc.sh | 14 -------------- 1 file changed, 14 deletions(-) delete mode 100755 run_mfc.sh diff --git a/run_mfc.sh b/run_mfc.sh deleted file mode 100755 index fc734beaea..0000000000 --- a/run_mfc.sh +++ /dev/null @@ -1,14 +0,0 @@ -#!/bin/bash - -./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar - -./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar - -./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e interactive -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar - From 31520ec5498a35e88e02085598e56da1ce66d286 Mon Sep 17 00:00:00 2001 From: Avery Trevino Date: Tue, 6 Aug 2024 15:29:43 -0500 Subject: [PATCH 285/380] adding 3D_bubble_channel --- examples/3D_bubble_channel/case.py | 381 +++++++++++++++++++++++++++++ 1 file changed, 381 insertions(+) create mode 100755 examples/3D_bubble_channel/case.py diff --git a/examples/3D_bubble_channel/case.py b/examples/3D_bubble_channel/case.py new file mode 100755 index 0000000000..c7461aa225 --- /dev/null +++ b/examples/3D_bubble_channel/case.py @@ -0,0 +1,381 @@ +#!/usr/bin/env python3 +import math, json + +## 1 FOR BACKGROUND, 2 FOR BUBBLE, 3 FOR GEL +# Pressure [Pa] +p01 = 5E6 +p02 = 3550 +p03 = p01 + +# Temperature [K] +T01 = 298.15 +T02 = 298.15 +T03 = T01 + +#### FLUID PROPERTIES #### + +### liquid water ### +# pi infty +piwl = 1.0E+09 +# qv +qvwl = -1167000 +# qv' +qvpwl = 0.0E0 +# cv +cvwl = 1816 +# cp +cpwl = 4267 +# gamma +gamwl = cpwl / cvwl + +## FOR PATCHES 1 & 2 ## + +# density +rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) +rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) +rho0wl3 = (p03 + piwl)/((gamwl-1)*cvwl*T03) + +# speed of sound FOR +c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) +c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) +c_wl3 = math.sqrt( gamwl * ( p03 + piwl ) / rho0wl3 ) + +# part for Gases - relations from IMR +Ru = 8.3144598 # Universal gas constant (J/mol-K) + +### Vapor water ### +Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) +# gamma +gamwv = 1.4 +# cp +cpwv = Rv * gamwv/(gamwv-1) +# cv +cvwv = cpwv/gamwv +# pi infinity +piwv = 0.0E0 +# qv +qvwv = 2030000 +# qv' +qvpwv = -23400 + +## FOR PATCHES 1 & 2 ## + +# density +rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) +rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) +rho0wv3 = (p03 + piwv)/((gamwv-1)*cvwv*T03) + +# speed of sound +c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) +c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) +c_wv3 = math.sqrt( gamwv * ( p03 + piwv ) / rho0wv3 ) + +### Air ### + +Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) +gamwa = 1.4 +# cp +cpa = Ra * gamwa/(gamwa-1) +# cv +cva = cpa/gamwa +# pi infinity +pia = 0.0E0 +# qv +qvwa = 0.0E0 +# qv' +qvpwa = 0.0E0 + +## FOR PATCHES 1 & 2 ## + +# density +rho0wa1 = (p01 + pia)/((gamwa-1)*cva*T01) +rho0wa2 = (p02 + pia)/((gamwa-1)*cva*T02) +rho0wa3 = (p03 + pia)/((gamwa-1)*cva*T03) + +# Speed of sound +c_a1 = math.sqrt( gamwa * ( p01 + pia ) / rho0wa1 ) +c_a2 = math.sqrt( gamwa * ( p02 + pia ) / rho0wa2 ) +c_a3 = math.sqrt( gamwa * ( p03 + pia ) / rho0wa3 ) + +### 3% polyacrylamide gel ### + +# gamma +gamwg = gamwl #2.35 +# pi infty +pig = piwl #1.1754E+09 +# qv +qvwg = qvwl #0.0E0 +# qv' +qvpwg = qvpwl #0.0E0 +# cv +cvg = cvwl +# cp +cpg = gamwg*cvg + +## FOR PATCHES 1 & 2 & 3 ## + +# density +rho0wg1 = (p01 + pig)/((gamwg-1)*cvg*T01) +rho0wg2 = (p02 + pig)/((gamwg-1)*cvg*T02) +rho0wg3 = (p03 + pig)/((gamwg-1)*cvg*T03) + +# Speed of sound +c_g1 = math.sqrt( gamwg * ( p01 + pig ) / rho0wg1 ) +c_g2 = math.sqrt( gamwg * ( p02 + pig ) / rho0wg2 ) +c_g3 = math.sqrt( gamwg * ( p03 + pig ) / rho0wg3 ) + +## SHOCK RELATIONS +p02Op01 = p02 / p01 + +# Mach number of the shocked region - this should agree with Min, if everything is correct +Ms = math.sqrt( ( gamwa + 1. ) / ( 2. * gamwa ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) + +# shock speed +ss = Ms * c_a1 + +### volume fractions for each of the patches ### +C0 = 0.25 # vapor concentration for IMR + +# patch 1: liquid water +liq_wg = 0 +liq_wa = 1.00E-15 +liq_wv = 1.00E-15 +liq_wl = 1.00E00 - liq_wv - liq_wa - liq_wg +# water vapor +vap_wl = 1.00E-15 +vap_wv = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0wa2 + 1 ) +vap_wa = 1.00E-15 +vap_wg = 0 +vap_tot = vap_wl + vap_wv + vap_wa + vap_wg +# air +air_wl = 1.00E-15 +air_wv = vap_tot +air_wg = 0 +air_wa = 1.00E00 - air_wl - air_wv - air_wg +# bubble +bub_wl = 1E-15 +bub_wv = vap_tot +bub_wg = 0 +bub_wa = 1 - bub_wl - bub_wv - bub_wg +# gel +gel_wl = 0 +gel_wv = 0 +gel_wa = 0 +gel_wg = 1.00E00 - gel_wl - gel_wv - gel_wa + +## Elasticity +Gl = 0 +Gv = 0 +Ga = 0 +Gg = 0.57E+03 + +## SIMULATION PARAMETERS + +# CFL +cfl = 0.30 + +# Bubble Initial Radius +R0 = 50E-06 + +# number of elements +Nx = 249 #404 #249 +Ny = 124 #179 #124 +Nz = 124 #179 #124 +Nx0 = Nx + +# domain boundaries +lref = 2*R0 +xb = - lref +xe = lref + +yb = 0.00 +ye = 2*lref + +zb = 0.00 +ze = 2*lref + +lenx = ( xe - xb ) +leny = ( ye - yb ) +lenz = ( ze - zb ) + +xcenl = 0. +ycenl = leny/2. +zcenl = lenz/2. + +#xdist = 6.51E-10 #2.17E-5 +#sod = xdist/R0 +sod = 1.5 +xcenb = sod*R0 #neg for bub in liq; pos bub in gel +ycenb = 0.00 +zcenb = 0.00 + +xceng = xe / 2. +yceng = ycenl +zceng = zcenl + +# typical cell size +dx = ( xe - xb ) / Nx +dy = ( ye - yb ) / Ny +dz = ( ze - zb ) / Nz +#print(dx) +PPBR_x = R0 / dx +PPBR_y = R0 / dy +PPBR_z = R0 / dz +#print(PPBR_x) +#print(PPBR_y) + +# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) +SF = 100 + +# Critical time-step +tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) + +# making Nt divisible by SF +# tendA = 1.5 * tc +tend = 1.2 * tc + +# 1 - ensure NtA is sufficient to go a little beyond tendA +# NtA = int( tendA // dt + 1 ) + +# Array of saves. it is the same as Nt/Sf = t_step_save +# AS = int( NtA // SF + 1 ) + +# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) +# Nt = AS * SF +#Nt = int(2.5E3 * tend // tc * Nx / Nx0 + 1) +Nt = int(2.0E3 * tend // tc * Nx / Nx0 + 1) +#print(Nt) +dt = tend / Nt + +AS = int( Nt//SF ) +tstart = 0#2184 +# Total physical time +# tend = Nt * dt + +# Configuring case dictionary ================================================== +print(json.dumps({ + # Logistics ================================================ + 'run_time_info': 'T', + # ========================================================== + # Computational Domain Parameters ========================== + 'x_domain%beg' : xb, + 'x_domain%end' : xe, + 'y_domain%beg' : yb, + 'y_domain%end' : ye, + 'z_domain%beg' : zb, + 'z_domain%end' : ze, + 'stretch_x' : 'F', + 'loops_x' : 1, + 'a_x' : 4.0E0, + 'x_a' : -1.75*R0*(abs(sod)+1), + 'x_b' : 5*R0, + 'stretch_y' : 'T', + 'loops_y' : 2, + 'a_y' : 4.0E0, + 'y_a' : -2*R0*abs(sod), + 'y_b' : 2*R0*abs(sod), + 'stretch_z' : 'T', + 'loops_z' : 2, + 'a_z' : 4.0E0, + 'z_a' : -2*R0*abs(sod), + 'z_b' : 2*R0*abs(sod), + 'cyl_coord' : 'F', + 'm' : Nx, + 'n' : Ny, + 'p' : Nz, + 'dt' : dt, + 't_step_start' : tstart, + 't_step_stop' : Nt, + 't_step_save' : AS, + # ========================================================== + # Simulation Algorithm Parameters ========================== + 'num_patches' : 2, + 'model_eqns' : 3, + 'num_fluids' : 2, + 'hypoelasticity' : 'F', + 'hyperelasticity' : 'F', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'relax' : 'T', + 'relax_model' : 6, + 'palpha_eps' : 1.0E-6, + 'ptgalpha_eps' : 1.0E-2, + 'time_stepper' : 3, + 'weno_order' : 3, + 'weno_eps' : 1.0E-16, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'F', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -16, #-2, + 'bc_x%end' : -16, + 'bc_y%beg' : -2, + 'bc_y%end' : -6, + 'bc_z%beg' : -2, + 'bc_z%end' : -6, + # ========================================================== + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt':'T', + 'parallel_io' :'T', + 'probe_wrt' :'T', + 'fd_order' : 1, + 'num_probes' : 1, + 'probe(1)%x' : 0., + 'probe(1)%y' : 0., + 'probe(1)%z' : 0., + # ========================================================== + # Patch 1: High pressured water ============================ + # Specify the cubic water background grid geometry + 'patch_icpp(1)%geometry' : 9, + 'patch_icpp(1)%x_centroid' : 20*xcenl, + 'patch_icpp(1)%y_centroid' : 20*ycenl, + 'patch_icpp(1)%z_centroid' : 20*zcenl, + 'patch_icpp(1)%length_x' : 20*lenx, + 'patch_icpp(1)%length_y' : 20*leny, + 'patch_icpp(1)%length_z' : 20*lenz, + 'patch_icpp(1)%vel(1)' : 0.0E+00, + 'patch_icpp(1)%vel(2)' : 0.0E+00, + 'patch_icpp(1)%vel(3)' : 0.0E+00, + 'patch_icpp(1)%pres' : p01, + 'patch_icpp(1)%alpha_rho(1)' : liq_wl * rho0wl1, + 'patch_icpp(1)%alpha_rho(2)' : liq_wv * rho0wv1, + 'patch_icpp(1)%alpha(1)' : liq_wl, + 'patch_icpp(1)%alpha(2)' : liq_wv, + # ========================================================== + # Patch 2: (Vapor) Bubble ================================== + 'patch_icpp(2)%geometry' : 8, + 'patch_icpp(2)%x_centroid' : xcenb, + 'patch_icpp(2)%y_centroid' : ycenb, + 'patch_icpp(2)%z_centroid' : zcenb, + 'patch_icpp(2)%radius' : R0, + 'patch_icpp(2)%vel(1)' : 0.0E+00, + 'patch_icpp(2)%vel(2)' : 0.0E+00, + 'patch_icpp(2)%vel(3)' : 0.0E+00, + 'patch_icpp(2)%pres' : p02, + 'patch_icpp(2)%alpha_rho(1)' : bub_wl*rho0wl2, + 'patch_icpp(2)%alpha_rho(2)' : bub_wv*rho0wv2, + 'patch_icpp(2)%alpha(1)' : bub_wl, + 'patch_icpp(2)%alpha(2)' : bub_wv, + 'patch_icpp(2)%alter_patch(1)' : 'T', + # ========================================================== + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), + 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), + 'fluid_pp(1)%cv' : cvwl, + 'fluid_pp(1)%qv' : qvwl, + 'fluid_pp(1)%qvp' : qvpwl, + 'fluid_pp(1)%G' : Gl, + 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), + 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), + 'fluid_pp(2)%cv' : cvwv, + 'fluid_pp(2)%qv' : qvwv, + 'fluid_pp(2)%qvp' : qvpwv, + 'fluid_pp(2)%G' : Gv, + # ========================================================== +})) From 2a4388aaa5485c0ed49de36d53156f8615f20496 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 6 Aug 2024 15:55:24 -0500 Subject: [PATCH 286/380] resolved a few issues for the lung wave problem --- examples/3D_lungwave/case.py | 19 +++-- src/simulation/m_checker.fpp | 10 +-- src/simulation/m_hyperelastic.fpp | 118 +++++++++++++++--------------- submit_gpu_lung.sh | 6 +- 4 files changed, 76 insertions(+), 77 deletions(-) diff --git a/examples/3D_lungwave/case.py b/examples/3D_lungwave/case.py index b5ff53dc5d..1872639732 100644 --- a/examples/3D_lungwave/case.py +++ b/examples/3D_lungwave/case.py @@ -20,7 +20,7 @@ Bl = 492.E+06 rhol = 996.0 c_l = 1648.7 -G_l = 1E3 +G_l = 1E+06 #primitive vartiables @@ -56,10 +56,10 @@ P_amp_n = P_amp/stress_char #geometry -dlengx = 20. +dlengx = 15. dlengy = 1. dlengz = 1. -Ny = 100 +Ny = 25 Nx = dlengx*Ny Nz = dlengz*Ny dx = dlengx/Nx @@ -73,8 +73,8 @@ interface_amp = 0.03 # time stepping requirements -time_end = 500 -cfl = 0.2 +time_end = 50 +cfl = 0.01 dt = cfl * dx/c_l_n Nt = int(time_end/dt) @@ -100,11 +100,11 @@ 'm' : int(Nx), 'n' : int(Ny), 'p' : int(Nz), - 'stretch_x' : 'T', + 'stretch_x' : 'F', 'a_x' : 4.0E+00, 'x_a' : -5., 'x_b' : 5., - 'loops_x' : 4, + 'loops_x' : 0, 'dt' : dt, 't_step_start' : tstart, 't_step_stop' : tstop, @@ -139,8 +139,8 @@ # ========================================================================== # Turning on Hypoelasticity ================================================ - #'hypoelasticity' : 'T', - 'hyperelasticity' : 'T', + 'hypoelasticity' : 'T', + #'hyperelasticity' : 'T', # ========================================================================== # Formatted Database Files Structure Parameters ============================ @@ -206,7 +206,6 @@ 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, 'patch_icpp(2)%alpha(1)' : alphal_lung, 'patch_icpp(2)%alpha(2)' : alphag_lung, - #'patch_icpp(2)%tau_e(1)' : 0.0, # ========================================================================== # Fluids Physical Parameters =============================================== diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index 84fcbbaa45..4c339e2c3a 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -369,11 +369,11 @@ contains !> Checks constraints on hypoelasticity parameters subroutine s_check_inputs_hypoelasticity - if (riemann_solver /= 1) then - call s_mpi_abort('hypoelasticity requires HLL '// & - '(riemann_solver = 1) Riemann solver. '// & - 'Exiting ...') - end if + !if (riemann_solver /= 1) then + ! call s_mpi_abort('hypoelasticity requires HLL '// & + ! '(riemann_solver = 1) Riemann solver. '// & + ! 'Exiting ...') + !end if end subroutine s_check_inputs_hypoelasticity !> Checks constraints on hyperelasticity parameters diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index e65d770679..f16ad21a2e 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -70,63 +70,6 @@ module m_hyperelastic contains - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_initialize_hyperelastic_module - integer :: i !< generic iterator - - @:ALLOCATE(btensor%vf(1:b_size)) - do i = 1, b_size - @:ALLOCATE(btensor%vf(i)%sf(0:m, 0:n, 0:p)) - end do - @:ACC_SETUP_VFs(btensor) - - @:ALLOCATE(Gs(1:num_fluids)) - !$acc loop seq - do i = 1, num_fluids - Gs(i) = fluid_pp(i)%G - end do - !$acc update device(Gs) - - ! Associating procedural pointer to the subroutine that will be - ! utilized to calculate the solution of a given Riemann problem - if (hyper_model == 1) then - s_compute_cauchy_solver => s_neoHookean_cauchy_solver - elseif (hyper_model == 2) then - s_compute_cauchy_solver => s_Mooney_Rivlin_cauchy_solver - end if - - @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) - if (n > 0) then - @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) - end if - if (p > 0) then - @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) - end if - - ! Computing centered finite difference coefficients - call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & - fd_number, fd_order) - !$acc update device(fd_coeff_x) - if (n > 0) then - call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & - fd_number, fd_order) - !$acc update device(fd_coeff_y) - end if - if (p > 0) then - call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & - fd_number, fd_order) - !$acc update device(fd_coeff_z) - end if - - end subroutine s_initialize_hyperelastic_module - !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. !! @param q_prim_vf Primitive variables @@ -163,7 +106,7 @@ contains rho_K = max(rho_K, sgm_eps) if (G_K <= verysmall) G_K = 0d0 - if (G_K > 20d0) then + if (G_K > 1.0d-03) then !$acc loop seq do i = 1, tensor_size tensora(i) = 0d0 @@ -238,7 +181,7 @@ contains ! store the determinant at the last entry of the btensor btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) ! STEP 5a: updating the Cauchy stress primitive scalar field - call s_compute_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) + call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) ! STEP 5b: updating the pressure field q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & G_K*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma_K @@ -338,6 +281,63 @@ contains end subroutine s_Mooney_Rivlin_cauchy_solver + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_initialize_hyperelastic_module + integer :: i !< generic iterator + + @:ALLOCATE(btensor%vf(1:b_size)) + do i = 1, b_size + @:ALLOCATE(btensor%vf(i)%sf(0:m, 0:n, 0:p)) + end do + @:ACC_SETUP_VFs(btensor) + + @:ALLOCATE(Gs(1:num_fluids)) + !$acc loop seq + do i = 1, num_fluids + Gs(i) = fluid_pp(i)%G + end do + !$acc update device(Gs) + + ! Associating procedural pointer to the subroutine that will be + ! utilized to calculate the solution of a given Riemann problem + if (hyper_model == 1) then + s_compute_cauchy_solver => s_neoHookean_cauchy_solver + elseif (hyper_model == 2) then + s_compute_cauchy_solver => s_Mooney_Rivlin_cauchy_solver + end if + + @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) + if (n > 0) then + @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) + end if + if (p > 0) then + @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) + end if + + ! Computing centered finite difference coefficients + call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & + fd_number, fd_order) + !$acc update device(fd_coeff_x) + if (n > 0) then + call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & + fd_number, fd_order) + !$acc update device(fd_coeff_y) + end if + if (p > 0) then + call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & + fd_number, fd_order) + !$acc update device(fd_coeff_z) + end if + + end subroutine s_initialize_hyperelastic_module + subroutine s_finalize_hyperelastic_module() integer :: i !< iterator diff --git a/submit_gpu_lung.sh b/submit_gpu_lung.sh index b7902da8db..b93ebaf913 100755 --- a/submit_gpu_lung.sh +++ b/submit_gpu_lung.sh @@ -1,6 +1,6 @@ #!/bin/bash -./mfc.sh run ./examples/2D_lungwave_horizontal/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -./mfc.sh run ./examples/2D_lungwave_horizontal/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta From 02adf9e0dcdf0e92b2e1f9be5d01836cf53f12af Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 6 Aug 2024 15:59:13 -0500 Subject: [PATCH 287/380] added some files --- examples/3D_bubble_channel/case.py | 8 ++++---- src/simulation/m_global_parameters.fpp | 4 ++-- submit_gpu.sh | 5 +++-- 3 files changed, 9 insertions(+), 8 deletions(-) diff --git a/examples/3D_bubble_channel/case.py b/examples/3D_bubble_channel/case.py index c7461aa225..b3d00da0f9 100755 --- a/examples/3D_bubble_channel/case.py +++ b/examples/3D_bubble_channel/case.py @@ -296,10 +296,10 @@ 'hyperelasticity' : 'F', 'mpp_lim' : 'T', 'mixture_err' : 'T', - 'relax' : 'T', - 'relax_model' : 6, - 'palpha_eps' : 1.0E-6, - 'ptgalpha_eps' : 1.0E-2, + #'relax' : 'T', + #'relax_model' : 6, + #'palpha_eps' : 1.0E-6, + #'ptgalpha_eps' : 1.0E-2, 'time_stepper' : 3, 'weno_order' : 3, 'weno_eps' : 1.0E-16, diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index dd22c0b252..9ee981d8b7 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -169,7 +169,7 @@ module m_global_parameters !$acc declare create(num_dims, weno_polyn, weno_order, num_fluids, wenojs, mapped_weno, wenoz, teno) #:endif - !$acc declare create(mpp_lim, model_eqns, mixture_err, alt_soundspeed, avg_state, mp_weno, weno_eps, teno_CT, hypoelasticity, hyperelasticity, elasticity, low_Mach) + !$acc declare create(mpp_lim, model_eqns, mixture_err, alt_soundspeed, avg_state, mp_weno, weno_eps, teno_CT, hypoelasticity, hyperelasticity, hyper_model, elasticity, low_Mach) logical :: relax !< activate phase change integer :: relax_model !< Relaxation model @@ -1107,7 +1107,7 @@ contains !$acc update device(m, n, p) !$acc update device(alt_soundspeed, acoustic_source, num_source) - !$acc update device(dt, sys_size, buff_size, pref, rhoref, gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim, bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids, model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord, mp_weno, weno_eps, teno_CT, hyperelasticity, elasticity, xi_idx, low_Mach) + !$acc update device(dt, sys_size, buff_size, pref, rhoref, gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim, bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids, model_eqns, num_dims, mixture_err, grid_geometry, cyl_coord, mp_weno, weno_eps, teno_CT, hyperelasticity, hyper_model, elasticity, xi_idx, low_Mach) #:if not MFC_CASE_OPTIMIZATION !$acc update device(wenojs, mapped_weno, wenoz, teno) diff --git a/submit_gpu.sh b/submit_gpu.sh index 2c77cc9276..c1959b1ee4 100755 --- a/submit_gpu.sh +++ b/submit_gpu.sh @@ -44,6 +44,7 @@ #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 02:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -./mfc.sh run tests/6FC6A809/case.py -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -./mfc.sh run tests/6FC6A809/case.py -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +./mfc.sh run ./examples/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +./mfc.sh run ./examples/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta + From 40ff12b7ef7a53b12da96c4f349868d8d0ffc659 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 6 Aug 2024 17:30:20 -0500 Subject: [PATCH 288/380] testing bubble in channel --- .../{case.py => nogood_case.py} | 53 ++++++++++--------- submit_gpu.sh | 5 +- 2 files changed, 31 insertions(+), 27 deletions(-) rename examples/3D_bubble_channel/{case.py => nogood_case.py} (88%) diff --git a/examples/3D_bubble_channel/case.py b/examples/3D_bubble_channel/nogood_case.py similarity index 88% rename from examples/3D_bubble_channel/case.py rename to examples/3D_bubble_channel/nogood_case.py index b3d00da0f9..6fc04870c0 100755 --- a/examples/3D_bubble_channel/case.py +++ b/examples/3D_bubble_channel/nogood_case.py @@ -3,8 +3,8 @@ ## 1 FOR BACKGROUND, 2 FOR BUBBLE, 3 FOR GEL # Pressure [Pa] -p01 = 5E6 -p02 = 3550 +p01 = 101325. +p02 = 101325 p03 = p01 # Temperature [K] @@ -138,25 +138,25 @@ # patch 1: liquid water liq_wg = 0 -liq_wa = 1.00E-15 -liq_wv = 1.00E-15 +liq_wa = 0*1.00E-15 +liq_wv = 1.00E-9 liq_wl = 1.00E00 - liq_wv - liq_wa - liq_wg # water vapor -vap_wl = 1.00E-15 +vap_wl = 1.00E-9 vap_wv = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0wa2 + 1 ) -vap_wa = 1.00E-15 +vap_wa = 0*1.00E-15 vap_wg = 0 vap_tot = vap_wl + vap_wv + vap_wa + vap_wg # air air_wl = 1.00E-15 air_wv = vap_tot air_wg = 0 -air_wa = 1.00E00 - air_wl - air_wv - air_wg +air_wa = 0*(1.00E00 - air_wl - air_wv - air_wg) # bubble -bub_wl = 1E-15 -bub_wv = vap_tot +bub_wl = 1.0E-9 +bub_wv = 1.0-bub_wl bub_wg = 0 -bub_wa = 1 - bub_wl - bub_wv - bub_wg +bub_wa = 0*(1 - bub_wl - bub_wv - bub_wg) # gel gel_wl = 0 gel_wv = 0 @@ -172,7 +172,6 @@ ## SIMULATION PARAMETERS # CFL -cfl = 0.30 # Bubble Initial Radius R0 = 50E-06 @@ -185,7 +184,7 @@ # domain boundaries lref = 2*R0 -xb = - lref +xb = -lref xe = lref yb = 0.00 @@ -204,7 +203,7 @@ #xdist = 6.51E-10 #2.17E-5 #sod = xdist/R0 -sod = 1.5 +sod = 0 xcenb = sod*R0 #neg for bub in liq; pos bub in gel ycenb = 0.00 zcenb = 0.00 @@ -243,7 +242,7 @@ # Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) # Nt = AS * SF #Nt = int(2.5E3 * tend // tc * Nx / Nx0 + 1) -Nt = int(2.0E3 * tend // tc * Nx / Nx0 + 1) +Nt = int(1E6 * tend // tc * Nx / Nx0 + 1) #print(Nt) dt = tend / Nt @@ -269,12 +268,12 @@ 'a_x' : 4.0E0, 'x_a' : -1.75*R0*(abs(sod)+1), 'x_b' : 5*R0, - 'stretch_y' : 'T', + 'stretch_y' : 'F', 'loops_y' : 2, 'a_y' : 4.0E0, 'y_a' : -2*R0*abs(sod), 'y_b' : 2*R0*abs(sod), - 'stretch_z' : 'T', + 'stretch_z' : 'F', 'loops_z' : 2, 'a_z' : 4.0E0, 'z_a' : -2*R0*abs(sod), @@ -286,14 +285,15 @@ 'dt' : dt, 't_step_start' : tstart, 't_step_stop' : Nt, - 't_step_save' : AS, + 't_step_save' : 1, # ========================================================== # Simulation Algorithm Parameters ========================== 'num_patches' : 2, 'model_eqns' : 3, 'num_fluids' : 2, - 'hypoelasticity' : 'F', - 'hyperelasticity' : 'F', + #'alt_soundspeed' : 'T', + #'hypoelasticity' : 'F', + #'hyperelasticity' : 'F', 'mpp_lim' : 'T', 'mixture_err' : 'T', #'relax' : 'T', @@ -301,19 +301,19 @@ #'palpha_eps' : 1.0E-6, #'ptgalpha_eps' : 1.0E-2, 'time_stepper' : 3, - 'weno_order' : 3, + 'weno_order' : 5, 'weno_eps' : 1.0E-16, 'weno_Re_flux' : 'F', 'weno_avg' : 'F', - 'mapped_weno' : 'T', + 'mapped_weno' : 'F', 'null_weights' : 'F', - 'mp_weno' : 'F', + 'mp_weno' : 'T', 'riemann_solver' : 2, 'wave_speeds' : 1, 'avg_state' : 2, 'bc_x%beg' : -16, #-2, 'bc_x%end' : -16, - 'bc_y%beg' : -2, + 'bc_y%beg' : -2, 'bc_y%end' : -6, 'bc_z%beg' : -2, 'bc_z%end' : -6, @@ -354,6 +354,9 @@ 'patch_icpp(2)%y_centroid' : ycenb, 'patch_icpp(2)%z_centroid' : zcenb, 'patch_icpp(2)%radius' : R0, + 'patch_icpp(2)%smoothen' : 'T', + 'patch_icpp(2)%smooth_patch_id': 1, + 'patch_icpp(2)%smooth_coeff' : 0.5E+00, 'patch_icpp(2)%vel(1)' : 0.0E+00, 'patch_icpp(2)%vel(2)' : 0.0E+00, 'patch_icpp(2)%vel(3)' : 0.0E+00, @@ -370,12 +373,12 @@ 'fluid_pp(1)%cv' : cvwl, 'fluid_pp(1)%qv' : qvwl, 'fluid_pp(1)%qvp' : qvpwl, - 'fluid_pp(1)%G' : Gl, + #'fluid_pp(1)%G' : Gl, 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), 'fluid_pp(2)%cv' : cvwv, 'fluid_pp(2)%qv' : qvwv, 'fluid_pp(2)%qvp' : qvpwv, - 'fluid_pp(2)%G' : Gv, + #'fluid_pp(2)%G' : Gv, # ========================================================== })) diff --git a/submit_gpu.sh b/submit_gpu.sh index c1959b1ee4..6621411206 100755 --- a/submit_gpu.sh +++ b/submit_gpu.sh @@ -44,7 +44,8 @@ #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 02:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -./mfc.sh run ./examples/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -./mfc.sh run ./examples/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +./mfc.sh run ./examples/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +./mfc.sh run ./examples/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run ./examples/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta From 7113d290eb749a932e637423b23dc4e8bb8339fc Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 6 Aug 2024 21:12:23 -0500 Subject: [PATCH 289/380] improving hyperelasticity --- examples/3D_lungwave/case.py | 4 +- src/simulation/m_hyperelastic.fpp | 126 ++++++++++++++---------------- submit_gpu_lung.sh | 6 +- 3 files changed, 63 insertions(+), 73 deletions(-) diff --git a/examples/3D_lungwave/case.py b/examples/3D_lungwave/case.py index 1872639732..1884002b04 100644 --- a/examples/3D_lungwave/case.py +++ b/examples/3D_lungwave/case.py @@ -139,8 +139,8 @@ # ========================================================================== # Turning on Hypoelasticity ================================================ - 'hypoelasticity' : 'T', - #'hyperelasticity' : 'T', + #'hypoelasticity' : 'T', + 'hyperelasticity' : 'F', # ========================================================================== # Formatted Database Files Structure Parameters ============================ diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index f16ad21a2e..6035a49860 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -34,6 +34,7 @@ module m_hyperelastic !> @name Abstract subroutine for the infinite relaxation solver !> @{ subroutine s_abstract_hyperelastic_solver(btensor, q_prim_vf, G, j, k, l) + !!!!$acc routine seq import :: scalar_field, sys_size, b_size type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor @@ -46,9 +47,6 @@ module m_hyperelastic end interface !> @} - procedure(s_abstract_hyperelastic_solver), & - pointer :: s_compute_cauchy_solver => null() - !! The btensor at the cell-interior Gaussian quadrature points. !! These tensor is needed to be calculated once and make the code DRY. type(vector_field) :: btensor !< @@ -70,6 +68,55 @@ module m_hyperelastic contains + !> The following subroutine handles the calculation of the btensor. + !! The calculation of the btensor takes qprimvf. + !! @param q_prim_vf Primitive variables + !! @param btensor is the output + !! calculate the grad_xi, grad_xi is a nxn tensor + !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor + !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor + !! btensor is symmetric, save the data space + subroutine s_initialize_hyperelastic_module + integer :: i !< generic iterator + + @:ALLOCATE(btensor%vf(1:b_size)) + do i = 1, b_size + @:ALLOCATE(btensor%vf(i)%sf(0:m, 0:n, 0:p)) + end do + @:ACC_SETUP_VFs(btensor) + + @:ALLOCATE(Gs(1:num_fluids)) + !$acc loop seq + do i = 1, num_fluids + Gs(i) = fluid_pp(i)%G + end do + !$acc update device(Gs) + + @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) + if (n > 0) then + @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) + end if + if (p > 0) then + @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) + end if + + ! Computing centered finite difference coefficients + call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & + fd_number, fd_order) + !$acc update device(fd_coeff_x) + if (n > 0) then + call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & + fd_number, fd_order) + !$acc update device(fd_coeff_y) + end if + if (p > 0) then + call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & + fd_number, fd_order) + !$acc update device(fd_coeff_z) + end if + + end subroutine s_initialize_hyperelastic_module + !> The following subroutine handles the calculation of the btensor. !! The calculation of the btensor takes qprimvf. !! @param q_prim_vf Primitive variables @@ -104,9 +151,9 @@ contains call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & alpha_rho_K, Re_K, j, k, l, G_K, Gs) rho_K = max(rho_K, sgm_eps) - if (G_K <= verysmall) G_K = 0d0 + if ( G_K <= verysmall ) G_K = 0d0 - if (G_K > 1.0d-03) then + if ( G_K > verysmall ) then !$acc loop seq do i = 1, tensor_size tensora(i) = 0d0 @@ -181,7 +228,11 @@ contains ! store the determinant at the last entry of the btensor btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) ! STEP 5a: updating the Cauchy stress primitive scalar field - call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) + !if (hyper_model == 1) then + call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) + !elseif (hyper_model == 2) then + ! call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) + !end if ! STEP 5b: updating the pressure field q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & G_K*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma_K @@ -208,7 +259,7 @@ contains !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) - !!!$acc routine seq + !!!!$acc routine seq type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor real(kind(0d0)), intent(in) :: G @@ -281,71 +332,10 @@ contains end subroutine s_Mooney_Rivlin_cauchy_solver - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. - !! @param q_prim_vf Primitive variables - !! @param btensor is the output - !! calculate the grad_xi, grad_xi is a nxn tensor - !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor - !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor - !! btensor is symmetric, save the data space - subroutine s_initialize_hyperelastic_module - integer :: i !< generic iterator - - @:ALLOCATE(btensor%vf(1:b_size)) - do i = 1, b_size - @:ALLOCATE(btensor%vf(i)%sf(0:m, 0:n, 0:p)) - end do - @:ACC_SETUP_VFs(btensor) - - @:ALLOCATE(Gs(1:num_fluids)) - !$acc loop seq - do i = 1, num_fluids - Gs(i) = fluid_pp(i)%G - end do - !$acc update device(Gs) - - ! Associating procedural pointer to the subroutine that will be - ! utilized to calculate the solution of a given Riemann problem - if (hyper_model == 1) then - s_compute_cauchy_solver => s_neoHookean_cauchy_solver - elseif (hyper_model == 2) then - s_compute_cauchy_solver => s_Mooney_Rivlin_cauchy_solver - end if - - @:ALLOCATE_GLOBAL(fd_coeff_x(-fd_number:fd_number, 0:m)) - if (n > 0) then - @:ALLOCATE_GLOBAL(fd_coeff_y(-fd_number:fd_number, 0:n)) - end if - if (p > 0) then - @:ALLOCATE_GLOBAL(fd_coeff_z(-fd_number:fd_number, 0:p)) - end if - - ! Computing centered finite difference coefficients - call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & - fd_number, fd_order) - !$acc update device(fd_coeff_x) - if (n > 0) then - call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & - fd_number, fd_order) - !$acc update device(fd_coeff_y) - end if - if (p > 0) then - call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & - fd_number, fd_order) - !$acc update device(fd_coeff_z) - end if - - end subroutine s_initialize_hyperelastic_module - subroutine s_finalize_hyperelastic_module() integer :: i !< iterator - ! Disassociating procedural pointer to the subroutine which was - ! utilized to calculate the solution of a given Riemann problem - s_compute_cauchy_solver => null() - ! Deallocating memory do i = 1, b_size @:DEALLOCATE_GLOBAL(btensor%vf(i)%sf) diff --git a/submit_gpu_lung.sh b/submit_gpu_lung.sh index b93ebaf913..f83c9cdb0c 100755 --- a/submit_gpu_lung.sh +++ b/submit_gpu_lung.sh @@ -1,6 +1,6 @@ #!/bin/bash -#./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta +./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta From 2bdd25a741fb58267f7400e2c8c8c4633718a25c Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 7 Aug 2024 09:23:48 -0500 Subject: [PATCH 290/380] small changes to the submit scripts --- .../{nogood_case.py => case.py} | 0 examples/3D_lungwave/arc_case.py | 221 ++++++++++++++++++ submit_gpu.sh | 13 +- submit_test.sh | 2 +- 4 files changed, 230 insertions(+), 6 deletions(-) rename examples/3D_bubble_channel/{nogood_case.py => case.py} (100%) create mode 100644 examples/3D_lungwave/arc_case.py diff --git a/examples/3D_bubble_channel/nogood_case.py b/examples/3D_bubble_channel/case.py similarity index 100% rename from examples/3D_bubble_channel/nogood_case.py rename to examples/3D_bubble_channel/case.py diff --git a/examples/3D_lungwave/arc_case.py b/examples/3D_lungwave/arc_case.py new file mode 100644 index 0000000000..1884002b04 --- /dev/null +++ b/examples/3D_lungwave/arc_case.py @@ -0,0 +1,221 @@ +#!/usr/bin/env python3 + +import math +import json + +pi = 3.141592653589 +# material parameters + +#material1 :: gas +#patterson 2018 + +gammag = 1.4 #unitless +Bg =0 #pascals +rhog = 1.18 #kg/m^3 +c_g = 347.2 #m/s +G_g = 0 #pa + +#material2 :: water +gammal = 5.5 +Bl = 492.E+06 +rhol = 996.0 +c_l = 1648.7 +G_l = 1E+06 + + +#primitive vartiables +patmos = 101325. #pa + +#problem specific variable +lambda_wave = 200.E-6 + +#define pulse +P_amp = 10.E+6 +P_len = 45 #length of the impulse +theta = -math.pi/2 #direction of propagation + +#non-dim + +#define characteristic density, length, time, stress material #make it liquid +rho_char = rhol +length_char = lambda_wave +c_char = c_l #should be liquid +time_char = length_char/c_char +stress_char = rho_char*c_char*c_char/gammal + +#non-dim the properties +rhog_n = rhog/rho_char +c_g_n = c_g/c_char +rhol_n = rhol/rho_char +c_l_n = c_l/c_char +Bg_n = Bg/stress_char +Bl_n = Bl/stress_char +G_g_n = G_g/stress_char +G_l_n = G_l/stress_char +patmos_n = patmos/stress_char +P_amp_n = P_amp/stress_char + +#geometry +dlengx = 15. +dlengy = 1. +dlengz = 1. +Ny = 25 +Nx = dlengx*Ny +Nz = dlengz*Ny +dx = dlengx/Nx +dy = dlengy/Ny +dz = dlengz/Nz +alphal_back = 1.0 +alphag_back = 0.0 +alphal_lung = 0.0 +alphag_lung = 1.0 + +interface_amp = 0.03 + +# time stepping requirements +time_end = 50 +cfl = 0.01 + +dt = cfl * dx/c_l_n +Nt = int(time_end/dt) +Nframes = 500 +tstart = 0 +tstop = Nt +tsave = int(Nt/Nframes) + +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================================ + 'run_time_info' : 'T', + #'sim_data' : 'T', + # ========================================================================== + + # Computational Domain Parameters ========================================== + 'x_domain%beg' : -dlengx/2., + 'x_domain%end' : dlengx/2., + 'y_domain%beg' : 0., + 'y_domain%end' : dlengy, + 'z_domain%beg' : 0., + 'z_domain%end' : dlengz, + 'm' : int(Nx), + 'n' : int(Ny), + 'p' : int(Nz), + 'stretch_x' : 'F', + 'a_x' : 4.0E+00, + 'x_a' : -5., + 'x_b' : 5., + 'loops_x' : 0, + 'dt' : dt, + 't_step_start' : tstart, + 't_step_stop' : tstop, + 't_step_save' : tsave, + # ========================================================================== + + # Simulation Algorithm Parameters ========================================== + 'num_patches' : 2, + 'model_eqns' : 3, + 'alt_soundspeed' : 'F', + 'num_fluids' : 2, + #'adv_alphan' : 'T', + 'mpp_lim' : 'T', + 'mixture_err' : 'T', + 'time_stepper' : 3, + 'weno_order' : 5, + 'weno_eps' : 1.E-16, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'T', + 'null_weights' : 'F', + 'mp_weno' : 'T', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -6, + 'bc_x%end' : -6, + 'bc_y%beg' : -1, + 'bc_y%end' : -1, + 'bc_z%beg' : -1, + 'bc_z%end' : -1, + # ========================================================================== + + # Turning on Hypoelasticity ================================================ + #'hypoelasticity' : 'T', + 'hyperelasticity' : 'F', + # ========================================================================== + + # Formatted Database Files Structure Parameters ============================ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'T', + # ========================================================================== + + # acoustics setting ========================================================= + 'acoustic_source' : 'T', + 'num_source' : 1, + 'acoustic(1)%support' : 3, + 'acoustic(1)%loc(1)' : 4, + 'acoustic(1)%loc(2)' : dlengy/2, + #'acoustic(1)%loc(3)' : dlengz/2, + 'acoustic(1)%pulse' : 3, + 'acoustic(1)%npulse' : 1, + 'acoustic(1)%wavelength' : P_len, #wavelength of the signal + 'acoustic(1)%mag' : P_amp_n, + 'acoustic(1)%length' : dlengy, #length of the place ??? + 'acoustic(1)%height' : dlengz, + 'acoustic(1)%dir' : -math.pi, + #=========================================================================== + + # Patch 1: Background ====================================================== + 'patch_icpp(1)%geometry' : 9, + 'patch_icpp(1)%x_centroid' : 0., + 'patch_icpp(1)%y_centroid' : dlengy/2., + 'patch_icpp(1)%z_centroid' : dlengz/2., + 'patch_icpp(1)%length_x' : 2000, #dlengx, # + 'patch_icpp(1)%length_y' : dlengy, + 'patch_icpp(1)%length_z' : dlengz, + 'patch_icpp(1)%vel(1)' : 0.E+00, + 'patch_icpp(1)%vel(2)' : 0.E+00, + 'patch_icpp(1)%vel(3)' : 0.E+00, + 'patch_icpp(1)%pres' : patmos_n, + 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, + 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, + 'patch_icpp(1)%alpha(1)' : alphal_back, + 'patch_icpp(1)%alpha(2)' : alphag_back, + #'patch_icpp(1)%tau_e(1)' : 0.0, + + # ========================================================================== + + # Patch 2: Lung ============================================================ + 'patch_icpp(2)%geometry' : 13, + 'patch_icpp(2)%hcid' : 301, + #'patch_icpp(2)%geometry' : 9, + 'patch_icpp(2)%alter_patch(1)' : 'T', + 'patch_icpp(2)%x_centroid' : -998,#-dlengx/4., # + 'patch_icpp(2)%y_centroid' : dlengy/2., + 'patch_icpp(2)%z_centroid' : dlengz/2., + 'patch_icpp(2)%length_x' : 2000,#dlengx,#dlengx/2.+2, # + 'patch_icpp(2)%length_y' : dlengy, + 'patch_icpp(2)%length_z' : dlengz, + 'patch_icpp(2)%a2' : interface_amp, + 'patch_icpp(2)%vel(1)' : 0.E+00, + 'patch_icpp(2)%vel(2)' : 0.0, + 'patch_icpp(2)%vel(3)' : 0.0, + 'patch_icpp(2)%pres' : patmos_n, + 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, + 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, + 'patch_icpp(2)%alpha(1)' : alphal_lung, + 'patch_icpp(2)%alpha(2)' : alphag_lung, + # ========================================================================== + + # Fluids Physical Parameters =============================================== + 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), + 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), + 'fluid_pp(1)%G' : G_l_n, + 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), + 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), + 'fluid_pp(2)%G' : G_g_n, + #============================================================================== +})) + +# ============================================================================== diff --git a/submit_gpu.sh b/submit_gpu.sh index 6621411206..0859ba7f1e 100755 --- a/submit_gpu.sh +++ b/submit_gpu.sh @@ -2,7 +2,7 @@ ### A100s #./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwex_pre -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta @@ -40,12 +40,15 @@ #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 02:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -./mfc.sh run ./examples/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -./mfc.sh run ./examples/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run ./examples/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta +./mfc.sh run /scratch/bciv/rodrigu1/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +./mfc.sh run /scratch/bciv/rodrigu1/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta diff --git a/submit_test.sh b/submit_test.sh index 69b80bbe7b..2f79148e85 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -39,7 +39,7 @@ #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta #./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar From 2e969a279f417723321878ee293eacb87a4af70e Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 9 Aug 2024 20:09:21 -0500 Subject: [PATCH 291/380] a few additional changes --- src/common/m_checker_common.fpp | 4 +-- src/simulation/m_data_output.fpp | 29 ++++++++++++---- src/simulation/m_hyperelastic.fpp | 57 ++++++++++++++++--------------- submit_gpu.sh | 2 +- 4 files changed, 54 insertions(+), 38 deletions(-) diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index b4506a01f1..dbcd6ac415 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -189,9 +189,9 @@ contains !> Checks constraints on the hyperelasticity parameters. !! Called by s_check_inputs_common for pre-processing and simulation subroutine s_check_inputs_hyperelasticity - if (model_eqns /= 3) then + if (model_eqns == 1 .or. model_eqns .gt. 3) then call s_mpi_abort('hyperelasticity requires '// & - '6-equation model (model_eqns = 3). Exiting ...') + '6-equation model (model_eqns = 2 or 3). Exiting ...') end if end subroutine s_check_inputs_hyperelasticity diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 11f4538185..2f2ce8cc85 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -283,6 +283,8 @@ contains real(kind(0d0)) :: gamma !< Cell-avg. sp. heat ratio real(kind(0d0)) :: pi_inf !< Cell-avg. liquid stiffness function real(kind(0d0)) :: qv !< Cell-avg. fluid reference energy + real(kind(0d0)) :: G !< Cell-avg. fluid shear modulus + real(kind(0d0)), dimension(num_fluids) :: Gs !< Cell-avg. fluid shear moduli real(kind(0d0)) :: c !< Cell-avg. sound speed real(kind(0d0)) :: E !< Cell-avg. energy real(kind(0d0)) :: H !< Cell-avg. enthalpy @@ -301,26 +303,32 @@ contains !! Modified dtheta accounting for Fourier filtering in azimuthal direction. ! Computing Stability Criteria at Current Time-step ================ - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho, vel, alpha, Re, fltr_dtheta, Nfq) + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho, vel, alpha, pi_inf, qv, G, Gs, Re, fltr_dtheta, Nfq) do l = 0, p do k = 0, n do j = 0, m + !$acc loop seq do i = 1, num_fluids alpha_rho(i) = q_prim_vf(i)%sf(j, k, l) alpha(i) = q_prim_vf(E_idx + i)%sf(j, k, l) end do - if (bubbles) then + if (elasticity) then + call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv, alpha, & + alpha_rho, Re, j, k, l, G, Gs) + elseif (bubbles) then call s_convert_species_to_mixture_variables_bubbles_acc(rho, gamma, pi_inf, qv, alpha, alpha_rho, Re, j, k, l) else call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv, alpha, alpha_rho, Re, j, k, l) end if + !$acc loop seq do i = 1, num_dims vel(i) = q_prim_vf(contxe + i)%sf(j, k, l) end do vel_sum = 0d0 + !$acc loop seq do i = 1, num_dims vel_sum = vel_sum + vel(i)**2d0 end do @@ -329,17 +337,22 @@ contains E = gamma*pres + pi_inf + 5d-1*rho*vel_sum + qv + ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY + if (hyperelasticity) then + E = E + G*q_prim_vf(xiend+1)%sf(j, k, l) + end if + H = (E + pres)/rho ! Compute mixture sound speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, alpha, vel_sum, c) if (c /= c) then - print *, 'crashed at processor: ', proc_rank, ', at j :: ', j, ', k :: ', k, ' l :: ', l + !print *, 'crashed at processor: ', proc_rank, ', at j :: ', j, ', k :: ', k, ' l :: ', l print *, 'alpha1 ::', alpha(1), 'and alpha2 ::', alpha(2), ' alpha3 :: ', alpha(3) print *, 'alpha_rho1 ::', alpha_rho(1), ', alpha_rho2 ::', alpha_rho(2), ' alpha_rho3 :: ', alpha_rho(3) print *, 'E :: ', E, ', pres :: ', pres, ', rho :: ', rho - call s_mpi_abort('Exiting ...') + !call s_mpi_abort('Exiting ...') end if if (grid_geometry == 3) then @@ -419,6 +432,8 @@ contains end do end do end do + !$acc end parallel loop + ! end: Computing Stability Criteria at Current Time-step =========== ! Determining local stability criteria extrema at current time-step @@ -448,7 +463,7 @@ contains !$acc end kernels end if #endif - + ! Determining global stability criteria extrema at current time-step if (num_procs > 1) then call s_mpi_reduce_stability_criteria_extrema(icfl_max_loc, & @@ -464,7 +479,7 @@ contains if (any(Re_size > 0)) vcfl_max_glb = vcfl_max_loc if (any(Re_size > 0)) Rc_min_glb = Rc_min_loc end if - + ! Determining the stability criteria extrema over all the time-steps if (icfl_max_glb > icfl_max) icfl_max = icfl_max_glb @@ -475,12 +490,12 @@ contains ! Outputting global stability criteria extrema at current time-step if (proc_rank == 0) then + print *, "icfl :: ",icfl_max_glb if (any(Re_size > 0)) then write (1, '(6X,I8,6X,F10.6,6X,F9.6,6X,F9.6,6X,F10.6)') & t_step, t_step*dt, icfl_max_glb, & vcfl_max_glb, & Rc_min_glb - else write (1, '(13X,I8,14X,F10.6,13X,F9.6)') & t_step, t_step*dt, icfl_max_glb diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 6035a49860..6be18fce62 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -131,29 +131,30 @@ contains type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf real(kind(0d0)), dimension(tensor_size) :: tensora, tensorb - real(kind(0d0)), dimension(num_fluids) :: alpha_K, alpha_rho_K - real(kind(0d0)), dimension(2) :: Re_K - real(kind(0d0)) :: rho_K, gamma_K, pi_inf_K, qv_K - real(kind(0d0)) :: G_K + real(kind(0d0)), dimension(num_fluids) :: alpha_k, alpha_rho_k + real(kind(0d0)), dimension(2) :: Re + real(kind(0d0)) :: rho, gamma, pi_inf, qv + real(kind(0d0)) :: G integer :: j, k, l, i, r !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, & - !$acc rho_K, gamma_K, pi_inf_K, qv_K, G_K, Re_K, tensora, tensorb) + !$acc rho, gamma, pi_inf, qv, G, Re, tensora, tensorb) do l = 0, p do k = 0, n do j = 0, m !$acc loop seq do i = 1, num_fluids - alpha_rho_K(i) = q_cons_vf(i)%sf(j, k, l) - alpha_K(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) + alpha_rho_k(i) = q_cons_vf(i)%sf(j, k, l) + alpha_k(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) end do ! If in simulation, use acc mixture subroutines - call s_convert_species_to_mixture_variables_acc(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, & - alpha_rho_K, Re_K, j, k, l, G_K, Gs) - rho_K = max(rho_K, sgm_eps) - if ( G_K <= verysmall ) G_K = 0d0 + call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv, alpha_k, & + alpha_rho_k, Re, j, k, l, G, Gs) + rho = max(rho, sgm_eps) + G = max(G, sgm_eps) + !if ( G <= verysmall ) G_K = 0d0 - if ( G_K > verysmall ) then + if ( G > verysmall ) then !$acc loop seq do i = 1, tensor_size tensora(i) = 0d0 @@ -194,7 +195,7 @@ contains - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - if (tensorb(tensor_size) > 0d0) then + if (tensorb(tensor_size) > verysmall) then ! STEP 2c: computing the inverse of grad_xi tensor = F ! tensorb is the adjoint, tensora becomes F !$acc loop seq @@ -213,34 +214,34 @@ contains tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) ! STEP 4: update the btensor, this is consistent with Riemann solvers - ! \tau_xx + ! \b_xx btensor%vf(1)%sf(j, k, l) = tensorb(1) - ! \tau_xy + ! \b_xy btensor%vf(2)%sf(j, k, l) = tensorb(2) - ! \tau_yy + ! \b_yy btensor%vf(3)%sf(j, k, l) = tensorb(5) - ! \tau_xz + ! \b_xz btensor%vf(4)%sf(j, k, l) = tensorb(3) - ! \tau_yz + ! \b_yz btensor%vf(5)%sf(j, k, l) = tensorb(6) - ! \tau_zz + ! \b_zz btensor%vf(6)%sf(j, k, l) = tensorb(9) ! store the determinant at the last entry of the btensor btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) ! STEP 5a: updating the Cauchy stress primitive scalar field - !if (hyper_model == 1) then - call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) - !elseif (hyper_model == 2) then - ! call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G_K, j, k, l) - !end if + if (hyper_model == 1) then + call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) + elseif (hyper_model == 2) then + call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) + end if ! STEP 5b: updating the pressure field q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & - G_K*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma_K + G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma ! STEP 5c: updating the Cauchy stress conservative scalar field !$acc loop seq do i = 1, b_size - 1 q_cons_vf(strxb + i - 1)%sf(j, k, l) = & - rho_K*q_prim_vf(strxb + i - 1)%sf(j, k, l) + rho*q_prim_vf(strxb + i - 1)%sf(j, k, l) end do end if end if @@ -259,7 +260,7 @@ contains !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) - !!!!$acc routine seq + !$acc routine seq type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor real(kind(0d0)), intent(in) :: G @@ -300,7 +301,7 @@ contains !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space subroutine s_Mooney_Rivlin_cauchy_solver(btensor, q_prim_vf, G, j, k, l) - !!!!$acc routine seq + !$acc routine seq type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor real(kind(0d0)), intent(in) :: G diff --git a/submit_gpu.sh b/submit_gpu.sh index 0859ba7f1e..d6d4b98990 100755 --- a/submit_gpu.sh +++ b/submit_gpu.sh @@ -46,7 +46,7 @@ ./mfc.sh run /scratch/bciv/rodrigu1/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta ./mfc.sh run /scratch/bciv/rodrigu1/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta +./mfc.sh run /scratch/bciv/rodrigu1/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta From 17d55413021b94081721602a9ebf76d1a17bae3d Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 9 Aug 2024 20:36:20 -0500 Subject: [PATCH 292/380] updated the m_variables_conversion --- src/common/m_variables_conversion.fpp | 27 +++++++++++++++------------ submit_gpu.sh | 2 +- 2 files changed, 16 insertions(+), 13 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index a5a6164d07..cd03727a6b 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -979,11 +979,16 @@ contains end if end if + if (elasticity) then + !$acc loop seq + do i = strxb, strxe + qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K + end do + end if + if (hypoelasticity) then !$acc loop seq do i = strxb, strxe - qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & - /rho_K ! subtracting elastic contribution for pressure calculation if (G_K > verysmall) then !TODO: check if stable for >0 qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & @@ -1000,10 +1005,6 @@ contains end if if (hyperelasticity) then - !$acc loop seq - do i = strxb, strxe - qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K - end do !$acc loop seq do i = xibeg, xiend qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K @@ -1148,9 +1149,16 @@ contains end do end if - if (hypoelasticity) then + if (elasticity) then + ! adding the elastic contribution + ! Multiply \tau to \rho \tau do i = strxb, strxe q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) + end do + end if + + if (hypoelasticity) then + do i = strxb, strxe ! adding elastic contribution if (G > verysmall) then q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & @@ -1168,11 +1176,6 @@ contains ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022 if (hyperelasticity) then - ! adding the elastic contribution - ! Multiply \tau to \rho \tau - do i = strxb, strxe - q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) - end do ! Multiply \xi to \rho \xi do i = xibeg, xiend q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) diff --git a/submit_gpu.sh b/submit_gpu.sh index d6d4b98990..0859ba7f1e 100755 --- a/submit_gpu.sh +++ b/submit_gpu.sh @@ -46,7 +46,7 @@ ./mfc.sh run /scratch/bciv/rodrigu1/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta ./mfc.sh run /scratch/bciv/rodrigu1/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/rodrigu1/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta +#./mfc.sh run /scratch/bciv/rodrigu1/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta #./mfc.sh run /scratch/bciv/rodrigu1/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta From 0b58a52575016f329383f9032bfdbd91ceb9d673 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 19 Aug 2024 21:34:56 -0500 Subject: [PATCH 293/380] metaprogramming to hyperelastic --- src/simulation/m_hyperelastic.fpp | 15 +++------------ 1 file changed, 3 insertions(+), 12 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 6be18fce62..b928e9944a 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -214,18 +214,9 @@ contains tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) ! STEP 4: update the btensor, this is consistent with Riemann solvers - ! \b_xx - btensor%vf(1)%sf(j, k, l) = tensorb(1) - ! \b_xy - btensor%vf(2)%sf(j, k, l) = tensorb(2) - ! \b_yy - btensor%vf(3)%sf(j, k, l) = tensorb(5) - ! \b_xz - btensor%vf(4)%sf(j, k, l) = tensorb(3) - ! \b_yz - btensor%vf(5)%sf(j, k, l) = tensorb(6) - ! \b_zz - btensor%vf(6)%sf(j, k, l) = tensorb(9) + #:for BIJ, TXY in [(1,1),(2,2),(3,5),(4,3),(5,6),(6,9)] + btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) + #:endfor ! store the determinant at the last entry of the btensor btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) ! STEP 5a: updating the Cauchy stress primitive scalar field From bd406db79a51719a4458f3f0776463316f9cad7f Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 21 Aug 2024 16:02:32 -0500 Subject: [PATCH 294/380] added a few more metaprogramming --- src/simulation/m_hyperelastic.fpp | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index b928e9944a..f2f3085d07 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -261,15 +261,13 @@ contains real(kind(0d0)) :: f13 = 1d0/3d0 integer :: i !< Generic loop iterators - !TODO Make this 1D and 2D capable ! tensor is the symmetric tensor & calculate the trace of the tensor trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) ! calculate the deviatoric of the tensor - btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace - btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace - btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace - + #:for IJ in [1,3,6] + btensor(${IJ}$)%sf(j, k, l) = btensor(${IJ}$)%sf(j, k, l) - f13*trace + #:endfor ! dividing by the jacobian for neo-Hookean model ! setting the tensor to the stresses for riemann solver !$acc loop seq From 3d84962117248e378ac10448d6240c3ab3b4972d Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 7 Sep 2024 19:44:03 -0500 Subject: [PATCH 295/380] updated the Delta modules --- toolchain/modules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/toolchain/modules b/toolchain/modules index 04bfdbab92..d8c4d0de6e 100644 --- a/toolchain/modules +++ b/toolchain/modules @@ -54,7 +54,7 @@ f-gpu craype-accel-amd-gfx90a d NCSA Delta d-all python/3.11.6 d-cpu gcc/11.4.0 openmpi -d-gpu nvhpc/22.11 openmpi+cuda/4.1.5+cuda cmake +d-gpu nvhpc/24.1 openmpi/4.1.5+cuda cmake d-gpu CC=nvc CXX=nvc++ FC=nvfortran o Brown Oscar From a8eeab08d97a25fb2033d6312f8b18f1d0ea465b Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 7 Sep 2024 19:47:39 -0500 Subject: [PATCH 296/380] added modules to Delta --- toolchain/modules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/toolchain/modules b/toolchain/modules index d73c600773..a9950bffd4 100644 --- a/toolchain/modules +++ b/toolchain/modules @@ -54,7 +54,7 @@ f-gpu craype-accel-amd-gfx90a d NCSA Delta d-all python/3.11.6 d-cpu gcc/11.4.0 openmpi -d-gpu nvhpc/22.11 openmpi+cuda/4.1.5+cuda cmake +d-gpu nvhpc/24.1 openmpi/4.1.5+cuda cmake d-gpu CC=nvc CXX=nvc++ FC=nvfortran c DoD Carpenter From 1e424e0d7b3012b3e2537f3e0dccd8b0a66c4004 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 6 Oct 2024 17:19:44 -0500 Subject: [PATCH 297/380] update the library in the mako file --- toolchain/templates/delta.mako | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/toolchain/templates/delta.mako b/toolchain/templates/delta.mako index e08a4aaee8..d13e832a9f 100644 --- a/toolchain/templates/delta.mako +++ b/toolchain/templates/delta.mako @@ -37,7 +37,7 @@ cd - > /dev/null echo # Fixes Delta not being able to find core library file -export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:/sw/spack/deltas11-2023-03/apps/linux-rhel8-zen3/nvhpc-22.11/openmpi-4.1.5-nzb4n4r/lib/ +export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:/sw/spack/deltas11-2023-03/apps/linux-rhel8-zen3/nvhpc-24.1/openmpi-4.1.5-zkiklxi/lib/ % for target in targets: ${helpers.run_prologue(target)} From 60f92261ab7265516ff1bc4dff677f972d8e17ff Mon Sep 17 00:00:00 2001 From: Nazarii Koval Date: Thu, 17 Oct 2024 15:37:05 -0500 Subject: [PATCH 298/380] updated input file in the lung problem, updated 3dhardcodedIC --- examples/3D_lungwave/arc_case.py | 221 ---------------------- examples/3D_lungwave/case.py | 128 +++++++------ src/pre_process/include/3dHardcodedIC.fpp | 30 ++- 3 files changed, 100 insertions(+), 279 deletions(-) delete mode 100644 examples/3D_lungwave/arc_case.py diff --git a/examples/3D_lungwave/arc_case.py b/examples/3D_lungwave/arc_case.py deleted file mode 100644 index 1884002b04..0000000000 --- a/examples/3D_lungwave/arc_case.py +++ /dev/null @@ -1,221 +0,0 @@ -#!/usr/bin/env python3 - -import math -import json - -pi = 3.141592653589 -# material parameters - -#material1 :: gas -#patterson 2018 - -gammag = 1.4 #unitless -Bg =0 #pascals -rhog = 1.18 #kg/m^3 -c_g = 347.2 #m/s -G_g = 0 #pa - -#material2 :: water -gammal = 5.5 -Bl = 492.E+06 -rhol = 996.0 -c_l = 1648.7 -G_l = 1E+06 - - -#primitive vartiables -patmos = 101325. #pa - -#problem specific variable -lambda_wave = 200.E-6 - -#define pulse -P_amp = 10.E+6 -P_len = 45 #length of the impulse -theta = -math.pi/2 #direction of propagation - -#non-dim - -#define characteristic density, length, time, stress material #make it liquid -rho_char = rhol -length_char = lambda_wave -c_char = c_l #should be liquid -time_char = length_char/c_char -stress_char = rho_char*c_char*c_char/gammal - -#non-dim the properties -rhog_n = rhog/rho_char -c_g_n = c_g/c_char -rhol_n = rhol/rho_char -c_l_n = c_l/c_char -Bg_n = Bg/stress_char -Bl_n = Bl/stress_char -G_g_n = G_g/stress_char -G_l_n = G_l/stress_char -patmos_n = patmos/stress_char -P_amp_n = P_amp/stress_char - -#geometry -dlengx = 15. -dlengy = 1. -dlengz = 1. -Ny = 25 -Nx = dlengx*Ny -Nz = dlengz*Ny -dx = dlengx/Nx -dy = dlengy/Ny -dz = dlengz/Nz -alphal_back = 1.0 -alphag_back = 0.0 -alphal_lung = 0.0 -alphag_lung = 1.0 - -interface_amp = 0.03 - -# time stepping requirements -time_end = 50 -cfl = 0.01 - -dt = cfl * dx/c_l_n -Nt = int(time_end/dt) -Nframes = 500 -tstart = 0 -tstop = Nt -tsave = int(Nt/Nframes) - -# Configuring case dictionary -print(json.dumps({ - # Logistics ================================================================ - 'run_time_info' : 'T', - #'sim_data' : 'T', - # ========================================================================== - - # Computational Domain Parameters ========================================== - 'x_domain%beg' : -dlengx/2., - 'x_domain%end' : dlengx/2., - 'y_domain%beg' : 0., - 'y_domain%end' : dlengy, - 'z_domain%beg' : 0., - 'z_domain%end' : dlengz, - 'm' : int(Nx), - 'n' : int(Ny), - 'p' : int(Nz), - 'stretch_x' : 'F', - 'a_x' : 4.0E+00, - 'x_a' : -5., - 'x_b' : 5., - 'loops_x' : 0, - 'dt' : dt, - 't_step_start' : tstart, - 't_step_stop' : tstop, - 't_step_save' : tsave, - # ========================================================================== - - # Simulation Algorithm Parameters ========================================== - 'num_patches' : 2, - 'model_eqns' : 3, - 'alt_soundspeed' : 'F', - 'num_fluids' : 2, - #'adv_alphan' : 'T', - 'mpp_lim' : 'T', - 'mixture_err' : 'T', - 'time_stepper' : 3, - 'weno_order' : 5, - 'weno_eps' : 1.E-16, - 'weno_Re_flux' : 'F', - 'weno_avg' : 'F', - 'mapped_weno' : 'T', - 'null_weights' : 'F', - 'mp_weno' : 'T', - 'riemann_solver' : 2, - 'wave_speeds' : 1, - 'avg_state' : 2, - 'bc_x%beg' : -6, - 'bc_x%end' : -6, - 'bc_y%beg' : -1, - 'bc_y%end' : -1, - 'bc_z%beg' : -1, - 'bc_z%end' : -1, - # ========================================================================== - - # Turning on Hypoelasticity ================================================ - #'hypoelasticity' : 'T', - 'hyperelasticity' : 'F', - # ========================================================================== - - # Formatted Database Files Structure Parameters ============================ - 'format' : 1, - 'precision' : 2, - 'prim_vars_wrt' :'T', - 'parallel_io' :'T', - # ========================================================================== - - # acoustics setting ========================================================= - 'acoustic_source' : 'T', - 'num_source' : 1, - 'acoustic(1)%support' : 3, - 'acoustic(1)%loc(1)' : 4, - 'acoustic(1)%loc(2)' : dlengy/2, - #'acoustic(1)%loc(3)' : dlengz/2, - 'acoustic(1)%pulse' : 3, - 'acoustic(1)%npulse' : 1, - 'acoustic(1)%wavelength' : P_len, #wavelength of the signal - 'acoustic(1)%mag' : P_amp_n, - 'acoustic(1)%length' : dlengy, #length of the place ??? - 'acoustic(1)%height' : dlengz, - 'acoustic(1)%dir' : -math.pi, - #=========================================================================== - - # Patch 1: Background ====================================================== - 'patch_icpp(1)%geometry' : 9, - 'patch_icpp(1)%x_centroid' : 0., - 'patch_icpp(1)%y_centroid' : dlengy/2., - 'patch_icpp(1)%z_centroid' : dlengz/2., - 'patch_icpp(1)%length_x' : 2000, #dlengx, # - 'patch_icpp(1)%length_y' : dlengy, - 'patch_icpp(1)%length_z' : dlengz, - 'patch_icpp(1)%vel(1)' : 0.E+00, - 'patch_icpp(1)%vel(2)' : 0.E+00, - 'patch_icpp(1)%vel(3)' : 0.E+00, - 'patch_icpp(1)%pres' : patmos_n, - 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, - 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, - 'patch_icpp(1)%alpha(1)' : alphal_back, - 'patch_icpp(1)%alpha(2)' : alphag_back, - #'patch_icpp(1)%tau_e(1)' : 0.0, - - # ========================================================================== - - # Patch 2: Lung ============================================================ - 'patch_icpp(2)%geometry' : 13, - 'patch_icpp(2)%hcid' : 301, - #'patch_icpp(2)%geometry' : 9, - 'patch_icpp(2)%alter_patch(1)' : 'T', - 'patch_icpp(2)%x_centroid' : -998,#-dlengx/4., # - 'patch_icpp(2)%y_centroid' : dlengy/2., - 'patch_icpp(2)%z_centroid' : dlengz/2., - 'patch_icpp(2)%length_x' : 2000,#dlengx,#dlengx/2.+2, # - 'patch_icpp(2)%length_y' : dlengy, - 'patch_icpp(2)%length_z' : dlengz, - 'patch_icpp(2)%a2' : interface_amp, - 'patch_icpp(2)%vel(1)' : 0.E+00, - 'patch_icpp(2)%vel(2)' : 0.0, - 'patch_icpp(2)%vel(3)' : 0.0, - 'patch_icpp(2)%pres' : patmos_n, - 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, - 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, - 'patch_icpp(2)%alpha(1)' : alphal_lung, - 'patch_icpp(2)%alpha(2)' : alphag_lung, - # ========================================================================== - - # Fluids Physical Parameters =============================================== - 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), - 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), - 'fluid_pp(1)%G' : G_l_n, - 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), - 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), - 'fluid_pp(2)%G' : G_g_n, - #============================================================================== -})) - -# ============================================================================== diff --git a/examples/3D_lungwave/case.py b/examples/3D_lungwave/case.py index 1884002b04..236cbd0978 100644 --- a/examples/3D_lungwave/case.py +++ b/examples/3D_lungwave/case.py @@ -15,13 +15,20 @@ c_g = 347.2 #m/s G_g = 0 #pa +#gas Cv calculation +Ru = 8.3144598 +Ra = Ru/(28.955E-3) +Cp_g = Ra*gammag/(gammag-1) +Cv_g = Cp_g/gammag +# + #material2 :: water gammal = 5.5 Bl = 492.E+06 rhol = 996.0 -c_l = 1648.7 -G_l = 1E+06 - +c_l = 1540#1648.7 +G_l = 1.0E3 +Cv_l = 1816 #primitive vartiables patmos = 101325. #pa @@ -30,18 +37,18 @@ lambda_wave = 200.E-6 #define pulse -P_amp = 10.E+6 -P_len = 45 #length of the impulse +P_amp = 1.E+6 +P_len = 45*lambda_wave #length of the impulse theta = -math.pi/2 #direction of propagation #non-dim #define characteristic density, length, time, stress material #make it liquid -rho_char = rhol -length_char = lambda_wave -c_char = c_l #should be liquid -time_char = length_char/c_char -stress_char = rho_char*c_char*c_char/gammal +rho_char = 1#rhol +length_char = 1#lambda_wave +c_char = 1#c_l #should be liquid +time_char = 1#length_char/c_char +stress_char = 1#rho_char*c_char*c_char/gammal #non-dim the properties rhog_n = rhog/rho_char @@ -56,25 +63,27 @@ P_amp_n = P_amp/stress_char #geometry -dlengx = 15. -dlengy = 1. -dlengz = 1. -Ny = 25 -Nx = dlengx*Ny -Nz = dlengz*Ny +dlengx = 10.*lambda_wave +dlengy = 1.*lambda_wave/2. +dlengz = 1.*lambda_wave/2. +Ny = 48 +Nx = dlengx*Ny/dlengy +Nz = dlengz*Ny/dlengy dx = dlengx/Nx dy = dlengy/Ny dz = dlengz/Nz -alphal_back = 1.0 -alphag_back = 0.0 -alphal_lung = 0.0 -alphag_lung = 1.0 -interface_amp = 0.03 +alphal_back = 0.99 +alphag_back = 1.0 - alphal_back + +alphag_lung = 0.99 +alphal_lung = 1.0 - alphag_lung + +interface_amp = 0.03*lambda_wave # time stepping requirements -time_end = 50 -cfl = 0.01 +time_end = 5.0e-5#1.5E-04 +cfl = 0.3 dt = cfl * dx/c_l_n Nt = int(time_end/dt) @@ -87,7 +96,7 @@ print(json.dumps({ # Logistics ================================================================ 'run_time_info' : 'T', - #'sim_data' : 'T', + 'sim_data' : 'T', # ========================================================================== # Computational Domain Parameters ========================================== @@ -100,23 +109,28 @@ 'm' : int(Nx), 'n' : int(Ny), 'p' : int(Nz), - 'stretch_x' : 'F', + 'stretch_x' : 'T', 'a_x' : 4.0E+00, - 'x_a' : -5., - 'x_b' : 5., - 'loops_x' : 0, + 'x_a' : -3.*lambda_wave, + 'x_b' : 3.*lambda_wave, + 'loops_x' : 2, 'dt' : dt, 't_step_start' : tstart, 't_step_stop' : tstop, - 't_step_save' : tsave, + 't_step_save' : 10,#tsave, # ========================================================================== # Simulation Algorithm Parameters ========================================== 'num_patches' : 2, 'model_eqns' : 3, + ####Change + 'relax' : 'T', + 'relax_model' : 5, + 'palpha_eps' : 1.0E-5, #check smaller -6/-8 + 'ptgalpha_eps' : 0.999, + ########Change 'alt_soundspeed' : 'F', 'num_fluids' : 2, - #'adv_alphan' : 'T', 'mpp_lim' : 'T', 'mixture_err' : 'T', 'time_stepper' : 3, @@ -132,15 +146,15 @@ 'avg_state' : 2, 'bc_x%beg' : -6, 'bc_x%end' : -6, - 'bc_y%beg' : -1, - 'bc_y%end' : -1, - 'bc_z%beg' : -1, - 'bc_z%end' : -1, + 'bc_y%beg' : -2, # was -1 for all of them + 'bc_y%end' : -2, + 'bc_z%beg' : -2, + 'bc_z%end' : -2, # ========================================================================== # Turning on Hypoelasticity ================================================ #'hypoelasticity' : 'T', - 'hyperelasticity' : 'F', + 'hyperelasticity' : 'T', # ========================================================================== # Formatted Database Files Structure Parameters ============================ @@ -154,49 +168,47 @@ 'acoustic_source' : 'T', 'num_source' : 1, 'acoustic(1)%support' : 3, - 'acoustic(1)%loc(1)' : 4, - 'acoustic(1)%loc(2)' : dlengy/2, - #'acoustic(1)%loc(3)' : dlengz/2, + 'acoustic(1)%loc(1)' : 0.1*lambda_wave, + 'acoustic(1)%loc(2)' : 0,#lambda_wave/2, + 'acoustic(1)%loc(3)' : 0, 'acoustic(1)%pulse' : 3, 'acoustic(1)%npulse' : 1, 'acoustic(1)%wavelength' : P_len, #wavelength of the signal 'acoustic(1)%mag' : P_amp_n, - 'acoustic(1)%length' : dlengy, #length of the place ??? - 'acoustic(1)%height' : dlengz, + 'acoustic(1)%length' : 2*dlengy, #length of the place ??? + 'acoustic(1)%height' : 2*dlengz, #maybe 2dlengz 'acoustic(1)%dir' : -math.pi, #=========================================================================== # Patch 1: Background ====================================================== 'patch_icpp(1)%geometry' : 9, 'patch_icpp(1)%x_centroid' : 0., - 'patch_icpp(1)%y_centroid' : dlengy/2., - 'patch_icpp(1)%z_centroid' : dlengz/2., - 'patch_icpp(1)%length_x' : 2000, #dlengx, # - 'patch_icpp(1)%length_y' : dlengy, - 'patch_icpp(1)%length_z' : dlengz, + 'patch_icpp(1)%y_centroid' : 0,#dlengy/2., + 'patch_icpp(1)%z_centroid' : 0,#dlengz/2., + 'patch_icpp(1)%length_x' : 5,#100*lambda_wave,#5*dlengx,#30*lambda_wave, + 'patch_icpp(1)%length_y' : 2*dlengy, + 'patch_icpp(1)%length_z' : 2*dlengz, 'patch_icpp(1)%vel(1)' : 0.E+00, - 'patch_icpp(1)%vel(2)' : 0.E+00, + 'patch_icpp(1)%vel(2)' : 0.E+00, 'patch_icpp(1)%vel(3)' : 0.E+00, 'patch_icpp(1)%pres' : patmos_n, 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, - 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, + 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, # make non 0 'patch_icpp(1)%alpha(1)' : alphal_back, 'patch_icpp(1)%alpha(2)' : alphag_back, - #'patch_icpp(1)%tau_e(1)' : 0.0, - + # ========================================================================== # Patch 2: Lung ============================================================ 'patch_icpp(2)%geometry' : 13, - 'patch_icpp(2)%hcid' : 301, - #'patch_icpp(2)%geometry' : 9, + 'patch_icpp(2)%hcid' : 302, 'patch_icpp(2)%alter_patch(1)' : 'T', - 'patch_icpp(2)%x_centroid' : -998,#-dlengx/4., # - 'patch_icpp(2)%y_centroid' : dlengy/2., - 'patch_icpp(2)%z_centroid' : dlengz/2., - 'patch_icpp(2)%length_x' : 2000,#dlengx,#dlengx/2.+2, # - 'patch_icpp(2)%length_y' : dlengy, - 'patch_icpp(2)%length_z' : dlengz, + 'patch_icpp(2)%x_centroid' : 0,#-5*lambda_wave,#-dlengx/2., #-lambda_wave*5, # + 'patch_icpp(2)%y_centroid' : 0,#dlengy/2., + 'patch_icpp(2)%z_centroid' : 0,#dlengz/2., + 'patch_icpp(2)%length_x' : 5,#5*dlengx,#lambda_wave*30, # + 'patch_icpp(2)%length_y' : 2*dlengy, + 'patch_icpp(2)%length_z' : 2*dlengz, 'patch_icpp(2)%a2' : interface_amp, 'patch_icpp(2)%vel(1)' : 0.E+00, 'patch_icpp(2)%vel(2)' : 0.0, @@ -212,9 +224,11 @@ 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), 'fluid_pp(1)%G' : G_l_n, + 'fluid_pp(1)%cv' : Cv_l, 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), 'fluid_pp(2)%G' : G_g_n, + 'fluid_pp(2)%cv' : Cv_g, #============================================================================== })) diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp index 7b75101514..135123b5fe 100644 --- a/src/pre_process/include/3dHardcodedIC.fpp +++ b/src/pre_process/include/3dHardcodedIC.fpp @@ -55,7 +55,35 @@ q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1) q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2) end if - + + case (302) ! (3D lung geometry in X direction - axisym, with smoothing) + h = 0.0 + lam = 1.0*200.E-06 + amp = patch_icpp(patch_id)%a2 + + intH = amp/2*(sin(2*pi*y_cc(j)/lam + pi/2) + sin(2*pi*z_cc(k)/lam + pi/2))+h + + alph = patch_icpp(2)%alpha(1) + (patch_icpp(1)%alpha(1)-patch_icpp(2)%alpha(1))/(amp)*(x_cc(i)-(intH-amp/2)) + + ! Version 2 + if (x_cc(i) > intH + amp/2) then + + q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1) + q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2) + q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1) + q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2) + q_prim_vf(E_idx)%sf(i, j, k) = patch_icpp(1)%pres + + else if ((x_cc(i) .le. intH + amp/2) .and. (x_cc(i) .ge. intH - amp/2)) then + + q_prim_vf(advxb)%sf(i, j, k) = alph !0.5 + q_prim_vf(advxe)%sf(i, j, k) = 1- alph !0.5 + q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)/patch_icpp(1)%alpha(1)*alph!0.5 + q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(2)%alpha_rho(2)/patch_icpp(2)%alpha(2)*(1-alph)!0.5 + q_prim_vf(E_idx)%sf(i, j, k) = patch_icpp(1)%pres + + end if + ! Put your variable assignments here case default call s_int_to_str(patch_id, iStr) From 6ab5f9197ebeebf88902c67320e694c095d58167 Mon Sep 17 00:00:00 2001 From: nkoval2003 <90657193+nkoval2003@users.noreply.github.com> Date: Tue, 29 Oct 2024 18:30:57 -0400 Subject: [PATCH 299/380] Update case.py --- examples/3D_lungwave/case.py | 29 ++++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/examples/3D_lungwave/case.py b/examples/3D_lungwave/case.py index 236cbd0978..46e4b67f58 100644 --- a/examples/3D_lungwave/case.py +++ b/examples/3D_lungwave/case.py @@ -27,7 +27,7 @@ Bl = 492.E+06 rhol = 996.0 c_l = 1540#1648.7 -G_l = 1.0E3 +G_l = 5.0E3 Cv_l = 1816 #primitive vartiables @@ -63,10 +63,14 @@ P_amp_n = P_amp/stress_char #geometry -dlengx = 10.*lambda_wave +amp = 0.12 +interface_amp = amp*lambda_wave +Namp = 10 + +dlengx = 6.*lambda_wave dlengy = 1.*lambda_wave/2. dlengz = 1.*lambda_wave/2. -Ny = 48 +Ny = int(Namp*0.5/amp) Nx = dlengx*Ny/dlengy Nz = dlengz*Ny/dlengy dx = dlengx/Nx @@ -79,15 +83,14 @@ alphag_lung = 0.99 alphal_lung = 1.0 - alphag_lung -interface_amp = 0.03*lambda_wave # time stepping requirements -time_end = 5.0e-5#1.5E-04 -cfl = 0.3 +time_end = 5.5e-5#1.5E-04 +cfl = 0.4 dt = cfl * dx/c_l_n Nt = int(time_end/dt) -Nframes = 500 +Nframes = 250 tstart = 0 tstop = Nt tsave = int(Nt/Nframes) @@ -111,13 +114,13 @@ 'p' : int(Nz), 'stretch_x' : 'T', 'a_x' : 4.0E+00, - 'x_a' : -3.*lambda_wave, - 'x_b' : 3.*lambda_wave, + 'x_a' : -2.*lambda_wave, + 'x_b' : 2.*lambda_wave, 'loops_x' : 2, 'dt' : dt, 't_step_start' : tstart, 't_step_stop' : tstop, - 't_step_save' : 10,#tsave, + 't_step_save' : tsave, # ========================================================================== # Simulation Algorithm Parameters ========================================== @@ -168,9 +171,9 @@ 'acoustic_source' : 'T', 'num_source' : 1, 'acoustic(1)%support' : 3, - 'acoustic(1)%loc(1)' : 0.1*lambda_wave, - 'acoustic(1)%loc(2)' : 0,#lambda_wave/2, - 'acoustic(1)%loc(3)' : 0, + 'acoustic(1)%loc(1)' : 1.0*lambda_wave, + 'acoustic(1)%loc(2)' : dlengy/2, + 'acoustic(1)%loc(3)' : dlengz/2, 'acoustic(1)%pulse' : 3, 'acoustic(1)%npulse' : 1, 'acoustic(1)%wavelength' : P_len, #wavelength of the signal From db99be8d3580a7f8be37c5199f7b5058bee22bd0 Mon Sep 17 00:00:00 2001 From: Nazarii Koval Date: Thu, 31 Oct 2024 16:52:20 -0500 Subject: [PATCH 300/380] added 2 print statements in the m_hyper --- src/pre_process/include/3dHardcodedIC.fpp | 11 +++++------ src/simulation/m_hyperelastic.fpp | 10 ++++++---- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp index 135123b5fe..bd64014d0a 100644 --- a/src/pre_process/include/3dHardcodedIC.fpp +++ b/src/pre_process/include/3dHardcodedIC.fpp @@ -57,16 +57,15 @@ end if case (302) ! (3D lung geometry in X direction - axisym, with smoothing) - h = 0.0 lam = 1.0*200.E-06 amp = patch_icpp(patch_id)%a2 + h = 0.25*amp - intH = amp/2*(sin(2*pi*y_cc(j)/lam + pi/2) + sin(2*pi*z_cc(k)/lam + pi/2))+h + intH = amp/2*(sin(2*pi*y_cc(j)/lam + pi/2) + sin(2*pi*z_cc(k)/lam + pi/2)) - alph = patch_icpp(2)%alpha(1) + (patch_icpp(1)%alpha(1)-patch_icpp(2)%alpha(1))/(amp)*(x_cc(i)-(intH-amp/2)) + alph = patch_icpp(2)%alpha(1) + (patch_icpp(1)%alpha(1)-patch_icpp(2)%alpha(1))/(h)*(x_cc(i)-(intH-h/2)) - ! Version 2 - if (x_cc(i) > intH + amp/2) then + if (x_cc(i) > intH + h/2) then q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1) q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2) @@ -74,7 +73,7 @@ q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2) q_prim_vf(E_idx)%sf(i, j, k) = patch_icpp(1)%pres - else if ((x_cc(i) .le. intH + amp/2) .and. (x_cc(i) .ge. intH - amp/2)) then + else if ((x_cc(i) .le. intH + h/2) .and. (x_cc(i) .ge. intH - h/2)) then q_prim_vf(advxb)%sf(i, j, k) = alph !0.5 q_prim_vf(advxe)%sf(i, j, k) = 1- alph !0.5 diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index a1aa96b3d7..c1d126cd37 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -155,6 +155,7 @@ contains !if ( G <= verysmall ) G_K = 0d0 if ( G > verysmall ) then + print *, 'G = ', G !$acc loop seq do i = 1, tensor_size tensora(i) = 0d0 @@ -196,6 +197,7 @@ contains + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) if (tensorb(tensor_size) > verysmall) then + print *, 'yay i got here' ! STEP 2c: computing the inverse of grad_xi tensor = F ! tensorb is the adjoint, tensora becomes F !$acc loop seq @@ -220,11 +222,11 @@ contains ! store the determinant at the last entry of the btensor btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) ! STEP 5a: updating the Cauchy stress primitive scalar field - if (hyper_model == 1) then + !if (hyper_model == 1) then call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) - elseif (hyper_model == 2) then - call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) - end if + !elseif (hyper_model == 2) then + ! call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) + !end if ! STEP 5b: updating the pressure field q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma From 17e8a19205a841e906ad106ec9cd3cac729d40e3 Mon Sep 17 00:00:00 2001 From: nkoval2003 <90657193+nkoval2003@users.noreply.github.com> Date: Thu, 31 Oct 2024 18:00:05 -0400 Subject: [PATCH 301/380] Update case.py --- examples/3D_lungwave/case.py | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/examples/3D_lungwave/case.py b/examples/3D_lungwave/case.py index 46e4b67f58..b5911fdbfb 100644 --- a/examples/3D_lungwave/case.py +++ b/examples/3D_lungwave/case.py @@ -63,9 +63,9 @@ P_amp_n = P_amp/stress_char #geometry -amp = 0.12 +amp = 0.5 interface_amp = amp*lambda_wave -Namp = 10 +Namp = 25 #20 # Dont Change dlengx = 6.*lambda_wave dlengy = 1.*lambda_wave/2. @@ -77,23 +77,25 @@ dy = dlengy/Ny dz = dlengz/Nz -alphal_back = 0.99 +alphal_back = 0.99999 alphag_back = 1.0 - alphal_back -alphag_lung = 0.99 +alphag_lung = 0.99999 alphal_lung = 1.0 - alphag_lung # time stepping requirements time_end = 5.5e-5#1.5E-04 -cfl = 0.4 +time_save = 0.01 +cfl = 0.5 # Should not change dt = cfl * dx/c_l_n Nt = int(time_end/dt) -Nframes = 250 tstart = 0 tstop = Nt -tsave = int(Nt/Nframes) +tsave = int(time_save*Nt) +#Nframes = 100 +#tsave = int(Nt/Nframes) # Configuring case dictionary print(json.dumps({ @@ -171,7 +173,7 @@ 'acoustic_source' : 'T', 'num_source' : 1, 'acoustic(1)%support' : 3, - 'acoustic(1)%loc(1)' : 1.0*lambda_wave, + 'acoustic(1)%loc(1)' : (amp+0.5)*lambda_wave, #1.0*lambda_wave, 'acoustic(1)%loc(2)' : dlengy/2, 'acoustic(1)%loc(3)' : dlengz/2, 'acoustic(1)%pulse' : 3, From d122b2e2a9c47ee38734645f1a11c5a4268d79bb Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 7 Nov 2024 15:40:53 -0600 Subject: [PATCH 302/380] adding small fixes to the code to improve the lung problem for APS DFD --- examples/3D_lungwave/case.py | 16 ++++++------- src/pre_process/include/3dHardcodedIC.fpp | 2 +- src/simulation/m_hyperelastic.fpp | 28 ++++++++++------------- src/simulation/m_rhs.fpp | 17 +++++--------- src/simulation/m_time_steppers.fpp | 2 +- submit_hyper.sh | 7 ++++-- 6 files changed, 33 insertions(+), 39 deletions(-) diff --git a/examples/3D_lungwave/case.py b/examples/3D_lungwave/case.py index b5911fdbfb..f966bad58f 100644 --- a/examples/3D_lungwave/case.py +++ b/examples/3D_lungwave/case.py @@ -65,7 +65,7 @@ #geometry amp = 0.5 interface_amp = amp*lambda_wave -Namp = 25 #20 # Dont Change +Namp = 60 #25 #20 # Dont Change dlengx = 6.*lambda_wave dlengy = 1.*lambda_wave/2. @@ -77,15 +77,15 @@ dy = dlengy/Ny dz = dlengz/Nz -alphal_back = 0.99999 +alphal_back = 1.0 - 1E-8 alphag_back = 1.0 - alphal_back -alphag_lung = 0.99999 +alphag_lung = 1.0 - 1E-8 alphal_lung = 1.0 - alphag_lung # time stepping requirements -time_end = 5.5e-5#1.5E-04 +time_end = 1E-5#5.5e-5#1.5E-04 time_save = 0.01 cfl = 0.5 # Should not change @@ -131,8 +131,8 @@ ####Change 'relax' : 'T', 'relax_model' : 5, - 'palpha_eps' : 1.0E-5, #check smaller -6/-8 - 'ptgalpha_eps' : 0.999, + 'palpha_eps' : 1.0E-8, #check smaller -6/-8 + 'ptgalpha_eps' : 1.0-1E-8, ########Change 'alt_soundspeed' : 'F', 'num_fluids' : 2, @@ -216,8 +216,8 @@ 'patch_icpp(2)%length_z' : 2*dlengz, 'patch_icpp(2)%a2' : interface_amp, 'patch_icpp(2)%vel(1)' : 0.E+00, - 'patch_icpp(2)%vel(2)' : 0.0, - 'patch_icpp(2)%vel(3)' : 0.0, + 'patch_icpp(2)%vel(2)' : 0.E+00, + 'patch_icpp(2)%vel(3)' : 0.E+00, 'patch_icpp(2)%pres' : patmos_n, 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp index bd64014d0a..38bc6fd3da 100644 --- a/src/pre_process/include/3dHardcodedIC.fpp +++ b/src/pre_process/include/3dHardcodedIC.fpp @@ -59,7 +59,7 @@ case (302) ! (3D lung geometry in X direction - axisym, with smoothing) lam = 1.0*200.E-06 amp = patch_icpp(patch_id)%a2 - h = 0.25*amp + h = 0.125*amp intH = amp/2*(sin(2*pi*y_cc(j)/lam + pi/2) + sin(2*pi*z_cc(k)/lam + pi/2)) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index c1d126cd37..23006222aa 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -137,11 +137,10 @@ contains real(kind(0d0)) :: G integer :: j, k, l, i, r - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, & - !$acc rho, gamma, pi_inf, qv, G, Re, tensora, tensorb) - do l = 0, p - do k = 0, n - do j = 0, m + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, rho, gamma, pi_inf, qv, G, Re, tensora, tensorb) + do l = 0, p + do k = 0, n + do j = 2, m-2 !$acc loop seq do i = 1, num_fluids alpha_rho_k(i) = q_cons_vf(i)%sf(j, k, l) @@ -152,10 +151,9 @@ contains alpha_rho_k, Re, j, k, l, G, Gs) rho = max(rho, sgm_eps) G = max(G, sgm_eps) - !if ( G <= verysmall ) G_K = 0d0 + !if ( G <= verysmall ) G = 0d0 if ( G > verysmall ) then - print *, 'G = ', G !$acc loop seq do i = 1, tensor_size tensora(i) = 0d0 @@ -197,7 +195,6 @@ contains + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) if (tensorb(tensor_size) > verysmall) then - print *, 'yay i got here' ! STEP 2c: computing the inverse of grad_xi tensor = F ! tensorb is the adjoint, tensora becomes F !$acc loop seq @@ -222,19 +219,18 @@ contains ! store the determinant at the last entry of the btensor btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) ! STEP 5a: updating the Cauchy stress primitive scalar field - !if (hyper_model == 1) then + if (hyper_model == 1) then call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) - !elseif (hyper_model == 2) then - ! call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) - !end if + elseif (hyper_model == 2) then + call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) + end if ! STEP 5b: updating the pressure field q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma ! STEP 5c: updating the Cauchy stress conservative scalar field !$acc loop seq do i = 1, b_size - 1 - q_cons_vf(strxb + i - 1)%sf(j, k, l) = & - rho*q_prim_vf(strxb + i - 1)%sf(j, k, l) + q_cons_vf(strxb+i-1)%sf(j, k, l) = rho*q_prim_vf(strxb+i-1)%sf(j, k, l) end do end if end if @@ -271,7 +267,7 @@ contains btensor(${IJ}$)%sf(j, k, l) = btensor(${IJ}$)%sf(j, k, l) - f13*trace #:endfor ! dividing by the jacobian for neo-Hookean model - ! setting the tensor to the stresses for riemann solver + ! setting the tensor to the stresses for Riemann solver !$acc loop seq do i = 1, b_size - 1 q_prim_vf(strxb + i - 1)%sf(j, k, l) = & @@ -279,7 +275,7 @@ contains end do ! compute the invariant without the elastic modulus q_prim_vf(xiend + 1)%sf(j, k, l) = & - 0.5d0*(trace - 3.0d0)/btensor(b_size)%sf(j, k, l) + 0.5d0*(trace - 3d0)/btensor(b_size)%sf(j, k, l) end subroutine s_neoHookean_cauchy_solver diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index f0b1d81411..f357969760 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -798,7 +798,7 @@ contains end do end do end if - !print *, "I got here A" + call nvtxStartRange("RHS-CONVERT") call s_convert_conservative_to_primitive_variables( & q_cons_qp%vf, & @@ -806,16 +806,16 @@ contains gm_alpha_qp%vf, & ix, iy, iz) call nvtxEndRange - !print *, "I got here B" call nvtxStartRange("RHS-MPI") call s_populate_variables_buffers(q_prim_qp%vf, pb, mv) - call nvtxEndRange - !print *, "I got here c" call nvtxStartRange("RHS-ELASTIC") - if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_qp%vf, q_prim_qp%vf) + if (hyperelasticity) then + call s_hyperelastic_rmt_stress_update(q_cons_qp%vf, q_prim_qp%vf) + call s_populate_variables_buffers(q_prim_qp%vf, pb, mv) + end if call nvtxEndRange if (cfl_dt) then @@ -947,7 +947,6 @@ contains flux_gsrc_n(id)%vf, & id, ix, iy, iz) call nvtxEndRange - !print *, "I got here e" ! =============================================================== ! Additional physics and source terms =========================== @@ -966,7 +965,6 @@ contains q_prim_qp%vf, & rhs_vf) call nvtxEndRange - !print *, "I got here f" ! RHS additions for viscosity call nvtxStartRange("RHS_add_phys") @@ -1067,8 +1065,6 @@ contains #:endif ! END: Additional pphysics and source terms ============================ - !print *, "I got here g" - if (run_time_info .or. probe_wrt .or. ib) then ix%beg = -buff_size; iy%beg = 0; iz%beg = 0 @@ -1095,9 +1091,8 @@ contains time_avg = 0d0 end if ! ================================================================== - !print *, "I got here h" - call nvtxEndRange + end subroutine s_compute_rhs subroutine s_compute_advection_source_term(idir, rhs_vf, q_cons_vf, q_prim_vf, flux_src_n_vf) diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 882c332048..588b55771c 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -863,7 +863,7 @@ contains end if call nvtxStartRange("RHS-ELASTIC") - if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_ts(1)%vf, q_prim_vf) + if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_ts(1)%vf, q_prim_vf) call nvtxEndRange if (adv_n) call s_comp_alpha_from_n(q_cons_ts(1)%vf) diff --git a/submit_hyper.sh b/submit_hyper.sh index ba197a9987..50690ec0b7 100755 --- a/submit_hyper.sh +++ b/submit_hyper.sh @@ -1,7 +1,10 @@ #!/bin/bash -./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar +#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta +./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 2 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 2 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 2 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta From eb799b7e705c8cac42ff97b63149df20508f2601 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 10 Nov 2024 21:30:01 -0600 Subject: [PATCH 303/380] adding the zero gradient boundary conditions --- src/simulation/m_boundary_conditions.fpp | 150 ++++++++++++++++++++--- 1 file changed, 135 insertions(+), 15 deletions(-) diff --git a/src/simulation/m_boundary_conditions.fpp b/src/simulation/m_boundary_conditions.fpp index 1df4fcc858..54d7f71310 100644 --- a/src/simulation/m_boundary_conditions.fpp +++ b/src/simulation/m_boundary_conditions.fpp @@ -27,6 +27,7 @@ contains !> The purpose of this procedure is to populate the buffers !! of the primitive variables, depending on the selected !! boundary conditions. + !! @param q_prim_vf Primitive variable subroutine s_populate_variables_buffers(q_prim_vf, pb, mv) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf @@ -220,24 +221,45 @@ contains real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: bc_dir, bc_loc integer :: j, k, l, q, i + real(kind(0d0)) :: bc_sum !< x-direction ========================================================= if (bc_dir == 1) then !< x-direction if (bc_loc == -1) then !bc_x%beg - !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size - do l = 0, p - do k = 0, n - do j = 1, buff_size - q_prim_vf(i)%sf(-j, k, l) = & - q_prim_vf(i)%sf(0, k, l) - end do + !$acc parallel loop collapse(4) gang vector default(present) + do i = 1, sys_size + do l = 0, p + do k = 0, n + do j = 1, buff_size + q_prim_vf(i)%sf(-j, k, l) = & + q_prim_vf(i)%sf(0, k, l) end do - end do - end do + end do + end do + end do + if (hyperelasticity) then + !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) + do j = 1, buff_size + do l = 0, p + do k = 0, n + do i = xibeg, xiend + bc_sum = 0d0 + !$acc loop seq + do q = 1, j + bc_sum = bc_sum - dx(-q) + end do + q_prim_vf(i)%sf(-j, k, l) = & + q_prim_vf(i)%sf(0, k, l) - bc_sum + end do + end do + end do + end do + !$acc end parallel loop + end if + else !< bc_x%end !$acc parallel loop collapse(4) gang vector default(present) @@ -247,11 +269,30 @@ contains do j = 1, buff_size q_prim_vf(i)%sf(m + j, k, l) = & q_prim_vf(i)%sf(m, k, l) - end do + end do end do end do end do + if (hyperelasticity) then + !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) + do j = 1, buff_size + do l = 0, p + do k = 0, n + do i = xibeg, xiend + bc_sum = 0d0 + !$acc loop seq + do q = 1, j + bc_sum = bc_sum + dx(m + q) + end do + q_prim_vf(i)%sf(m + j, k, l) = & + q_prim_vf(i)%sf(m, k, l) + bc_sum + end do + end do + end do + end do + !$acc end parallel loop + end if end if !< y-direction ========================================================= @@ -266,11 +307,31 @@ contains do l = -buff_size, m + buff_size q_prim_vf(i)%sf(l, -j, k) = & q_prim_vf(i)%sf(l, 0, k) - end do + end do end do end do end do + if (hyperelasticity) then + !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) + do j = 1, buff_size + do l = -buff_size, m + buff_size + do k = 0, p + do i = xibeg, xiend + bc_sum = 0d0 + !$acc loop seq + do q = 1, j + bc_sum = bc_sum - dy(-q) + end do + q_prim_vf(i)%sf(l, -j, k) = & + q_prim_vf(i)%sf(l, 0, k) - bc_sum + end do + end do + end do + end do + !$acc end parallel loop + end if + else !< bc_y%end !$acc parallel loop collapse(4) gang vector default(present) @@ -285,6 +346,26 @@ contains end do end do + if (hyperelasticity) then + !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) + do j = 1, buff_size + do l = -buff_size, m + buff_size + do k = 0, p + do i = xibeg, xiend + bc_sum = 0d0 + !$acc loop seq + do q = 1, j + bc_sum = bc_sum + dy(n + q) + end do + q_prim_vf(i)%sf(l, n + j, k) = & + q_prim_vf(i)%sf(l, n, k) + bc_sum + end do + end do + end do + end do + !$acc end parallel loop + end if + end if !< z-direction ========================================================= @@ -299,12 +380,31 @@ contains do k = -buff_size, m + buff_size q_prim_vf(i)%sf(k, l, -j) = & q_prim_vf(i)%sf(k, l, 0) - end do + end do end do end do end do - else !< bc_z%end + if (hyperelasticity) then + !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) + do j = 1, buff_size + do l = -buff_size, n + buff_size + do k = -buff_size, m + buff_size + do i = xibeg, xiend + bc_sum = 0d0 + !$acc loop seq + do q = 1, j + bc_sum = bc_sum - dx(-q) + end do + q_prim_vf(i)%sf(k, l, -j) = & + q_prim_vf(i)%sf(k, l, 0) - bc_sum + end do + end do + end do + end do + !$acc end parallel loop + end if + else !< bc_z%end !$acc parallel loop collapse(4) gang vector default(present) do i = 1, sys_size @@ -313,11 +413,31 @@ contains do k = -buff_size, m + buff_size q_prim_vf(i)%sf(k, l, p + j) = & q_prim_vf(i)%sf(k, l, p) - end do + end do end do end do end do + if (hyperelasticity) then + !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) + do j = 1, buff_size + do l = -buff_size, n + buff_size + do k = -buff_size, m + buff_size + do i = xibeg, xiend + bc_sum = 0d0 + !$acc loop seq + do q = 1, j + bc_sum = bc_sum + dz(p + q) + end do + q_prim_vf(i)%sf(k, l, p + j) = & + q_prim_vf(i)%sf(k, l, p) + bc_sum + end do + end do + end do + end do + !$acc end parallel loop + end if + end if end if From c9c3ee17efd9c654924f6a6f43dc7ed3810e23d2 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 12 Nov 2024 00:25:35 -0600 Subject: [PATCH 304/380] removing old speed of sound, there may older code that also needs to be removed, code compiles --- src/common/include/inline_conversions.fpp | 58 ----------------------- 1 file changed, 58 deletions(-) delete mode 100644 src/common/include/inline_conversions.fpp diff --git a/src/common/include/inline_conversions.fpp b/src/common/include/inline_conversions.fpp deleted file mode 100644 index cd008b54f9..0000000000 --- a/src/common/include/inline_conversions.fpp +++ /dev/null @@ -1,58 +0,0 @@ -#:def s_compute_speed_of_sound() - subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c) -#ifdef CRAY_ACC_WAR - !DIR$ INLINEALWAYS s_compute_speed_of_sound -#else - !$acc routine seq -#endif - real(kind(0d0)), intent(IN) :: pres - real(kind(0d0)), intent(IN) :: rho, gamma, pi_inf - real(kind(0d0)), intent(IN) :: H - real(kind(0d0)), dimension(num_fluids), intent(IN) :: adv - real(kind(0d0)), intent(IN) :: vel_sum - real(kind(0d0)), intent(OUT) :: c - real(kind(0d0)) :: blkmod1, blkmod2 - - integer :: q - - if (alt_soundspeed) then - blkmod1 = ((gammas(1) + 1d0)*pres + & - pi_infs(1))/gammas(1) - blkmod2 = ((gammas(2) + 1d0)*pres + & - pi_infs(2))/gammas(2) - c = (1d0/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2))) - - elseif (model_eqns == 3) then - c = 0d0 - !$acc loop seq - do q = 1, num_fluids - c = c + adv(q)*(1d0/gammas(q) + 1d0)* & - (pres + pi_infs(q)/(gammas(q) + 1d0)) - end do - c = c/rho - - elseif (((model_eqns == 4) .or. (model_eqns == 2 .and. bubbles))) then - ! Sound speed for bubble mmixture to order O(\alpha) - - if (mpp_lim .and. (num_fluids > 1)) then - c = (1d0/gamma + 1d0)* & - (pres + pi_inf/(gamma + 1d0))/rho - else - c = & - (1d0/gamma + 1d0)* & - (pres + pi_inf/(gamma + 1d0))/ & - (rho*(1d0 - adv(num_fluids))) - end if - - else - c = ((H - 5d-1*vel_sum)/gamma) - end if - - if (mixture_err .and. c < 0d0) then - c = 100.d0*sgm_eps - else - c = sqrt(c) - end if - end subroutine s_compute_speed_of_sound -#:enddef - From e8538526afcbf02a0df643b985e4af18c4f13b7a Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 12 Nov 2024 18:47:03 -0600 Subject: [PATCH 305/380] passes the test suite on Delta --- src/simulation/m_data_output.fpp | 2 +- submit_test.sh | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index aea9653e0e..c84affe620 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -1687,7 +1687,7 @@ contains !> Module deallocation and/or disassociation procedures subroutine s_finalize_data_output_module - deallocate (c_mass) + !deallocate (c_mass) ! Deallocating the ICFL, VCFL, CCFL, and Rc stability criteria @:DEALLOCATE_GLOBAL(icfl_sf) if (viscous) then diff --git a/submit_test.sh b/submit_test.sh index 2f79148e85..5ff8996980 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -46,7 +46,8 @@ #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 02:00:00 -# test1 -t simulation -c oscar #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar +./mfc.sh run tests/A21CF713/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta +./mfc.sh run tests/A21CF713/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta + -#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/finalruns/elcom/bubliq/25wv/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/finalruns/elcom/bubliq/75wv/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta From 5da51af98d4e86aa4eff2236e5bc6f9e3470e129 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 13 Nov 2024 15:11:09 -0600 Subject: [PATCH 306/380] still working on lung simulation --- examples/3D_lungwave/case.py | 16 ++++++++-------- src/simulation/m_checker.fpp | 2 +- submit_gpu_lung.sh | 6 ------ submit_lung.sh | 9 +++++++++ 4 files changed, 18 insertions(+), 15 deletions(-) delete mode 100755 submit_gpu_lung.sh create mode 100755 submit_lung.sh diff --git a/examples/3D_lungwave/case.py b/examples/3D_lungwave/case.py index f966bad58f..a9ce6e8c75 100644 --- a/examples/3D_lungwave/case.py +++ b/examples/3D_lungwave/case.py @@ -65,7 +65,7 @@ #geometry amp = 0.5 interface_amp = amp*lambda_wave -Namp = 60 #25 #20 # Dont Change +Namp = 50 #25 #20 # Dont Change dlengx = 6.*lambda_wave dlengy = 1.*lambda_wave/2. @@ -127,12 +127,12 @@ # Simulation Algorithm Parameters ========================================== 'num_patches' : 2, - 'model_eqns' : 3, + 'model_eqns' : 2, ####Change - 'relax' : 'T', - 'relax_model' : 5, - 'palpha_eps' : 1.0E-8, #check smaller -6/-8 - 'ptgalpha_eps' : 1.0-1E-8, + #'relax' : 'T', + #'relax_model' : 5, + #'palpha_eps' : 1.0E-8, #check smaller -6/-8 + #'ptgalpha_eps' : 1.0-1E-8, ########Change 'alt_soundspeed' : 'F', 'num_fluids' : 2, @@ -149,8 +149,8 @@ 'riemann_solver' : 2, 'wave_speeds' : 1, 'avg_state' : 2, - 'bc_x%beg' : -6, - 'bc_x%end' : -6, + 'bc_x%beg' : -3, + 'bc_x%end' : -3, 'bc_y%beg' : -2, # was -1 for all of them 'bc_y%end' : -2, 'bc_z%beg' : -2, diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index b45ac8f82f..d4cd906843 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -231,7 +231,7 @@ contains !> Checks constraints on hypoelasticity parameters subroutine s_check_inputs_hypoelasticity - @:PROHIBIT(hypoelasticity .and. riemann_solver /= 1, "hypoelasticity requires HLL Riemann solver (riemann_solver = 1)") + !@:PROHIBIT(hypoelasticity .and. riemann_solver /= 1, "hypoelasticity requires HLL Riemann solver (riemann_solver = 1)") end subroutine !> Checks constraints on bubble parameters diff --git a/submit_gpu_lung.sh b/submit_gpu_lung.sh deleted file mode 100755 index f83c9cdb0c..0000000000 --- a/submit_gpu_lung.sh +++ /dev/null @@ -1,6 +0,0 @@ -#!/bin/bash - -./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - diff --git a/submit_lung.sh b/submit_lung.sh new file mode 100755 index 0000000000..43ac497765 --- /dev/null +++ b/submit_lung.sh @@ -0,0 +1,9 @@ +#!/bin/bash + +#./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 2 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +#./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 2 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta +#./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta + +./mfc.sh run /scratch/bciv/rodrigu1/lung/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta +./mfc.sh run /scratch/bciv/rodrigu1/lung/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta + From 7570818454703c36a77b08f65bf245450f2f3c02 Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Mon, 18 Nov 2024 15:42:17 -0600 Subject: [PATCH 307/380] populate primitive variable buffer after hyperelasticity for stress in rhs --- src/simulation/m_rhs.fpp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 8b08e24ca5..1ad04bf69c 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -673,7 +673,10 @@ contains call nvtxEndRange call nvtxStartRange("RHS-ELASTIC") - if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_qp%vf, q_prim_qp%vf) + if (hyperelasticity) then + call s_hyperelastic_rmt_stress_update(q_cons_qp%vf, q_prim_qp%vf) + call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) + end if call nvtxEndRange if (cfl_dt) then From a251fa266d360416271b19254dd27f8828fc834a Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Mon, 18 Nov 2024 16:07:09 -0600 Subject: [PATCH 308/380] adding von Mises stress routine + post_process to output --- src/common/m_variables_conversion.fpp | 8 ++++++++ src/post_process/m_start_up.f90 | 5 +++++ 2 files changed, 13 insertions(+) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index fdc9c6c50e..958ed22eea 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1032,6 +1032,14 @@ contains qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K end do end if +#ifndef POST_PROCESS + ! to save von Mises stress instead of elastic internal energy + qK_prim_vf(xiend+1)%sf(j, k, l) = sqrt((3/2)*qK_prim_vf(1)%sf(j, k, l)**2 + & + 2*qK_prim_vf(2)%sf(j, k, l)**2 + qK_prim_vf(3)%sf(j, k, l)**2 + & + 2*qK_prim_vf(4)%sf(j, k, l)**2 + 2*qK_prim_vf(5)%sf(j, k, l)**2 + & + qK_prim_vf(6)%sf(j, k, l)**2) +#endif + end if !$acc loop seq do i = advxb, advxe diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index ca6f05f824..5d430f3c4f 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -385,6 +385,11 @@ subroutine s_save_data(t_step, varname, pres, c, H) write (varname, '(A,I0)') 'xi', i call s_write_variable_to_formatted_database_file(varname, t_step) end if + if (prim_vars_wrt) then + q_sf = q_prim_vf(xiend+1)%sf(j, k, l) + write (varname, '(A,I0)') 'vonMises' + call s_write_variable_to_formatted_database_file(varname, t_step) + end if varname(:) = ' ' end do end if From 939c639d91f72d18c952b3d2393eb225e78b07b7 Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Mon, 18 Nov 2024 17:36:59 -0600 Subject: [PATCH 309/380] von Mises compiles + fix of populate variable buffer in rhs for hyperelasticity --- src/common/m_variables_conversion.fpp | 1 - src/simulation/m_rhs.fpp | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 958ed22eea..4718408ad6 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1039,7 +1039,6 @@ contains 2*qK_prim_vf(4)%sf(j, k, l)**2 + 2*qK_prim_vf(5)%sf(j, k, l)**2 + & qK_prim_vf(6)%sf(j, k, l)**2) #endif - end if !$acc loop seq do i = advxb, advxe diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 1ad04bf69c..b036e0139f 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -675,7 +675,7 @@ contains call nvtxStartRange("RHS-ELASTIC") if (hyperelasticity) then call s_hyperelastic_rmt_stress_update(q_cons_qp%vf, q_prim_qp%vf) - call s_populate_primitive_variables_buffers(q_prim_qp%vf, pb, mv) + call s_populate_variables_buffers(q_prim_qp%vf, pb, mv) end if call nvtxEndRange From ef85e33f36ef40447167141d625dee9692c7d941 Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Mon, 18 Nov 2024 18:06:32 -0600 Subject: [PATCH 310/380] adding pre_stress hardcode patch --- src/pre_process/include/3dHardcodedIC.fpp | 32 +++++++++++++++++++++++ src/pre_process/m_assign_variables.fpp | 25 ++++++------------ 2 files changed, 40 insertions(+), 17 deletions(-) diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp index 7b75101514..a5ab5625e1 100644 --- a/src/pre_process/include/3dHardcodedIC.fpp +++ b/src/pre_process/include/3dHardcodedIC.fpp @@ -4,6 +4,11 @@ real(kind(0d0)) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph real(kind(0d0)) :: eps + + real(kind(0d0)) :: rcoord, theta, phi, xi_sph, x_bcen, y_bcen, z_bcen, Rinit + real(kind(0d0)) :: x_ccs, y_ccs, z_ccs + real(kind(0d0)), dimension(num_dims) :: xi_cart + integer :: l eps = 1e-9 #:enddef @@ -56,6 +61,33 @@ q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2) end if + case (302) ! pre_stress for hyperelasticity, bubble in material + R0ref = 30E-6 ! equilibrium radius + Rinit = patch_icpp(3)%radius ! initial radius + x_bcen = patch_icpp(3)%x_centroid + y_bcen = patch_icpp(3)%y_centroid + z_bcen = patch_icpp(3)%z_centroid + x_ccs = x_cc(i) - x_bcen + y_ccs = y_cc(j) - y_bcen + z_ccs = z_cc(k) - z_bcen + rcoord = sqrt(x_ccs**2 + y_ccs**2 + z_ccs**2) + phi = atan2(y_ccs, x_ccs) + theta = atan2(sqrt(x_ccs**2 + y_ccs**2), z_ccs) + !spherical coord, assuming Rmax=1 + xi_sph = (rcoord**3 - R0ref**3 + Rinit**3)**(1d0/3d0) + xi_cart(1) = xi_sph*sin(theta)*cos(phi) + xi_cart(2) = xi_sph*sin(theta)*sin(phi) + xi_cart(3) = xi_sph*cos(theta) + ! shift back + xi_cart(1) = xi_cart(1) + x_bcen + xi_cart(2) = xi_cart(2) + y_bcen + xi_cart(3) = xi_cart(3) + z_bcen +! print *, 'xi_cart(1) ::', xi_cart(1), 'xi_cart(2) ::', xi_cart(2), 'xi_cart(3) ::', xi_cart(3) + ! assigning the reference map to the q_prim vector field + do l = 1, 3 + q_prim_vf(l + xibeg - 1)%sf(i, j, k) = xi_cart(l) + end do + ! Put your variable assignments here case default call s_int_to_str(patch_id, iStr) diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp index ef70905f24..87973d7706 100644 --- a/src/pre_process/m_assign_variables.fpp +++ b/src/pre_process/m_assign_variables.fpp @@ -500,29 +500,20 @@ contains end if ! Elastic Shear Stress - if (hyperelasticity) then - - if (pre_stress) then ! pre stressed initial condition in spatial domain - rcoord = sqrt((x_cc(j)**2 + y_cc(k)**2 + z_cc(l)**2)) - theta = atan2(y_cc(k), x_cc(j)) - phi = atan2(sqrt(x_cc(j)**2 + y_cc(k)**2), z_cc(l)) - !spherical coord, assuming Rmax=1 - xi_sph = (rcoord**3 - R0ref**3 + 1d0)**(1d0/3d0) - xi_cart(1) = xi_sph*sin(phi)*cos(theta) - xi_cart(2) = xi_sph*sin(phi)*sin(theta) - xi_cart(3) = xi_sph*cos(phi) - else - xi_cart(1) = x_cc(j) - xi_cart(2) = y_cc(k) - xi_cart(3) = z_cc(l) + if (hyperelasticity .and. .not. pre_stress) then + xi_cart(1) = x_cc(j) + if (p > 0) then + xi_cart(2) = y_cc(k) + xi_cart(3) = z_cc(l) + elseif (n > 0) then + xi_cart(2) = y_cc(k) end if ! assigning the reference map to the q_prim vector field do i = 1, num_dims - q_prim_vf(i + xibeg - 1)%sf(j, k, l) = eta*xi_cart(i) + & + q_prim_vf(i + xibeg - 1)%sf(j, k, l) = eta*xi_cart(i) + & (1d0 - eta)*orig_prim_vf(i + xibeg - 1) end do - end if if (mpp_lim .and. bubbles) then From 7312231a820164e05531e30088ea20ff4f369e71 Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Mon, 18 Nov 2024 21:55:06 -0600 Subject: [PATCH 311/380] outline for kymograph: step 1 - kymograph flag added in post_process --- src/post_process/m_global_parameters.fpp | 2 ++ src/post_process/m_mpi_proxy.fpp | 2 +- src/post_process/m_start_up.f90 | 14 +++++++++++++- 3 files changed, 16 insertions(+), 2 deletions(-) diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index a319222a2a..cca095f85d 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -154,6 +154,7 @@ module m_global_parameters logical :: parallel_io !< Format of the data files logical :: sim_data logical :: file_per_process !< output format + logical :: kymograph integer, allocatable, dimension(:) :: proc_coords !< !! Processor coordinates in MPI_CART_COMM @@ -392,6 +393,7 @@ contains qm_wrt = .false. schlieren_wrt = .false. sim_data = .false. + kymograph = .false. cf_wrt = .false. ib = .false. diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp index c7b0f4a9f5..3c22b98169 100644 --- a/src/post_process/m_mpi_proxy.fpp +++ b/src/post_process/m_mpi_proxy.fpp @@ -197,7 +197,7 @@ contains #:for VAR in [ 'cyl_coord', 'mpp_lim', 'mixture_err', & & 'alt_soundspeed', 'hypoelasticity', 'parallel_io', 'rho_wrt', & - & 'E_wrt', 'pres_wrt', 'gamma_wrt', 'sim_data', & + & 'E_wrt', 'pres_wrt', 'gamma_wrt', 'sim_data', 'kymograph', & & 'heat_ratio_wrt', 'pi_inf_wrt', 'pres_inf_wrt', 'cons_vars_wrt', & & 'prim_vars_wrt', 'c_wrt', 'qm_wrt','schlieren_wrt', 'bubbles', 'qbmm', & & 'polytropic', 'polydisperse', 'file_per_process', 'relax', 'cf_wrt', & diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 5d430f3c4f..dc606ab46c 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -83,7 +83,7 @@ subroutine s_read_input_file relax_model, cf_wrt, sigma, adv_n, ib, num_ibs, & cfl_adap_dt, cfl_const_dt, t_save, t_stop, n_start, & cfl_target, surface_tension & - sim_data, hyperelasticity + sim_data, hyperelasticity, kymograph ! Inquiring the status of the post_process.inp file file_loc = 'post_process.inp' @@ -205,6 +205,14 @@ subroutine s_save_data(t_step, varname, pres, c, H) call s_write_energy_data_file(q_prim_vf, q_cons_vf) end if + if (kymograph .and. proc_rank == 0) then + call s_open_kymo_data_file() + end if + + if (kymograph) then + call s_write_kymo_data_file(q_prim_vf) + end if + ! Adding the grid to the formatted database file call s_write_grid_to_formatted_database_file(t_step) @@ -709,6 +717,10 @@ subroutine s_save_data(t_step, varname, pres, c, H) call s_close_energy_data_file() end if + if (kymograph .and. proc_rank == 0) then + call s_close_kymo_data_file() + end if + ! Closing the formatted database file call s_close_formatted_database_file() From 432f91584242dbe4dfc4b9824c1d9b3cb29cf8ef Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Mon, 18 Nov 2024 22:25:49 -0600 Subject: [PATCH 312/380] step 2 - kymo_data_file outline --- src/post_process/m_data_output.fpp | 32 +++++++++++++++++++++++++++++- src/post_process/m_start_up.f90 | 2 +- 2 files changed, 32 insertions(+), 2 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 599fc538b6..29b301c72f 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -31,13 +31,16 @@ module m_data_output s_open_formatted_database_file, & s_open_intf_data_file, & s_open_energy_data_file, & + s_open_kymo_data_file, & s_write_grid_to_formatted_database_file, & s_write_variable_to_formatted_database_file, & s_write_intf_data_file, & s_write_energy_data_file, & + s_write_kymo_data_file, & s_close_formatted_database_file, & s_close_intf_data_file, & s_close_energy_data_file, & + s_close_kymo_data_file, & s_finalize_data_output_module ! Including the Silo Fortran interface library that features the subroutines @@ -570,7 +573,23 @@ contains end subroutine s_open_energy_data_file ! ---------------------------------------- - subroutine s_write_grid_to_formatted_database_file(t_step) ! ----------- + subroutine s_open_kymo_data_file() ! ------------------------ + + character(LEN=path_len + 3*name_len) :: file_path !< + !! Relative path to a file in the case directory + + write (file_path, '(A)') '/kymo_data.dat' + file_path = trim(case_dir)//trim(file_path) + + ! Opening the simulation data file + open (251, FILE=trim(file_path), & + FORM='formatted', & + POSITION='append', & + STATUS='unknown') + + end subroutine s_open_kymo_data_file ! ---------------------------------------- + + subroutine s_write_grid_to_formatted_database_file(t_step) ! ----------- ! Description: The general objective of this subroutine is to write the ! necessary grid data to the formatted database file, for @@ -1168,6 +1187,11 @@ contains end subroutine s_write_energy_data_file + subroutine s_write_kymo_data_file + + + end subroutine s_write_kymo_data_file + subroutine s_close_formatted_database_file() ! ------------------------- ! Description: The purpose of this subroutine is to close any formatted ! database file(s) that may be opened at the time-step that @@ -1207,6 +1231,12 @@ contains end subroutine s_close_energy_data_file !--------------------- + subroutine s_close_kymo_data_file() + + close (251) + + end subroutine s_close_kymo_data_file + subroutine s_finalize_data_output_module() ! ------------------------- ! Description: Deallocation procedures for the module diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index dc606ab46c..0734c7681b 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -210,7 +210,7 @@ subroutine s_save_data(t_step, varname, pres, c, H) end if if (kymograph) then - call s_write_kymo_data_file(q_prim_vf) + call s_write_kymo_data_file() end if ! Adding the grid to the formatted database file From 0c9f354331514b01ed7f8e24ed0d211793b6c55b Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 18 Nov 2024 23:17:14 -0600 Subject: [PATCH 313/380] code not compiling --- src/common/m_variables_conversion.fpp | 3 ++- src/post_process/m_start_up.f90 | 36 ++++++++++++++++----------- 2 files changed, 23 insertions(+), 16 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 4718408ad6..ff7f8b325c 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1032,7 +1032,8 @@ contains qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K end do end if -#ifndef POST_PROCESS + +#ifdef MFC_POST_PROCESS ! to save von Mises stress instead of elastic internal energy qK_prim_vf(xiend+1)%sf(j, k, l) = sqrt((3/2)*qK_prim_vf(1)%sf(j, k, l)**2 + & 2*qK_prim_vf(2)%sf(j, k, l)**2 + qK_prim_vf(3)%sf(j, k, l)**2 + & diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 5d430f3c4f..d4b11d8e87 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -363,35 +363,41 @@ subroutine s_save_data(t_step, varname, pres, c, H) ! ---------------------------------------------------------------------- ! Adding the elastic shear stresses to the formatted database file ----- if (elasticity) then - do i = 1, stress_idx%end - stress_idx%beg + 1 - if (prim_vars_wrt) then + if (prim_vars_wrt) then + do i = 1, stress_idx%end - stress_idx%beg + 1 q_sf = q_prim_vf(i - 1 + stress_idx%beg)%sf( & -offset_x%beg:m + offset_x%end, & -offset_y%beg:n + offset_y%end, & -offset_z%beg:p + offset_z%end) + write (varname, '(A,I0)') 'tau', i call s_write_variable_to_formatted_database_file(varname, t_step) - end if - varname(:) = ' ' - end do + + varname(:) = ' ' + end do + end if end if if (hyperelasticity) then - do i = 1, xiend - xibeg + 1 - if (prim_vars_wrt) then + if (prim_vars_wrt) then + do i = 1, xiend - xibeg + 1 q_sf = q_prim_vf(i - 1 + xibeg)%sf( & -offset_x%beg:m + offset_x%end, & -offset_y%beg:n + offset_y%end, & -offset_z%beg:p + offset_z%end) + write (varname, '(A,I0)') 'xi', i call s_write_variable_to_formatted_database_file(varname, t_step) - end if - if (prim_vars_wrt) then - q_sf = q_prim_vf(xiend+1)%sf(j, k, l) - write (varname, '(A,I0)') 'vonMises' - call s_write_variable_to_formatted_database_file(varname, t_step) - end if - varname(:) = ' ' - end do + + varname(:) = ' ' + end do + + q_sf = q_prim_vf(xiend+1)%sf(j, k, l) + write (varname, '(A,I0)') 'vonMises' + call s_write_variable_to_formatted_database_file(varname, t_step) + + varname(:) = ' ' + + end if end if ! ---------------------------------------------------------------------- From 2bcee9ed517ff44bed638164b8fd5a0db17ac864 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 19 Nov 2024 09:15:53 -0600 Subject: [PATCH 314/380] fixed issues with von Mises calculation --- src/common/m_variables_conversion.fpp | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index ff7f8b325c..fdef29deeb 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1035,10 +1035,10 @@ contains #ifdef MFC_POST_PROCESS ! to save von Mises stress instead of elastic internal energy - qK_prim_vf(xiend+1)%sf(j, k, l) = sqrt((3/2)*qK_prim_vf(1)%sf(j, k, l)**2 + & - 2*qK_prim_vf(2)%sf(j, k, l)**2 + qK_prim_vf(3)%sf(j, k, l)**2 + & - 2*qK_prim_vf(4)%sf(j, k, l)**2 + 2*qK_prim_vf(5)%sf(j, k, l)**2 + & - qK_prim_vf(6)%sf(j, k, l)**2) + qK_prim_vf(xiend+1)%sf(j, k, l) = sqrt((3d0/2d0)* (qK_prim_vf(1)%sf(j, k, l)**2d0 + & + 2d0*qK_prim_vf(2)%sf(j, k, l)**2d0 + qK_prim_vf(3)%sf(j, k, l)**2d0 + & + 2d0*qK_prim_vf(4)%sf(j, k, l)**2d0 + 2d0*qK_prim_vf(5)%sf(j, k, l)**2d0 + & + qK_prim_vf(6)%sf(j, k, l)**2d0) ) #endif !$acc loop seq @@ -1055,7 +1055,6 @@ contains end do !$acc end parallel loop - !print *, 'I got here AA' end subroutine s_convert_conservative_to_primitive_variables ! --------- From bc102c827d2012b3365dd319f6126c87d39cdc4f Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Tue, 19 Nov 2024 09:23:44 -0600 Subject: [PATCH 315/380] incremental step 2 --- src/post_process/m_data_output.fpp | 14 ++++++++++++-- src/post_process/m_start_up.f90 | 2 +- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 29b301c72f..19ac0aa2ba 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -1187,8 +1187,18 @@ contains end subroutine s_write_energy_data_file - subroutine s_write_kymo_data_file - + subroutine s_write_kymo_data_file(q_prim_vf) + type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf + integer :: j, k, l, t !< Generic loop iterators + + do l = 0, p + do k = 0, n + do j = 0, m + + end do + end do + end do + end subroutine s_write_kymo_data_file diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 0734c7681b..dc606ab46c 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -210,7 +210,7 @@ subroutine s_save_data(t_step, varname, pres, c, H) end if if (kymograph) then - call s_write_kymo_data_file() + call s_write_kymo_data_file(q_prim_vf) end if ! Adding the grid to the formatted database file From 00479410cb11c7dceb11bd249d109026b317f3ac Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 19 Nov 2024 22:21:26 -0600 Subject: [PATCH 316/380] resolved namelist issue in post_process --- src/post_process/m_start_up.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 5d430f3c4f..c85be23fbc 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -82,7 +82,7 @@ subroutine s_read_input_file polydisperse, poly_sigma, file_per_process, relax, & relax_model, cf_wrt, sigma, adv_n, ib, num_ibs, & cfl_adap_dt, cfl_const_dt, t_save, t_stop, n_start, & - cfl_target, surface_tension & + cfl_target, surface_tension, & sim_data, hyperelasticity ! Inquiring the status of the post_process.inp file From dc993e1cb27222dae1ca7b037089f61c007a976b Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 20 Nov 2024 23:47:19 -0600 Subject: [PATCH 317/380] operational code for APS DFD 2024 --- src/common/m_phase_change.fpp | 4 ++-- src/common/m_variables_conversion.fpp | 12 ++++++------ src/simulation/m_hyperelastic.fpp | 8 ++++---- submit_test.sh | 3 +-- 4 files changed, 13 insertions(+), 14 deletions(-) diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index a56d74e91c..d2dc0128b6 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -349,7 +349,7 @@ contains ns = 0 ! change this relative error metric. 1E4 is arbitrary do while ((DABS(pS - pO) > palpha_eps) .and. & - (DABS((pS - pO)/pO) > palpha_eps/1d4) .or. (ns == 0)) + (DABS((pS - pO)/pO) > palpha_eps/1d0) .or. (ns == 0)) ! increasing counter ns = ns + 1 @@ -443,7 +443,7 @@ contains R2D(1) = 0.0d0; R2D(2) = 0.0d0 DeltamP(1) = 0.0d0; DeltamP(2) = 0.0d0 do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & - .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) & + .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d0))) & .or. (ns == 0)) ! Updating counter for the iterative procedure diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 4718408ad6..9f607a83d4 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1031,14 +1031,14 @@ contains do i = xibeg, xiend qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K end do - end if -#ifndef POST_PROCESS +#ifndef MFC_POST_PROCESS ! to save von Mises stress instead of elastic internal energy - qK_prim_vf(xiend+1)%sf(j, k, l) = sqrt((3/2)*qK_prim_vf(1)%sf(j, k, l)**2 + & - 2*qK_prim_vf(2)%sf(j, k, l)**2 + qK_prim_vf(3)%sf(j, k, l)**2 + & - 2*qK_prim_vf(4)%sf(j, k, l)**2 + 2*qK_prim_vf(5)%sf(j, k, l)**2 + & - qK_prim_vf(6)%sf(j, k, l)**2) + qK_prim_vf(xiend+1)%sf(j, k, l) = sqrt( (3d0/2d0) * (qK_prim_vf(1)%sf(j, k, l)**2d0 + & + 2d0*qK_prim_vf(2)%sf(j, k, l)**2d0 + qK_prim_vf(3)%sf(j, k, l)**2d0 + & + 2d0*qK_prim_vf(4)%sf(j, k, l)**2d0 + 2d0*qK_prim_vf(5)%sf(j, k, l)**2d0 + & + qK_prim_vf(6)%sf(j, k, l)**2d0) ) #endif + end if !$acc loop seq do i = advxb, advxe diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 5c6a9d948d..a7ce128d81 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -213,11 +213,11 @@ contains ! store the determinant at the last entry of the btensor btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) ! STEP 5a: updating the Cauchy stress primitive scalar field - if (hyper_model == 1) then + !if (hyper_model == 1) then call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) - elseif (hyper_model == 2) then - call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) - end if + !elseif (hyper_model == 2) then + ! call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) + !end if ! STEP 5b: updating the pressure field q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma diff --git a/submit_test.sh b/submit_test.sh index 5ff8996980..f1aa1c7f3c 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -46,8 +46,7 @@ #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 02:00:00 -# test1 -t simulation -c oscar #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar -./mfc.sh run tests/A21CF713/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run tests/A21CF713/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t simulation -c delta +./mfc.sh run /projects/bciv/rodrigu1/dfd2024/bubgel/geldef.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process simulation -c delta From 2bc57fbc2edebccca0388de883a7502669fb0f07 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Thu, 21 Nov 2024 20:44:25 -0600 Subject: [PATCH 318/380] debugged post_process --- src/common/m_variables_conversion.fpp | 12 +++++++----- src/post_process/m_start_up.f90 | 7 +++++-- src/simulation/m_hyperelastic.fpp | 4 ++-- src/simulation/m_rhs.fpp | 2 +- src/simulation/m_riemann_solvers.fpp | 2 +- submit_test.sh | 4 +++- 6 files changed, 19 insertions(+), 12 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 824706726b..5c550e8068 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1031,15 +1031,17 @@ contains do i = xibeg, xiend qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K end do + end if #ifdef MFC_POST_PROCESS + if (hyperelasticity) then ! to save von Mises stress instead of elastic internal energy - qK_prim_vf(xiend+1)%sf(j, k, l) = sqrt((3d0/2d0)* (qK_prim_vf(1)%sf(j, k, l)**2d0 + & - 2d0*qK_prim_vf(2)%sf(j, k, l)**2d0 + qK_prim_vf(3)%sf(j, k, l)**2d0 + & - 2d0*qK_prim_vf(4)%sf(j, k, l)**2d0 + 2d0*qK_prim_vf(5)%sf(j, k, l)**2d0 + & - qK_prim_vf(6)%sf(j, k, l)**2d0) ) -#endif + qK_prim_vf(xiend+1)%sf(j, k, l) = sqrt((3d0/2d0)* (qK_prim_vf(strxb)%sf(j, k, l)**2d0 + & + 2d0*qK_prim_vf(strxb+1)%sf(j, k, l)**2d0 + qK_prim_vf(strxb+2)%sf(j, k, l)**2d0 + & + 2d0*qK_prim_vf(strxb+3)%sf(j, k, l)**2d0 + 2d0*qK_prim_vf(strxb+4)%sf(j, k, l)**2d0 + & + qK_prim_vf(strxe)%sf(j, k, l)**2d0) ) end if +#endif !$acc loop seq do i = advxb, advxe diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 3f572c5c2b..512112f130 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -391,10 +391,13 @@ subroutine s_save_data(t_step, varname, pres, c, H) varname(:) = ' ' end do - q_sf = q_prim_vf(xiend+1)%sf(j, k, l) + q_sf = q_prim_vf(xiend+1)%sf( & + -offset_x%beg:m + offset_x%end, & + -offset_y%beg:n + offset_y%end, & + -offset_z%beg:p + offset_z%end) + write (varname, '(A,I0)') 'vonMises' call s_write_variable_to_formatted_database_file(varname, t_step) - varname(:) = ' ' end if diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 24d6fb675b..d2319ce9e6 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -131,8 +131,8 @@ contains integer :: j, k, l, i, r !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, rho, gamma, pi_inf, qv, G, Re, tensora, tensorb) - do l = 0, p - do k = 0, n + do l = 0, p-2 + do k = 0, n-2 do j = 2, m-2 !$acc loop seq do i = 1, num_fluids diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 3e7b074738..e52121cbc3 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -718,7 +718,7 @@ contains call nvtxStartRange("RHS-WENO") if (.not. surface_tension) then - ! Reconstruct densitiess + ! Reconstruct densities iv%beg = 1; iv%end = sys_size call s_reconstruct_cell_boundary_values( & q_prim_qp%vf(1:sys_size), & diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 58c0f446e9..43160fa90f 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -1180,7 +1180,7 @@ contains xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) end do - G_L = 0d0; G_R = 0d0; + G_L = 0d0; G_R = 0d0 !$acc loop seq do i = 1, num_fluids ! Mixture left and right shear modulus diff --git a/submit_test.sh b/submit_test.sh index f1aa1c7f3c..dece0092ed 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -46,7 +46,9 @@ #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 02:00:00 -# test1 -t simulation -c oscar #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar -./mfc.sh run /projects/bciv/rodrigu1/dfd2024/bubgel/geldef.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process simulation -c delta +#./mfc.sh run /projects/bciv/rodrigu1/dfd2024/bubgel/geldef.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process simulation -c delta +#./mfc.sh run /projects/bciv/rodrigu1/dfd2024/bubgel/geldef.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process post_process -c delta +./mfc.sh run /projects/bciv/rodrigu1/dfd2024/bubgel/geldef.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta From a8abfede423426f45bffb8bb2e20f31a4dab7caf Mon Sep 17 00:00:00 2001 From: mcarcana Date: Fri, 22 Nov 2024 00:42:53 -0500 Subject: [PATCH 319/380] step 3: extracting vonMises stress for selected 1D line in domain --- src/post_process/m_data_output.fpp | 30 ++++++++++++++++++------------ src/post_process/m_start_up.f90 | 4 ++-- 2 files changed, 20 insertions(+), 14 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 19ac0aa2ba..ba7f702b73 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -573,12 +573,16 @@ contains end subroutine s_open_energy_data_file ! ---------------------------------------- - subroutine s_open_kymo_data_file() ! ------------------------ + subroutine s_open_kymo_data_file(t_step) ! ------------------------ + ! Time-step that is currently being post-processed + integer, intent(in) :: t_step - character(LEN=path_len + 3*name_len) :: file_path !< - !! Relative path to a file in the case directory + ! Relative path to a file in the case directory + character(LEN=path_len + 3*name_len) :: file_path - write (file_path, '(A)') '/kymo_data.dat' + ! Kymo information is in binary database format + ! Generates relative path to database, opened for current time-step + write (file_path, '(A,I0,A)') '/', t_step, '/kymo_data.dat' file_path = trim(case_dir)//trim(file_path) ! Opening the simulation data file @@ -1190,15 +1194,17 @@ contains subroutine s_write_kymo_data_file(q_prim_vf) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer :: j, k, l, t !< Generic loop iterators - - do l = 0, p - do k = 0, n - do j = 0, m - - end do - end do + real(kind(0d0)) :: vonMises !< selected planes for kymograph comparison + + do t = 0, t_stop + do j = 0, m + vonMises = q_prim_vf(xiend+1)%sf(j, 0, 0) + if (proc_rank == 0) then + write (251, '(10X, 8F24.8)') & + vonMises + end if + end do end do - end subroutine s_write_kymo_data_file diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index dc606ab46c..a3b32239e1 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -82,7 +82,7 @@ subroutine s_read_input_file polydisperse, poly_sigma, file_per_process, relax, & relax_model, cf_wrt, sigma, adv_n, ib, num_ibs, & cfl_adap_dt, cfl_const_dt, t_save, t_stop, n_start, & - cfl_target, surface_tension & + cfl_target, surface_tension, & sim_data, hyperelasticity, kymograph ! Inquiring the status of the post_process.inp file @@ -206,7 +206,7 @@ subroutine s_save_data(t_step, varname, pres, c, H) end if if (kymograph .and. proc_rank == 0) then - call s_open_kymo_data_file() + call s_open_kymo_data_file(t_step) end if if (kymograph) then From 1a369de1506e0735dde427bc33a6ef1b12a83659 Mon Sep 17 00:00:00 2001 From: mcarcana Date: Fri, 22 Nov 2024 02:05:38 -0500 Subject: [PATCH 320/380] one approach to saving d, h_1, h_2 von Mises stress --- src/post_process/m_data_output.fpp | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index ba7f702b73..de2ebb3c73 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -1198,11 +1198,25 @@ contains do t = 0, t_stop do j = 0, m - vonMises = q_prim_vf(xiend+1)%sf(j, 0, 0) - if (proc_rank == 0) then - write (251, '(10X, 8F24.8)') & - vonMises - end if + do k = 0, n + ! for bubliq, sf(j,0,0) for d and sf(0.5*xcen_bub,k,0) for h + ! for bubgel, sf(j,0,0) for d, sf(-xcen_bub,k,0) for h_1, + ! sf(-0.5*xcen_bub,k,0) for h_2 + vonMises_d = q_prim_vf(xiend+1)%sf(j, 0, 0) + if (xcen_bub < 0) then !liq + vonMises_h1 = q_prim_vf(xiend+1)%sf(xcen_bub, k, 0) + vonMises_h2 = q_prim_vf(xiend+1)%sf(0.25*xcen_bub, k, 0) + else + vonMises_h1 = q_prim_vf(xiend+1)%sf(-xcen_bub, k, 0) + vonMises_h2 = q_prim_vf(xiend+1)%sf(-0.25*xcen_bub, k, 0) + end if + if (proc_rank == 0) then + write (251, '(10X, 8F24.8)') & + vonMises_d, & + vonMises_h1, & + vonMises_h2 + end if + end do end do end do From 1e3bd31dc98bbf54c9b1a676f519e1698b0d4392 Mon Sep 17 00:00:00 2001 From: mcarcana Date: Fri, 22 Nov 2024 02:10:50 -0500 Subject: [PATCH 321/380] alternative to saving d, h_1, h_2 von Mises stress --- src/post_process/m_data_output.fpp | 41 +++++++++++++++++------------- 1 file changed, 24 insertions(+), 17 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index de2ebb3c73..e4cdd525b8 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -1198,28 +1198,35 @@ contains do t = 0, t_stop do j = 0, m - do k = 0, n ! for bubliq, sf(j,0,0) for d and sf(0.5*xcen_bub,k,0) for h ! for bubgel, sf(j,0,0) for d, sf(-xcen_bub,k,0) for h_1, ! sf(-0.5*xcen_bub,k,0) for h_2 - vonMises_d = q_prim_vf(xiend+1)%sf(j, 0, 0) - if (xcen_bub < 0) then !liq - vonMises_h1 = q_prim_vf(xiend+1)%sf(xcen_bub, k, 0) - vonMises_h2 = q_prim_vf(xiend+1)%sf(0.25*xcen_bub, k, 0) - else - vonMises_h1 = q_prim_vf(xiend+1)%sf(-xcen_bub, k, 0) - vonMises_h2 = q_prim_vf(xiend+1)%sf(-0.25*xcen_bub, k, 0) - end if - if (proc_rank == 0) then - write (251, '(10X, 8F24.8)') & - vonMises_d, & - vonMises_h1, & - vonMises_h2 - end if - end do - end do + vonMises_d = q_prim_vf(xiend+1)%sf(j, 0, 0) + end do + end do + + do t = 0, t_stop + do k = 0, n + ! for bubliq, sf(j,0,0) for d and sf(0.5*xcen_bub,k,0) for h + ! for bubgel, sf(j,0,0) for d, sf(-xcen_bub,k,0) for h_1, + ! sf(-0.5*xcen_bub,k,0) for h_2 + if (xcen_bub < 0) then !liq + vonMises_h1 = q_prim_vf(xiend+1)%sf(xcen_bub, k, 0) + vonMises_h2 = q_prim_vf(xiend+1)%sf(0.25*xcen_bub, k, 0) + else + vonMises_h1 = q_prim_vf(xiend+1)%sf(-xcen_bub, k, 0) + vonMises_h2 = q_prim_vf(xiend+1)%sf(-0.25*xcen_bub, k, 0) + end if + end do end do + if (proc_rank == 0) then + write (251, '(10X, 8F24.8)') & + vonMises_d, & + vonMises_h1, & + vonMises_h2 + end if + end subroutine s_write_kymo_data_file subroutine s_close_formatted_database_file() ! ------------------------- From f2a9e0f71e85aac14a97442df6c4aef2e522ca3b Mon Sep 17 00:00:00 2001 From: mcarcana Date: Fri, 22 Nov 2024 02:46:23 -0500 Subject: [PATCH 322/380] kymograph tentatively done, compiles, need to test next --- src/post_process/m_data_output.fpp | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index e4cdd525b8..3fd50901da 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -1194,7 +1194,9 @@ contains subroutine s_write_kymo_data_file(q_prim_vf) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer :: j, k, l, t !< Generic loop iterators - real(kind(0d0)) :: vonMises !< selected planes for kymograph comparison + real(kind(0d0)) :: vonMises_d, vonMises_h1 !< selected planes for kymograph comparison + real(kind(0d0)) :: vonMises_h2, vonMises_h3 ! Date: Fri, 22 Nov 2024 19:14:54 -0600 Subject: [PATCH 323/380] issues in vonMises addressed --- src/common/m_variables_conversion.fpp | 10 +++++----- src/post_process/m_start_up.f90 | 5 ++++- submit_hyper.sh | 5 +---- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 4718408ad6..6c079c4a32 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1032,12 +1032,12 @@ contains qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l)/rho_K end do end if -#ifndef POST_PROCESS +#ifndef MFC_POST_PROCESS ! to save von Mises stress instead of elastic internal energy - qK_prim_vf(xiend+1)%sf(j, k, l) = sqrt((3/2)*qK_prim_vf(1)%sf(j, k, l)**2 + & - 2*qK_prim_vf(2)%sf(j, k, l)**2 + qK_prim_vf(3)%sf(j, k, l)**2 + & - 2*qK_prim_vf(4)%sf(j, k, l)**2 + 2*qK_prim_vf(5)%sf(j, k, l)**2 + & - qK_prim_vf(6)%sf(j, k, l)**2) + qK_prim_vf(xiend+1)%sf(j, k, l) = sqrt((3d0/2d0)*(qK_prim_vf(strxb)%sf(j, k, l)**2d0 + & + 2d0*qK_prim_vf(strxb+1)%sf(j, k, l)**2d0 + qK_prim_vf(strxb+2)%sf(j, k, l)**2d0 + & + 2d0*qK_prim_vf(strxb+3)%sf(j, k, l)**2d0 + 2d0*qK_prim_vf(strxb+4)%sf(j, k, l)**2d0 + & + qK_prim_vf(strxe)%sf(j, k, l)**2d0)) #endif !$acc loop seq diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index a3b32239e1..0d8c798c34 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -394,7 +394,10 @@ subroutine s_save_data(t_step, varname, pres, c, H) call s_write_variable_to_formatted_database_file(varname, t_step) end if if (prim_vars_wrt) then - q_sf = q_prim_vf(xiend+1)%sf(j, k, l) + q_sf = q_prim_vf(xiend+1)%sf( & + -offset_x%beg:m + offset_x%end, & + -offset_y%beg:n + offset_y%end, & + -offset_z%beg:p + offset_z%end) write (varname, '(A,I0)') 'vonMises' call s_write_variable_to_formatted_database_file(varname, t_step) end if diff --git a/submit_hyper.sh b/submit_hyper.sh index ba197a9987..8a87f95dde 100755 --- a/submit_hyper.sh +++ b/submit_hyper.sh @@ -1,7 +1,4 @@ #!/bin/bash -./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - - +./mfc.sh run /projects/bciv/mcarcanabarbosa/kymo/geldef.py -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta From efa9ca4b4cc0b025c6a98826f3409a785eddcdcf Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Fri, 22 Nov 2024 19:52:44 -0600 Subject: [PATCH 324/380] adjustments to vonMises --- src/common/m_variables_conversion.fpp | 2 +- src/post_process/m_start_up.f90 | 5 ++++- submit_hyper.sh | 6 +++--- 3 files changed, 8 insertions(+), 5 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 4718408ad6..725ff2c979 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1034,7 +1034,7 @@ contains end if #ifndef POST_PROCESS ! to save von Mises stress instead of elastic internal energy - qK_prim_vf(xiend+1)%sf(j, k, l) = sqrt((3/2)*qK_prim_vf(1)%sf(j, k, l)**2 + & + qK_prim_vf(xiend+1)%sf(j, k, l) = sqrt((3d0/2d0)*qK_prim_vf(1)%sf(j, k, l)**2 + & 2*qK_prim_vf(2)%sf(j, k, l)**2 + qK_prim_vf(3)%sf(j, k, l)**2 + & 2*qK_prim_vf(4)%sf(j, k, l)**2 + 2*qK_prim_vf(5)%sf(j, k, l)**2 + & qK_prim_vf(6)%sf(j, k, l)**2) diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index dc606ab46c..bae2d29196 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -394,7 +394,10 @@ subroutine s_save_data(t_step, varname, pres, c, H) call s_write_variable_to_formatted_database_file(varname, t_step) end if if (prim_vars_wrt) then - q_sf = q_prim_vf(xiend+1)%sf(j, k, l) + q_sf = q_prim_vf(xiend+1)%sf( & + -offset_x%beg:m + offset_x%end, & + -offset_y%beg:n + offset_y%end, & + -offset_z%beg:p + offset_z%end) write (varname, '(A,I0)') 'vonMises' call s_write_variable_to_formatted_database_file(varname, t_step) end if diff --git a/submit_hyper.sh b/submit_hyper.sh index ba197a9987..49aec51ef5 100755 --- a/submit_hyper.sh +++ b/submit_hyper.sh @@ -1,7 +1,7 @@ #!/bin/bash -./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar +#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar +#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar #./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - +./mfc.sh run /projects/bciv/mcarcanabarbosa/ctr/gel/geldef.py -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:00:00 -#gel25 -t post_process -a bciv-delta-gpu -c delta From 5b3fde7159fc0300e152f03c079630321d686f70 Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Fri, 22 Nov 2024 20:34:55 -0600 Subject: [PATCH 325/380] kymograph in case_dicts --- toolchain/mfc/run/case_dicts.py | 1 + 1 file changed, 1 insertion(+) diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index e9a7055c64..b3e261e9f3 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -346,6 +346,7 @@ def analytic(self): 't_stop': ParamType.REAL, 'n_start': ParamType.INT, 'surface_tension': ParamType.LOG, + 'kymograph': ParamType.LOG, }) for cmp_id in range(1,3+1): From 40b456ac38cb4189abe6563cc2660b1b9952b91a Mon Sep 17 00:00:00 2001 From: Mirelys Carcana Barbosa Date: Fri, 22 Nov 2024 20:53:24 -0600 Subject: [PATCH 326/380] it runs but does it work? --- src/post_process/m_data_output.fpp | 7 ++++--- src/post_process/m_start_up.f90 | 2 +- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 3fd50901da..ad16863b42 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -573,16 +573,17 @@ contains end subroutine s_open_energy_data_file ! ---------------------------------------- - subroutine s_open_kymo_data_file(t_step) ! ------------------------ + subroutine s_open_kymo_data_file() ! ------------------------ ! Time-step that is currently being post-processed - integer, intent(in) :: t_step +! integer, intent(in) :: t_step ! Relative path to a file in the case directory character(LEN=path_len + 3*name_len) :: file_path ! Kymo information is in binary database format ! Generates relative path to database, opened for current time-step - write (file_path, '(A,I0,A)') '/', t_step, '/kymo_data.dat' +! write (file_path, '(A,I0,A)') '/', t_step, '/kymo_data.dat' + write (file_path, '(A)') '/kymo_data.dat' file_path = trim(case_dir)//trim(file_path) ! Opening the simulation data file diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 9a88f5a5d6..1dc9c61290 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -206,7 +206,7 @@ subroutine s_save_data(t_step, varname, pres, c, H) end if if (kymograph .and. proc_rank == 0) then - call s_open_kymo_data_file(t_step) + call s_open_kymo_data_file() end if if (kymograph) then From 55d9ba967c2710602af6146259b3edc0720c4d22 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Fri, 20 Dec 2024 06:39:23 -0600 Subject: [PATCH 327/380] added sbatch command to improve performance on Delta --- submit_test.sh | 4 ++-- toolchain/templates/delta.mako | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/submit_test.sh b/submit_test.sh index dece0092ed..1c36e7c764 100755 --- a/submit_test.sh +++ b/submit_test.sh @@ -47,8 +47,8 @@ #./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar #./mfc.sh run /projects/bciv/rodrigu1/dfd2024/bubgel/geldef.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process simulation -c delta +./mfc.sh run /projects/bciv/rodrigu1/dfd2024/bubgel/geldef.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c delta #./mfc.sh run /projects/bciv/rodrigu1/dfd2024/bubgel/geldef.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process post_process -c delta - -./mfc.sh run /projects/bciv/rodrigu1/dfd2024/bubgel/geldef.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta +#./mfc.sh run /projects/bciv/rodrigu1/dfd2024/bubgel/geldef.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta diff --git a/toolchain/templates/delta.mako b/toolchain/templates/delta.mako index 694f22c457..1b8763d7b1 100644 --- a/toolchain/templates/delta.mako +++ b/toolchain/templates/delta.mako @@ -5,7 +5,7 @@ % if engine == 'batch': #SBATCH --nodes=${nodes} #SBATCH --ntasks-per-node=${tasks_per_node} -#SBATCH --cpus-per-task=1 +#SBATCH --cpus-per-task=16 #SBATCH --job-name="${name}" #SBATCH --time=${walltime} % if partition: From 1fafb74f99a9e5fd5f4397ec95f2847530b1c046 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 21 Dec 2024 15:28:15 -0600 Subject: [PATCH 328/380] updated a few files to conform to the modular precision --- src/pre_process/m_patches.fpp | 2 +- src/simulation/m_boundary_conditions.fpp | 14 +++++++------- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index 8c4f95515c..cab54a7552 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -2246,7 +2246,7 @@ contains end subroutine s_convert_cylindrical_to_spherical_coord - !> Archimedes spiral funcreal(kind(0d0)) :: theta_cc, r, x_p, P2, P3, P4, P5, P6, P7tion + !> Archimedes spiral function :: theta_cc, r, x_p, P2, P3, P4, P5, P6, P7 !! @param myth Angle !! @param offset Thickness !! @param a Starting position diff --git a/src/simulation/m_boundary_conditions.fpp b/src/simulation/m_boundary_conditions.fpp index 8bf83a3f35..d579b15c8e 100644 --- a/src/simulation/m_boundary_conditions.fpp +++ b/src/simulation/m_boundary_conditions.fpp @@ -221,7 +221,7 @@ contains real(wp), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: bc_dir, bc_loc integer :: j, k, l, q, i - real(kind(0d0)) :: bc_sum + real(wp) :: bc_sum !< x-direction ========================================================= if (bc_dir == 1) then !< x-direction @@ -246,7 +246,7 @@ contains do l = 0, p do k = 0, n do i = xibeg, xiend - bc_sum = 0d0 + bc_sum = 0_wp !$acc loop seq do q = 1, j bc_sum = bc_sum - dx(-q) @@ -280,7 +280,7 @@ contains do l = 0, p do k = 0, n do i = xibeg, xiend - bc_sum = 0d0 + bc_sum = 0_wp !$acc loop seq do q = 1, j bc_sum = bc_sum + dx(m + q) @@ -318,7 +318,7 @@ contains do l = -buff_size, m + buff_size do k = 0, p do i = xibeg, xiend - bc_sum = 0d0 + bc_sum = 0_wp !$acc loop seq do q = 1, j bc_sum = bc_sum - dy(-q) @@ -352,7 +352,7 @@ contains do l = -buff_size, m + buff_size do k = 0, p do i = xibeg, xiend - bc_sum = 0d0 + bc_sum = 0_wp !$acc loop seq do q = 1, j bc_sum = bc_sum + dy(n + q) @@ -391,7 +391,7 @@ contains do l = -buff_size, n + buff_size do k = -buff_size, m + buff_size do i = xibeg, xiend - bc_sum = 0d0 + bc_sum = 0_wp !$acc loop seq do q = 1, j bc_sum = bc_sum - dx(-q) @@ -424,7 +424,7 @@ contains do l = -buff_size, n + buff_size do k = -buff_size, m + buff_size do i = xibeg, xiend - bc_sum = 0d0 + bc_sum = 0_wp !$acc loop seq do q = 1, j bc_sum = bc_sum + dz(p + q) From fc3b2492d5288aac82e6baf4683dd2eb34377074 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 21 Dec 2024 15:34:40 -0600 Subject: [PATCH 329/380] added more module precision --- src/common/m_variables_conversion.fpp | 8 ++++---- src/pre_process/m_patches.fpp | 1 - 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index c742e813d5..03d2f3c006 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1045,10 +1045,10 @@ contains #ifdef MFC_POST_PROCESS if (hyperelasticity) then ! to save von Mises stress instead of elastic internal energy - qK_prim_vf(xiend+1)%sf(j, k, l) = sqrt((3d0/2d0)* (qK_prim_vf(strxb)%sf(j, k, l)**2d0 + & - 2d0*qK_prim_vf(strxb+1)%sf(j, k, l)**2d0 + qK_prim_vf(strxb+2)%sf(j, k, l)**2d0 + & - 2d0*qK_prim_vf(strxb+3)%sf(j, k, l)**2d0 + 2d0*qK_prim_vf(strxb+4)%sf(j, k, l)**2d0 + & - qK_prim_vf(strxe)%sf(j, k, l)**2d0) ) + qK_prim_vf(xiend+1)%sf(j, k, l) = sqrt((3_wp/2_wp)* (qK_prim_vf(strxb)%sf(j, k, l)**2_wp + & + 2_wp*qK_prim_vf(strxb+1)%sf(j, k, l)**2_wp + qK_prim_vf(strxb+2)%sf(j, k, l)**2_wp + & + 2_wp*qK_prim_vf(strxb+3)%sf(j, k, l)**2_wp + 2_wp*qK_prim_vf(strxb+4)%sf(j, k, l)**2_wp + & + qK_prim_vf(strxe)%sf(j, k, l)**2_wp) ) end if #endif diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index cab54a7552..b411147583 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -1444,7 +1444,6 @@ contains ! 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. - eps = 1.d-32 eta = 1._wp eps = 1.e-32_wp From 25bf4fe60491bcae210772e635506673e4762c4c Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 21 Dec 2024 15:43:20 -0600 Subject: [PATCH 330/380] cleaning up the master branch in preparation for PR --- batch_mfc.sh | 14 ------------- submit_gpu.sh | 54 ------------------------------------------------- submit_hyper.sh | 10 --------- submit_lung.sh | 9 --------- submit_pc.sh | 9 --------- submit_test.sh | 54 ------------------------------------------------- 6 files changed, 150 deletions(-) delete mode 100755 batch_mfc.sh delete mode 100755 submit_gpu.sh delete mode 100755 submit_hyper.sh delete mode 100755 submit_lung.sh delete mode 100755 submit_pc.sh delete mode 100755 submit_test.sh diff --git a/batch_mfc.sh b/batch_mfc.sh deleted file mode 100755 index 41df3c3473..0000000000 --- a/batch_mfc.sh +++ /dev/null @@ -1,14 +0,0 @@ -#!/bin/bash - -./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -./mfc.sh run /users/mrodri97/scratch/lungwave/case0/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar - -./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -./mfc.sh run /users/mrodri97/scratch/lungwave/case1/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar - -./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pre -t pre_process -c oscar -./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# sim -t simulation -c oscar -./mfc.sh run /users/mrodri97/scratch/lungwave/case2/case.py -e batch -N 1 -n 4 -w 00:30:00 -# pos -t post_process -c oscar - diff --git a/submit_gpu.sh b/submit_gpu.sh deleted file mode 100755 index 0859ba7f1e..0000000000 --- a/submit_gpu.sh +++ /dev/null @@ -1,54 +0,0 @@ -#!/bin/bash - -### A100s -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwex_pre -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta - -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta - -### A40s -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwex_pre -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# test -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_pre -t pre_process -a bciv-delta-gpu -c delta - -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwex_sim -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 12:00:00 -# bwim_sim -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 03:00:00 -# test_sim -t simulation -a bciv-delta-gpu -c delta - - -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterex/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# bwex_post -t post_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/mancia2024/bubwaterim2/input.py -e batch -p gpuA100x4 -N 5 -n 4 -g 1 -w 01:00:00 -# bwim_post -t post_process -a bciv-delta-gpu -c delta - -#./mfc.sh run /scratch/bciv/rodrigu1/test/input.py -e batch -p gpuA40x4 -N 5 -n 4 -g 1 -w 00:30:00 -# test_post -t post_process -a bciv-delta-gpu -c delta - -#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/3Dsph_hyper_prestress_input.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - -#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - -#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hypoe/hypo_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 02:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test61/case.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - -./mfc.sh run /scratch/bciv/rodrigu1/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/rodrigu1/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - -#./mfc.sh run /scratch/bciv/rodrigu1/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/3D_bubble_channel/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - diff --git a/submit_hyper.sh b/submit_hyper.sh deleted file mode 100755 index 50690ec0b7..0000000000 --- a/submit_hyper.sh +++ /dev/null @@ -1,10 +0,0 @@ -#!/bin/bash - -#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar -#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - -./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 2 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 2 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 2 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - diff --git a/submit_lung.sh b/submit_lung.sh deleted file mode 100755 index 43ac497765..0000000000 --- a/submit_lung.sh +++ /dev/null @@ -1,9 +0,0 @@ -#!/bin/bash - -#./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 2 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 2 -g 2 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run ./examples/3D_lungwave/case.py -p gpuA100x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - -./mfc.sh run /scratch/bciv/rodrigu1/lung/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -./mfc.sh run /scratch/bciv/rodrigu1/lung/case.py -p gpuA100x4 -N 1 -n 2 -g 1 -w 01:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta - diff --git a/submit_pc.sh b/submit_pc.sh deleted file mode 100755 index e45b98dbc4..0000000000 --- a/submit_pc.sh +++ /dev/null @@ -1,9 +0,0 @@ -#!/bin/bash - -#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar -#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - -./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t pre_process -c delta -./mfc.sh run ./examples/3D_phasechange_bubble/casefile.py -p batch -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t simulation -c delta - diff --git a/submit_test.sh b/submit_test.sh deleted file mode 100755 index 1c36e7c764..0000000000 --- a/submit_test.sh +++ /dev/null @@ -1,54 +0,0 @@ -#!/bin/bash - -#./mfc.sh run ./examples/3D_phasechange_bubble/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 8 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -#./mfc.sh run ./examples/3D_phasechange_bubble/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta - -#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -#./mfc.sh run ./examples/3D_ctr_test/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta - -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta - -#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/2speed/3dpc-noel-ptg.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta - -#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 00:10:00 -# test1 -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 4 -g 1 -w 04:00:00 -# test1 -t simulation -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/mcarcanabarbosa/ctr2024/testingpc4f/4speed/3dpc-noel-ptg.py -e batch -p gpuA100x4 -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.3/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 01:00:00 -# pre_bubingel -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# sim_bubingel -t simulation -a bciv-delta-gpu -c delta - -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test6.5/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta - -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# pre_bubinwater -t pre_process -a bciv-delta-gpu -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4/case.py -e batch -p gpuA100x4 -N 1 -n 4 -g 4 -w 06:00:00 -# sim_bubinwater -t simulation -a bciv-delta-gpu -c delta - -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t pre_process -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 2 -g 0 -w 01:00:00 -# test1 -t simulation -c delta -#./mfc.sh run /scratch/bciv/rodrigu1/ctr2024/test4.1/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta - - -#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 16 -g 0 -w 02:00:00 -# test1 -t simulation -c oscar -#./mfc.sh run /users/mrodri97/scratch/ctr2024/test6/case.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c oscar - -#./mfc.sh run /projects/bciv/rodrigu1/dfd2024/bubgel/geldef.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process simulation -c delta -./mfc.sh run /projects/bciv/rodrigu1/dfd2024/bubgel/geldef.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c delta - -#./mfc.sh run /projects/bciv/rodrigu1/dfd2024/bubgel/geldef.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t pre_process post_process -c delta -#./mfc.sh run /projects/bciv/rodrigu1/dfd2024/bubgel/geldef.py -p batch -N 1 -n 1 -g 0 -w 01:00:00 -# test1 -t post_process -c delta - From ab772fd1712d3d3bf1c21ad97884297f95aa9c0b Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 21 Dec 2024 15:58:16 -0600 Subject: [PATCH 331/380] ran the MFC format command for PR --- src/common/m_variables_conversion.fpp | 10 +- src/post_process/m_start_up.f90 | 22 +- src/pre_process/include/3dHardcodedIC.fpp | 30 +-- src/pre_process/m_assign_variables.fpp | 6 +- src/pre_process/m_patches.fpp | 8 +- src/simulation/m_boundary_conditions.fpp | 264 +++++++++++----------- src/simulation/m_data_output.fpp | 4 +- src/simulation/m_hyperelastic.fpp | 6 +- src/simulation/m_rhs.fpp | 4 +- 9 files changed, 177 insertions(+), 177 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 03d2f3c006..67fa44ec8e 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1044,11 +1044,11 @@ contains #ifdef MFC_POST_PROCESS if (hyperelasticity) then - ! to save von Mises stress instead of elastic internal energy - qK_prim_vf(xiend+1)%sf(j, k, l) = sqrt((3_wp/2_wp)* (qK_prim_vf(strxb)%sf(j, k, l)**2_wp + & - 2_wp*qK_prim_vf(strxb+1)%sf(j, k, l)**2_wp + qK_prim_vf(strxb+2)%sf(j, k, l)**2_wp + & - 2_wp*qK_prim_vf(strxb+3)%sf(j, k, l)**2_wp + 2_wp*qK_prim_vf(strxb+4)%sf(j, k, l)**2_wp + & - qK_prim_vf(strxe)%sf(j, k, l)**2_wp) ) + ! to save von Mises stress instead of elastic internal energy + qK_prim_vf(xiend + 1)%sf(j, k, l) = sqrt((3_wp/2_wp)*(qK_prim_vf(strxb)%sf(j, k, l)**2_wp + & + 2_wp*qK_prim_vf(strxb + 1)%sf(j, k, l)**2_wp + qK_prim_vf(strxb + 2)%sf(j, k, l)**2_wp + & + 2_wp*qK_prim_vf(strxb + 3)%sf(j, k, l)**2_wp + 2_wp*qK_prim_vf(strxb + 4)%sf(j, k, l)**2_wp + & + qK_prim_vf(strxe)%sf(j, k, l)**2_wp)) end if #endif diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 1e9e36a4d3..2672f8f899 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -369,7 +369,7 @@ subroutine s_save_data(t_step, varname, pres, c, H) ! Adding the elastic shear stresses to the formatted database file ----- if (elasticity) then if (prim_vars_wrt) then - do i = 1, stress_idx%end - stress_idx%beg + 1 + do i = 1, stress_idx%end - stress_idx%beg + 1 q_sf = q_prim_vf(i - 1 + stress_idx%beg)%sf( & -offset_x%beg:m + offset_x%end, & -offset_y%beg:n + offset_y%end, & @@ -378,12 +378,12 @@ subroutine s_save_data(t_step, varname, pres, c, H) call s_write_variable_to_formatted_database_file(varname, t_step) varname(:) = ' ' - end do + end do end if end if if (hyperelasticity) then if (prim_vars_wrt) then - do i = 1, xiend - xibeg + 1 + do i = 1, xiend - xibeg + 1 q_sf = q_prim_vf(i - 1 + xibeg)%sf( & -offset_x%beg:m + offset_x%end, & -offset_y%beg:n + offset_y%end, & @@ -392,16 +392,16 @@ subroutine s_save_data(t_step, varname, pres, c, H) call s_write_variable_to_formatted_database_file(varname, t_step) varname(:) = ' ' - end do + end do - q_sf = q_prim_vf(xiend+1)%sf( & - -offset_x%beg:m + offset_x%end, & - -offset_y%beg:n + offset_y%end, & - -offset_z%beg:p + offset_z%end) + q_sf = q_prim_vf(xiend + 1)%sf( & + -offset_x%beg:m + offset_x%end, & + -offset_y%beg:n + offset_y%end, & + -offset_z%beg:p + offset_z%end) - write (varname, '(A,I0)') 'vonMises' - call s_write_variable_to_formatted_database_file(varname, t_step) - varname(:) = ' ' + write (varname, '(A,I0)') 'vonMises' + call s_write_variable_to_formatted_database_file(varname, t_step) + varname(:) = ' ' end if end if diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp index ace0d46283..39dd992663 100644 --- a/src/pre_process/include/3dHardcodedIC.fpp +++ b/src/pre_process/include/3dHardcodedIC.fpp @@ -59,37 +59,37 @@ q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1) q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2) end if - + case (302) ! (3D lung geometry in X direction - axisym, with smoothing) - lam = 200.E-06_wp + lam = 200.e-06_wp amp = patch_icpp(patch_id)%a2 h = 0.125_wp*amp - + intH = amp/2._wp*(sin(2._wp*pi*y_cc(j)/lam + pi/2._wp) + sin(2._wp*pi*z_cc(k)/lam + pi/2._wp)) - - alph = patch_icpp(2)%alpha(1) + (patch_icpp(1)%alpha(1)-patch_icpp(2)%alpha(1))/(h)*(x_cc(i)-(intH-h/2._wp)) - + + alph = patch_icpp(2)%alpha(1) + (patch_icpp(1)%alpha(1) - patch_icpp(2)%alpha(1))/(h)*(x_cc(i) - (intH - h/2._wp)) + if (x_cc(i) > intH + h/2) then - + q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1) q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2) q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1) q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2) q_prim_vf(E_idx)%sf(i, j, k) = patch_icpp(1)%pres - - else if ((x_cc(i) .le. intH + h/2) .and. (x_cc(i) .ge. intH - h/2._wp)) then - + + else if ((x_cc(i) <= intH + h/2) .and. (x_cc(i) >= intH - h/2._wp)) then + q_prim_vf(advxb)%sf(i, j, k) = alph !0.5 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph !0.5 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)/patch_icpp(1)%alpha(1)*alph!0.5 - q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(2)%alpha_rho(2)/patch_icpp(2)%alpha(2)*(1-alph)!0.5 + q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(2)%alpha_rho(2)/patch_icpp(2)%alpha(2)*(1 - alph)!0.5 q_prim_vf(E_idx)%sf(i, j, k) = patch_icpp(1)%pres - + end if - + case (303) ! pre_stress for hyperelasticity, bubble in material - R0ref = 30E-6_wp ! equilibrium radius + R0ref = 30e-6_wp ! equilibrium radius Rinit = patch_icpp(3)%radius ! initial radius x_bcen = patch_icpp(3)%x_centroid y_bcen = patch_icpp(3)%y_centroid @@ -101,7 +101,7 @@ phi = atan2(y_ccs, x_ccs) theta = atan2(sqrt(x_ccs**2._wp + y_ccs**2._wp), z_ccs) !spherical coord, assuming Rmax=1 - xi_sph = (rcoord**3._wp - R0ref**3._wp + Rinit**3._wp)**(1._wp/3._wp) + xi_sph = (rcoord**3._wp - R0ref**3._wp + Rinit**3._wp)**(1._wp/3._wp) xi_cart(1) = xi_sph*sin(theta)*cos(phi) xi_cart(2) = xi_sph*sin(theta)*sin(phi) xi_cart(3) = xi_sph*cos(theta) diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp index 3f993a8a09..c2d748b3a6 100644 --- a/src/pre_process/m_assign_variables.fpp +++ b/src/pre_process/m_assign_variables.fpp @@ -498,10 +498,10 @@ contains if (hyperelasticity .and. .not. pre_stress) then xi_cart(1) = x_cc(j) if (p > 0) then - xi_cart(2) = y_cc(k) - xi_cart(3) = z_cc(l) + xi_cart(2) = y_cc(k) + xi_cart(3) = z_cc(l) elseif (n > 0) then - xi_cart(2) = y_cc(k) + xi_cart(2) = y_cc(k) end if ! assigning the reference map to the q_prim vector field diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index b411147583..89be2d847d 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -1527,8 +1527,8 @@ contains if (x_cc(i) - x_centroid >= 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. & + 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, & @@ -1536,8 +1536,8 @@ contains elseif (x_cc(i) - x_centroid < 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 & + 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 diff --git a/src/simulation/m_boundary_conditions.fpp b/src/simulation/m_boundary_conditions.fpp index d579b15c8e..fb4dae0bbd 100644 --- a/src/simulation/m_boundary_conditions.fpp +++ b/src/simulation/m_boundary_conditions.fpp @@ -228,38 +228,38 @@ contains if (bc_loc == -1) then !bc_x%beg - !$acc parallel loop collapse(4) gang vector default(present) - do i = 1, sys_size - do l = 0, p - do k = 0, n - do j = 1, buff_size - q_prim_vf(i)%sf(-j, k, l) = & - q_prim_vf(i)%sf(0, k, l) + !$acc parallel loop collapse(4) gang vector default(present) + do i = 1, sys_size + do l = 0, p + do k = 0, n + do j = 1, buff_size + q_prim_vf(i)%sf(-j, k, l) = & + q_prim_vf(i)%sf(0, k, l) + end do end do - end do - end do - end do + end do + end do + + if (hyperelasticity) then + !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) + do j = 1, buff_size + do l = 0, p + do k = 0, n + do i = xibeg, xiend + bc_sum = 0_wp + !$acc loop seq + do q = 1, j + bc_sum = bc_sum - dx(-q) + end do + q_prim_vf(i)%sf(-j, k, l) = & + q_prim_vf(i)%sf(0, k, l) - bc_sum + end do + end do + end do + end do + !$acc end parallel loop + end if - if (hyperelasticity) then - !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) - do j = 1, buff_size - do l = 0, p - do k = 0, n - do i = xibeg, xiend - bc_sum = 0_wp - !$acc loop seq - do q = 1, j - bc_sum = bc_sum - dx(-q) - end do - q_prim_vf(i)%sf(-j, k, l) = & - q_prim_vf(i)%sf(0, k, l) - bc_sum - end do - end do - end do - end do - !$acc end parallel loop - end if - else !< bc_x%end !$acc parallel loop collapse(4) gang vector default(present) @@ -269,30 +269,30 @@ contains do j = 1, buff_size q_prim_vf(i)%sf(m + j, k, l) = & q_prim_vf(i)%sf(m, k, l) - end do + end do end do end do end do - if (hyperelasticity) then - !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) - do j = 1, buff_size - do l = 0, p - do k = 0, n - do i = xibeg, xiend - bc_sum = 0_wp - !$acc loop seq - do q = 1, j - bc_sum = bc_sum + dx(m + q) - end do - q_prim_vf(i)%sf(m + j, k, l) = & - q_prim_vf(i)%sf(m, k, l) + bc_sum - end do - end do - end do - end do - !$acc end parallel loop - end if + if (hyperelasticity) then + !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) + do j = 1, buff_size + do l = 0, p + do k = 0, n + do i = xibeg, xiend + bc_sum = 0_wp + !$acc loop seq + do q = 1, j + bc_sum = bc_sum + dx(m + q) + end do + q_prim_vf(i)%sf(m + j, k, l) = & + q_prim_vf(i)%sf(m, k, l) + bc_sum + end do + end do + end do + end do + !$acc end parallel loop + end if end if !< y-direction ========================================================= @@ -307,30 +307,30 @@ contains do l = -buff_size, m + buff_size q_prim_vf(i)%sf(l, -j, k) = & q_prim_vf(i)%sf(l, 0, k) - end do + end do end do end do end do - if (hyperelasticity) then - !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) - do j = 1, buff_size - do l = -buff_size, m + buff_size - do k = 0, p - do i = xibeg, xiend - bc_sum = 0_wp - !$acc loop seq - do q = 1, j - bc_sum = bc_sum - dy(-q) - end do - q_prim_vf(i)%sf(l, -j, k) = & - q_prim_vf(i)%sf(l, 0, k) - bc_sum - end do - end do - end do - end do - !$acc end parallel loop - end if + if (hyperelasticity) then + !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) + do j = 1, buff_size + do l = -buff_size, m + buff_size + do k = 0, p + do i = xibeg, xiend + bc_sum = 0_wp + !$acc loop seq + do q = 1, j + bc_sum = bc_sum - dy(-q) + end do + q_prim_vf(i)%sf(l, -j, k) = & + q_prim_vf(i)%sf(l, 0, k) - bc_sum + end do + end do + end do + end do + !$acc end parallel loop + end if else !< bc_y%end @@ -346,26 +346,26 @@ contains end do end do - if (hyperelasticity) then - !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) - do j = 1, buff_size - do l = -buff_size, m + buff_size - do k = 0, p - do i = xibeg, xiend - bc_sum = 0_wp - !$acc loop seq - do q = 1, j - bc_sum = bc_sum + dy(n + q) - end do - q_prim_vf(i)%sf(l, n + j, k) = & - q_prim_vf(i)%sf(l, n, k) + bc_sum - end do - end do - end do - end do - !$acc end parallel loop - end if - + if (hyperelasticity) then + !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) + do j = 1, buff_size + do l = -buff_size, m + buff_size + do k = 0, p + do i = xibeg, xiend + bc_sum = 0_wp + !$acc loop seq + do q = 1, j + bc_sum = bc_sum + dy(n + q) + end do + q_prim_vf(i)%sf(l, n + j, k) = & + q_prim_vf(i)%sf(l, n, k) + bc_sum + end do + end do + end do + end do + !$acc end parallel loop + end if + end if !< z-direction ========================================================= @@ -380,31 +380,31 @@ contains do k = -buff_size, m + buff_size q_prim_vf(i)%sf(k, l, -j) = & q_prim_vf(i)%sf(k, l, 0) - end do + end do end do end do end do - if (hyperelasticity) then - !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) - do j = 1, buff_size - do l = -buff_size, n + buff_size - do k = -buff_size, m + buff_size - do i = xibeg, xiend - bc_sum = 0_wp - !$acc loop seq - do q = 1, j - bc_sum = bc_sum - dx(-q) - end do - q_prim_vf(i)%sf(k, l, -j) = & - q_prim_vf(i)%sf(k, l, 0) - bc_sum - end do - end do - end do - end do - !$acc end parallel loop - end if - else !< bc_z%end + if (hyperelasticity) then + !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) + do j = 1, buff_size + do l = -buff_size, n + buff_size + do k = -buff_size, m + buff_size + do i = xibeg, xiend + bc_sum = 0_wp + !$acc loop seq + do q = 1, j + bc_sum = bc_sum - dx(-q) + end do + q_prim_vf(i)%sf(k, l, -j) = & + q_prim_vf(i)%sf(k, l, 0) - bc_sum + end do + end do + end do + end do + !$acc end parallel loop + end if + else !< bc_z%end !$acc parallel loop collapse(4) gang vector default(present) do i = 1, sys_size @@ -413,31 +413,31 @@ contains do k = -buff_size, m + buff_size q_prim_vf(i)%sf(k, l, p + j) = & q_prim_vf(i)%sf(k, l, p) - end do + end do end do end do end do - if (hyperelasticity) then - !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) - do j = 1, buff_size - do l = -buff_size, n + buff_size - do k = -buff_size, m + buff_size - do i = xibeg, xiend - bc_sum = 0_wp - !$acc loop seq - do q = 1, j - bc_sum = bc_sum + dz(p + q) - end do - q_prim_vf(i)%sf(k, l, p + j) = & - q_prim_vf(i)%sf(k, l, p) + bc_sum - end do - end do - end do - end do - !$acc end parallel loop - end if - + if (hyperelasticity) then + !$acc parallel loop collapse(4) gang vector default(present), private(bc_sum) + do j = 1, buff_size + do l = -buff_size, n + buff_size + do k = -buff_size, m + buff_size + do i = xibeg, xiend + bc_sum = 0_wp + !$acc loop seq + do q = 1, j + bc_sum = bc_sum + dz(p + q) + end do + q_prim_vf(i)%sf(k, l, p + j) = & + q_prim_vf(i)%sf(k, l, p) + bc_sum + end do + end do + end do + end do + !$acc end parallel loop + end if + end if end if diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 49ae6923ca..f5579e3e28 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -322,7 +322,7 @@ contains !$acc end kernels end if #endif - + ! Determining global stability criteria extrema at current time-step if (num_procs > 1) then call s_mpi_reduce_stability_criteria_extrema(icfl_max_loc, & @@ -338,7 +338,7 @@ contains if (viscous) vcfl_max_glb = vcfl_max_loc if (viscous) Rc_min_glb = Rc_min_loc end if - + ! Determining the stability criteria extrema over all the time-steps if (icfl_max_glb > icfl_max) icfl_max = icfl_max_glb diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index fb1a2bd0fd..bbd7028c43 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -112,9 +112,9 @@ contains !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, & !$acc rho, gamma, pi_inf, qv, G, Re, tensora, tensorb) - do l = 0, p-2 - do k = 0, n-2 - do j = 2, m-2 + do l = 0, p - 2 + do k = 0, n - 2 + do j = 2, m - 2 !$acc loop seq do i = 1, num_fluids alpha_rho_k(i) = q_cons_vf(i)%sf(j, k, l) diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 8a746c14ea..f0dd58316c 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -675,9 +675,9 @@ contains call nvtxEndRange call nvtxStartRange("RHS-ELASTIC") - if (hyperelasticity) then + if (hyperelasticity) then call s_hyperelastic_rmt_stress_update(q_cons_qp%vf, q_prim_qp%vf) - call s_populate_variables_buffers(q_prim_qp%vf, pb, mv) + call s_populate_variables_buffers(q_prim_qp%vf, pb, mv) end if call nvtxEndRange From 87430b60a067ab70a58b80394ac4f038e63a6b47 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 21 Dec 2024 16:20:56 -0600 Subject: [PATCH 332/380] resolved several comments --- src/common/m_derived_types.fpp | 2 -- src/pre_process/include/3dHardcodedIC.fpp | 1 - src/pre_process/m_patches.fpp | 4 ++-- src/simulation/m_derived_variables.f90 | 1 - src/simulation/m_rhs.fpp | 2 +- toolchain/templates/delta.mako | 2 +- 6 files changed, 4 insertions(+), 8 deletions(-) diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index ba4c3d929a..1199145784 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -178,8 +178,6 @@ module m_derived_types logical :: non_axis_sym - logical :: non_axis_sym - real(wp) :: a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 !< !! The parameters needed for the spherical harmonic patch diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp index 39dd992663..de8a4c93b2 100644 --- a/src/pre_process/include/3dHardcodedIC.fpp +++ b/src/pre_process/include/3dHardcodedIC.fpp @@ -109,7 +109,6 @@ xi_cart(1) = xi_cart(1) + x_bcen xi_cart(2) = xi_cart(2) + y_bcen xi_cart(3) = xi_cart(3) + z_bcen -! print *, 'xi_cart(1) ::', xi_cart(1), 'xi_cart(2) ::', xi_cart(2), 'xi_cart(3) ::', xi_cart(3) ! assigning the reference map to the q_prim vector field do l = 1, 3 q_prim_vf(l + xibeg - 1)%sf(i, j, k) = xi_cart(l) diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index 89be2d847d..65d68b6895 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -792,7 +792,7 @@ contains ((y_cc(j) - y_centroid)/b)**2) & - 1._wp))*(-0.5_wp) + 0.5_wp end if - print *, "a :", a, "b :", b + if ((((x_cc(i) - x_centroid)/a)**2 + & ((y_cc(j) - y_centroid)/b)**2 <= 1._wp & .and. & @@ -2245,7 +2245,7 @@ contains end subroutine s_convert_cylindrical_to_spherical_coord - !> Archimedes spiral function :: theta_cc, r, x_p, P2, P3, P4, P5, P6, P7 + !> Archimedes spiral function !! @param myth Angle !! @param offset Thickness !! @param a Starting position diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index ccadd25f65..aae1bda761 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -156,7 +156,6 @@ subroutine s_compute_derived_variables(t_step) end do end do end do - call s_derive_center_of_mass(q_prim_ts(3)%vf, c_mass) call s_derive_center_of_mass(q_prim_ts(3)%vf, c_mass) diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index f0dd58316c..bb4ff959a7 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -790,7 +790,7 @@ contains ! =============================================================== ! Computing Riemann Solver Flux and Source Flux ================= - call nvtxStartRange("RHS_riemann_solver") + call nvtxStartRange("RHS-RIEMANN-SOLVER") call s_riemann_solver(qR_rsx_vf, qR_rsy_vf, qR_rsz_vf, & dqR_prim_dx_n(id)%vf, & dqR_prim_dy_n(id)%vf, & diff --git a/toolchain/templates/delta.mako b/toolchain/templates/delta.mako index 1b8763d7b1..694f22c457 100644 --- a/toolchain/templates/delta.mako +++ b/toolchain/templates/delta.mako @@ -5,7 +5,7 @@ % if engine == 'batch': #SBATCH --nodes=${nodes} #SBATCH --ntasks-per-node=${tasks_per_node} -#SBATCH --cpus-per-task=16 +#SBATCH --cpus-per-task=1 #SBATCH --job-name="${name}" #SBATCH --time=${walltime} % if partition: From 5d28efd81fd4b80f7bb6189f8f70d101ce4b9ace Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sat, 21 Dec 2024 16:23:43 -0600 Subject: [PATCH 333/380] fixed the lint issues --- toolchain/mfc/run/case_dicts.py | 1 - 1 file changed, 1 deletion(-) diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index 8296d06f47..52854e4e2e 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -52,7 +52,6 @@ def analytic(self): 'relax_model': ParamType.INT, 'sigma': ParamType.REAL, 'adv_n': ParamType.LOG, - 'hyperelasticity': ParamType.LOG, 'cfl_adap_dt': ParamType.LOG, 'cfl_const_dt': ParamType.LOG, 'chemistry': ParamType.LOG, From 8bcf768b4ff7f77f8fd8e266fee362267e1bf478 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Sat, 21 Dec 2024 17:30:50 -0500 Subject: [PATCH 334/380] Discard changes to examples/2D_lungwave/case.py --- examples/2D_lungwave/case.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/examples/2D_lungwave/case.py b/examples/2D_lungwave/case.py index 31127d8883..a53269ce9e 100644 --- a/examples/2D_lungwave/case.py +++ b/examples/2D_lungwave/case.py @@ -15,7 +15,7 @@ c_g = 347.2 #m/s G_g = 0 #pa -#material2 :: lung + #material2 :: lung gammal = 5.5 Bl = 492.E+06 @@ -32,7 +32,7 @@ #define pulse P_amp = 10.E+6 P_len = 45 #length of the impulse -theta = -math.pi/2 #direction of propagation +theta = -math.pi/2 #direction of propagation #non-dim From 4dacbeaedb1929f91c87f587fdb35a3b98b914ce Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Sat, 21 Dec 2024 17:35:43 -0500 Subject: [PATCH 335/380] Delete toolchain/bootstrap/docker.sh --- toolchain/bootstrap/docker.sh | 33 --------------------------------- 1 file changed, 33 deletions(-) delete mode 100644 toolchain/bootstrap/docker.sh diff --git a/toolchain/bootstrap/docker.sh b/toolchain/bootstrap/docker.sh deleted file mode 100644 index 60e34d9284..0000000000 --- a/toolchain/bootstrap/docker.sh +++ /dev/null @@ -1,33 +0,0 @@ -#!/bin/bash - -if ! command -v docker > /dev/null 2>&1; then - error "$MAGENTA""Docker$COLOR_RESET is not installed." - - exit 1 -fi - -log "Running in$MAGENTA Docker$COLOR_RESET mode." - -if [ -t 1 ]; then - dockerintopts='--interactive --tty' -fi - -__docker_run() { - docker run $dockerintopts --rm --workdir /home/me/MFC \ - --mount type=bind,source="$(pwd)",target=/home/me/MFC \ - sbryngelson/mfc:latest $@ -} - -__docker_run sudo chown -R me:me /home/me/MFC -if (($?)); then - error "Docker: Failed to set directory permissions on MFC mount.." - - exit 1 -fi - -__docker_run $@ -if (($?)); then - error "Error running Docker container with $@." - - exit 1 -fi From f54f9642ec15a2925270ae8ceee3290ceeb39f81 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Sat, 21 Dec 2024 17:36:34 -0500 Subject: [PATCH 336/380] Discard changes to examples/2D_lungwave_horizontal/case.py --- examples/2D_lungwave_horizontal/case.py | 1 + 1 file changed, 1 insertion(+) diff --git a/examples/2D_lungwave_horizontal/case.py b/examples/2D_lungwave_horizontal/case.py index 9a96888ae2..ca06daaca3 100644 --- a/examples/2D_lungwave_horizontal/case.py +++ b/examples/2D_lungwave_horizontal/case.py @@ -129,6 +129,7 @@ 'prim_vars_wrt' :'T', 'parallel_io' :'T', # ========================================================================== + # Monopole setting ========================================================= 'acoustic_source' : 'T', # creating an acoustic wave 'num_source' : 1, # place in the middle and expand From d5c4b749ef9da99d65e1e5ef3408b1433777d6ff Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Sat, 21 Dec 2024 17:37:18 -0500 Subject: [PATCH 337/380] Update modules --- toolchain/modules | 19 +++++-------------- 1 file changed, 5 insertions(+), 14 deletions(-) diff --git a/toolchain/modules b/toolchain/modules index 5099cd9894..c73336d96a 100644 --- a/toolchain/modules +++ b/toolchain/modules @@ -59,25 +59,16 @@ d-gpu nvhpc/24.1 cuda/12.3.0 openmpi/4.1.5+cuda cmake d-gpu CC=nvc CXX=nvc++ FC=nvfortran d-gpu MFC_CUDA_CC=80,86 -<<<<<<< HEAD -<<<<<<< HEAD -======= ->>>>>>> source +dai NCSA DeltaAI +dai-all python cmake nvhpc-openmpi3/24.3 cuda +dai-all CC=nvc CXX=nvc++ FC=nvfortran +dai-gpu MFC_CUDA_CC=89,90 + o Brown Oscar o-all python o-cpu hpcx-mpi o-gpu nvhpc cuda/12.3.0 cmake/3.26.3 o-gpu CC=nvc CXX=nvc++ FC=nvfortran -<<<<<<< HEAD -======= -======= - ->>>>>>> source -dai NCSA DeltaAI -dai-all python cmake nvhpc-openmpi3/24.3 cuda -dai-all CC=nvc CXX=nvc++ FC=nvfortran -dai-gpu MFC_CUDA_CC=89,90 ->>>>>>> source c DoD Carpenter c-all python/3.12.1 From 3ce911aaec36d77a21f386c4aa4c05f85045a163 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Sat, 21 Dec 2024 17:38:02 -0500 Subject: [PATCH 338/380] Discard changes to toolchain/modules --- toolchain/modules | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/toolchain/modules b/toolchain/modules index c73336d96a..8221e77aaa 100644 --- a/toolchain/modules +++ b/toolchain/modules @@ -59,17 +59,17 @@ d-gpu nvhpc/24.1 cuda/12.3.0 openmpi/4.1.5+cuda cmake d-gpu CC=nvc CXX=nvc++ FC=nvfortran d-gpu MFC_CUDA_CC=80,86 -dai NCSA DeltaAI -dai-all python cmake nvhpc-openmpi3/24.3 cuda -dai-all CC=nvc CXX=nvc++ FC=nvfortran -dai-gpu MFC_CUDA_CC=89,90 - o Brown Oscar o-all python o-cpu hpcx-mpi o-gpu nvhpc cuda/12.3.0 cmake/3.26.3 o-gpu CC=nvc CXX=nvc++ FC=nvfortran +dai NCSA DeltaAI +dai-all python cmake nvhpc-openmpi3/24.3 cuda +dai-all CC=nvc CXX=nvc++ FC=nvfortran +dai-gpu MFC_CUDA_CC=89,90 + c DoD Carpenter c-all python/3.12.1 c-cpu compiler-rt/2024.2.0 ifort/2024.2.0 icc/2023.1.0 mpi/latest cmake/3.28.1-intel-2023.0.0 From 183977097af817dda23bbcebb4bba07103d78c27 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 22 Dec 2024 00:06:19 -0600 Subject: [PATCH 339/380] made elasticity the logical for hypo and hyper --- src/post_process/m_global_parameters.fpp | 52 +++++++-------------- src/post_process/m_start_up.f90 | 2 +- src/pre_process/m_global_parameters.fpp | 53 +++++++--------------- src/pre_process/m_start_up.fpp | 3 +- src/simulation/m_global_parameters.fpp | 57 ++++++++---------------- src/simulation/m_start_up.fpp | 2 +- src/simulation/m_time_steppers.fpp | 4 ++ toolchain/mfc/run/case_dicts.py | 2 + 8 files changed, 61 insertions(+), 114 deletions(-) diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 25b2ddfa4e..4d53dae051 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -551,24 +551,6 @@ contains end if - if (hypoelasticity .or. hyperelasticity) then - elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D - sys_size = stress_idx%end - end if - - if (hyperelasticity) then - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims - ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 - ! number of entries in the symmetric btensor plus the jacobian - b_size = (num_dims*(num_dims + 1))/2 + 1 - tensor_size = num_dims**2 + 1 - end if - if (surface_tension) then c_idx = sys_size + 1 sys_size = c_idx @@ -594,24 +576,6 @@ contains sys_size = internalEnergies_idx%end alf_idx = 1 ! dummy, cannot actually have a void fraction - if (hypoelasticity .or. hyperelasticity) then - elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D - sys_size = stress_idx%end - end if - - if (hyperelasticity) then - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims - ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 - ! number of entries in the symmetric btensor plus the jacobian - b_size = (num_dims*(num_dims + 1))/2 + 1 - tensor_size = num_dims**2 + 1 - end if - if (surface_tension) then c_idx = sys_size + 1 sys_size = c_idx @@ -673,6 +637,22 @@ contains end if end if + if (elasticity) then + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end + if (hyperelasticity) then + xi_idx%beg = sys_size + 1 + xi_idx%end = sys_size + num_dims + ! adding three more equations for the \xi field and the elastic energy + sys_size = xi_idx%end + 1 + ! number of entries in the symmetric btensor plus the jacobian + b_size = (num_dims*(num_dims + 1))/2 + 1 + tensor_size = num_dims**2 + 1 + end if + end if + if (chemistry) then species_idx%beg = sys_size + 1 species_idx%end = sys_size + num_species diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 2672f8f899..cfb8715cbe 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -85,7 +85,7 @@ subroutine s_read_input_file relax_model, cf_wrt, sigma, adv_n, ib, num_ibs, & cfl_adap_dt, cfl_const_dt, t_save, t_stop, n_start, & cfl_target, surface_tension, & - sim_data, hyperelasticity + sim_data, hyperelasticity, elasticity ! Inquiring the status of the post_process.inp file file_loc = 'post_process.inp' diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 3fd5eb553a..f0cfc48651 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -641,24 +641,6 @@ contains end if end if - if (hypoelasticity .or. hyperelasticity) then - elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D - sys_size = stress_idx%end - end if - - if (hyperelasticity) then - ! number of entries in the symmetric btensor plus the jacobian - b_size = (num_dims*(num_dims + 1))/2 + 1 - tensor_size = num_dims**2 + 1 - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims - ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 - end if - if (surface_tension) then c_idx = sys_size + 1 sys_size = c_idx @@ -683,24 +665,6 @@ contains internalEnergies_idx%end = adv_idx%end + num_fluids sys_size = internalEnergies_idx%end - if (hypoelasticity .or. hyperelasticity) then - elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D - sys_size = stress_idx%end - end if - - if (hyperelasticity) then - ! number of entries in the symmetric btensor plus the jacobian - b_size = (num_dims*(num_dims + 1))/2 + 1 - tensor_size = num_dims**2 + 1 - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims - ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 - end if - if (surface_tension) then c_idx = sys_size + 1 sys_size = c_idx @@ -765,6 +729,23 @@ contains end if end if + if (elasticity) then + ! creates stress indices for both hypo and hyperelasticity + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end + if (hyperelasticity) then + ! number of entries in the symmetric btensor plus the jacobian + b_size = (num_dims*(num_dims + 1))/2 + 1 + tensor_size = num_dims**2 + 1 + xi_idx%beg = sys_size + 1 + xi_idx%end = sys_size + num_dims + ! adding three more equations for the \xi field and the elastic energy + sys_size = xi_idx%end + 1 + end if + end if + if (chemistry) then species_idx%beg = sys_size + 1 species_idx%end = sys_size + num_species diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index a3f19952e1..8e2771d3da 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -142,7 +142,8 @@ contains file_per_process, relax, relax_model, & palpha_eps, ptgalpha_eps, ib, num_ibs, patch_ib, & sigma, adv_n, cfl_adap_dt, cfl_const_dt, n_start, & - n_start_old, surface_tension, hyperelasticity, pre_stress + n_start_old, surface_tension, hyperelasticity, pre_stress, & + elasticity ! Inquiring the status of the pre_process.inp file file_loc = 'pre_process.inp' diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 15ee2e5b11..cddeadeafb 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -867,26 +867,6 @@ contains end if end if - if (hypoelasticity .or. hyperelasticity) then - elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D - sys_size = stress_idx%end - end if - - if (hyperelasticity) then - ! number of entries in the symmetric btensor plus the jacobian - b_size = (num_dims*(num_dims + 1))/2 + 1 - ! storing the jacobian in the last entry - tensor_size = num_dims**2 + 1 - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims - ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 - hyper_model = 1 - end if - if (surface_tension) then c_idx = sys_size + 1 sys_size = c_idx @@ -905,25 +885,6 @@ contains internalEnergies_idx%end = adv_idx%end + num_fluids sys_size = internalEnergies_idx%end - if (hypoelasticity .or. hyperelasticity) then - elasticity = .true. - stress_idx%beg = sys_size + 1 - stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 - ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D - sys_size = stress_idx%end - end if - - if (hyperelasticity) then - ! number of entries in the symmetric btensor plus the jacobian - b_size = (num_dims*(num_dims + 1))/2 + 1 - ! storing the jacobian in the last entry - tensor_size = num_dims**2 + 1 - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims - ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 - end if - if (surface_tension) then c_idx = sys_size + 1 sys_size = c_idx @@ -1021,6 +982,24 @@ contains end if ! END: Volume Fraction Model ======================================= + if (elasticity) then + ! creates stress indices for both hypo and hyperelasticity + stress_idx%beg = sys_size + 1 + stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 + ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D + sys_size = stress_idx%end + if (hyperelasticity) then + ! number of entries in the symmetric btensor plus the jacobian + b_size = (num_dims*(num_dims + 1))/2 + 1 + ! storing the jacobian in the last entry + tensor_size = num_dims**2 + 1 + xi_idx%beg = sys_size + 1 + xi_idx%end = sys_size + num_dims + ! adding three more equations for the \xi field and the elastic energy + sys_size = xi_idx%end + 1 + end if + end if + if (chemistry) then species_idx%beg = sys_size + 1 species_idx%end = sys_size + num_species diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index d0dcabbf93..8ed3b44b4d 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -169,7 +169,7 @@ contains g_x, g_y, g_z, n_start, t_save, t_stop, & cfl_adap_dt, cfl_const_dt, cfl_target, & viscous, surface_tension, & - hyperelasticity, R0ref + hyperelasticity, R0ref, elasticity ! Checking that an input file has been provided by the user. If it ! has, then the input file is read in, otherwise, simulation exits. diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 0f7c7b9fa8..f752ded1d4 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -802,6 +802,10 @@ contains if (adv_n) call s_comp_alpha_from_n(q_cons_ts(1)%vf) + call nvtxStartRange("RHS-ELASTIC") + if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_ts(1)%vf, q_prim_vf) + call nvtxEndRange + if (ib) then if (qbmm .and. .not. polytropic) then call s_ibm_correct_state(q_cons_ts(1)%vf, q_prim_vf, pb_ts(1)%sf, mv_ts(1)%sf) diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index 52854e4e2e..f84c0a5671 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -22,6 +22,7 @@ def analytic(self): return self.STR COMMON = { + 'elasticity': ParamType.LOG, 'hypoelasticity': ParamType.LOG, 'hyperelasticity': ParamType.LOG, 'cyl_coord': ParamType.LOG, @@ -243,6 +244,7 @@ def analytic(self): 'low_Mach': ParamType.INT, 'surface_tension': ParamType.LOG, 'viscous': ParamType.LOG, + 'hypermodel': ParamType.INT, }) for var in [ 'diffusion', 'reactions' ]: From 3c608c23055615ee843a4678318bbf1f6c69cb0d Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 22 Dec 2024 09:29:00 -0600 Subject: [PATCH 340/380] refined the checker common for the elasticity models --- src/common/m_checker_common.fpp | 39 ++++++++++++++++----------------- src/simulation/m_checker.fpp | 6 ----- 2 files changed, 19 insertions(+), 26 deletions(-) diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index 0025b90cf5..de6780bd3e 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -39,7 +39,6 @@ contains call s_check_inputs_bubbles call s_check_inputs_qbmm_and_polydisperse call s_check_inputs_adv_n - call s_check_inputs_hypoelasticity call s_check_inputs_phase_change call s_check_inputs_ibm #endif @@ -50,6 +49,7 @@ contains call s_check_inputs_weno call s_check_inputs_bc call s_check_inputs_stiffened_eos + call s_check_inputs_elasticity call s_check_inputs_surface_tension call s_check_inputs_moving_bc @@ -132,25 +132,6 @@ contains @:PROHIBIT(adv_n .and. qbmm) end subroutine - !> Checks constraints on the hypoelasticity parameters. - !! Called by s_check_inputs_common for pre-processing and simulation - subroutine s_check_inputs_hypoelasticity - @:PROHIBIT(hypoelasticity .and. model_eqns /= 2) -#ifdef MFC_SIMULATION - @:PROHIBIT(elasticity .and. fd_order /= 4) -#endif - end subroutine s_check_inputs_hypoelasticity - - !> Checks constraints on the hyperelasticity parameters. - !! Called by s_check_inputs_common for pre-processing and simulation - subroutine s_check_inputs_hyperelasticity - @:PROHIBIT(hyperelasticity .and. model_eqns == 1) - @:PROHIBIT(hyperelasticity .and. model_eqns > 3) -#ifdef MFC_SIMULATION - @:PROHIBIT(elasticity .and. fd_order /= 4) -#endif - end subroutine s_check_inputs_hyperelasticity - !> Checks constraints on the phase change parameters. !! Called by s_check_inputs_common for pre-processing and simulation subroutine s_check_inputs_phase_change @@ -177,6 +158,24 @@ contains #endif + !> Checks constraints on the elasticity parameters. + !! Called by s_check_inputs_common for pre-processing and simulation + subroutine s_check_inputs_elasticity + @:PROHIBIT((.not. elasticity) .and. (hypoelasticity .or. hyperelasticity), & + "Turn on elasticity to have either hyperelasticity or hypoelasticity") + @:PROHIBIT(elasticity .and. .not. (hypoelasticity .or. hyperelasticity), & + "Elasticity requires either hyperelasticity or hypoelasticity to be true") + @:PROHIBIT(elasticity .and. model_eqns == 1, & + "Elasticity does not work for model_eqns = 1") + @:PROHIBIT(elasticity .and. model_eqns > 3, & + "Elasticity works only for model_eqns 2 and 3") +#ifdef MFC_SIMULATION + @:PROHIBIT(elasticity .and. fd_order /= 4) + @:PROHIBIT(hyperelasticity .and. f_is_default(hyper_model), & + "Set the hyper_model in the input file") +#endif + end subroutine s_check_inputs_elasticity + !> Checks constraints on dimensionality and the number of cells for the grid. !! Called by s_check_inputs_common for all three stages subroutine s_check_inputs_simulation_domain diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index 3f4a9eaf43..f654592fcd 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -31,7 +31,6 @@ contains call s_check_inputs_time_stepping call s_check_inputs_model_eqns call s_check_inputs_acoustic_src - call s_check_inputs_hypoelasticity call s_check_inputs_bubbles call s_check_inputs_adapt_dt call s_check_inputs_alt_soundspeed @@ -257,11 +256,6 @@ contains end subroutine s_check_inputs_acoustic_src - !> Checks constraints on hypoelasticity parameters - subroutine s_check_inputs_hypoelasticity - !@:PROHIBIT(hypoelasticity .and. riemann_solver /= 1, "hypoelasticity requires HLL Riemann solver (riemann_solver = 1)") - end subroutine - !> Checks constraints on bubble parameters subroutine s_check_inputs_bubbles @:PROHIBIT(bubbles .and. riemann_solver /= 2, "Bubble modeling requires HLLC Riemann solver (riemann_solver = 2)") From 8e92fe5b6ab64f388970177cdb4ac3655506d7c3 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Sun, 22 Dec 2024 20:02:09 -0600 Subject: [PATCH 341/380] added elasticity as a mandatory flag to be added to the input file when running hypo or hyperelasticity --- examples/1D_hypo_2materials/case.py | 1 + examples/1D_impact/case.py | 1 + examples/1D_sodHypo/case.py | 1 + examples/3D_hyper_bubingel/case.py | 1 + examples/3D_hyper_bubinwater/case.py | 1 + examples/3D_lungwave/arc_case.py | 220 --------------------------- examples/3D_lungwave/case.py | 2 +- src/common/m_checker_common.fpp | 6 +- toolchain/mfc/test/cases.py | 2 +- 9 files changed, 10 insertions(+), 225 deletions(-) delete mode 100644 examples/3D_lungwave/arc_case.py diff --git a/examples/1D_hypo_2materials/case.py b/examples/1D_hypo_2materials/case.py index 94ce8d7258..3e517fa4d2 100755 --- a/examples/1D_hypo_2materials/case.py +++ b/examples/1D_hypo_2materials/case.py @@ -51,6 +51,7 @@ # ========================================================== # Turning on Hypoelasticity ================================ + 'elasticity' : 'T', 'hypoelasticity' : 'T', 'fd_order' : 4, # ========================================================== diff --git a/examples/1D_impact/case.py b/examples/1D_impact/case.py index c825b1df6b..cfcd536bff 100755 --- a/examples/1D_impact/case.py +++ b/examples/1D_impact/case.py @@ -51,6 +51,7 @@ # ========================================================== # Turning on Hypoelasticity ================================ + 'elasticity' : 'T', 'hypoelasticity' : 'T', 'fd_order' : 4, # ========================================================== diff --git a/examples/1D_sodHypo/case.py b/examples/1D_sodHypo/case.py index 3d5b551006..3c8c792de3 100755 --- a/examples/1D_sodHypo/case.py +++ b/examples/1D_sodHypo/case.py @@ -51,6 +51,7 @@ # ========================================================== # Turning on Hypoelasticity ================================ + 'elasticity' : 'T', 'hypoelasticity' : 'T', # ========================================================== diff --git a/examples/3D_hyper_bubingel/case.py b/examples/3D_hyper_bubingel/case.py index 4652c0e804..933770c5ab 100755 --- a/examples/3D_hyper_bubingel/case.py +++ b/examples/3D_hyper_bubingel/case.py @@ -292,6 +292,7 @@ 'num_patches' : 3, 'model_eqns' : 3, 'num_fluids' : 4, + 'elasticity' : 'T', 'hypoelasticity' : 'F', 'hyperelasticity' : 'T', 'mpp_lim' : 'T', diff --git a/examples/3D_hyper_bubinwater/case.py b/examples/3D_hyper_bubinwater/case.py index 9d9216ad3b..ccb1cc51d2 100755 --- a/examples/3D_hyper_bubinwater/case.py +++ b/examples/3D_hyper_bubinwater/case.py @@ -287,6 +287,7 @@ 'num_patches' : 3, 'model_eqns' : 3, 'num_fluids' : 4, + 'elasticity' : 'T', 'hypoelasticity' : 'F', 'hyperelasticity' : 'T', 'mpp_lim' : 'T', diff --git a/examples/3D_lungwave/arc_case.py b/examples/3D_lungwave/arc_case.py deleted file mode 100644 index 0efb7c9022..0000000000 --- a/examples/3D_lungwave/arc_case.py +++ /dev/null @@ -1,220 +0,0 @@ -#!/usr/bin/env python3 - -import math -import json - -pi = 3.141592653589 -# material parameters - -#material1 :: gas -#patterson 2018 - -gammag = 1.4 #unitless -Bg =0 #pascals -rhog = 1.18 #kg/m^3 -c_g = 347.2 #m/s -G_g = 0 #pa - -#material2 :: water -gammal = 5.5 -Bl = 492.E+06 -rhol = 996.0 -c_l = 1648.7 -G_l = 1E+06 - - -#primitive vartiables -patmos = 101325. #pa - -#problem specific variable -lambda_wave = 200.E-6 - -#define pulse -P_amp = 10.E+6 -P_len = 45 #length of the impulse -theta = -math.pi/2 #direction of propagation - -#non-dim - -#define characteristic density, length, time, stress material #make it liquid -rho_char = rhol -length_char = lambda_wave -c_char = c_l #should be liquid -time_char = length_char/c_char -stress_char = rho_char*c_char*c_char/gammal - -#non-dim the properties -rhog_n = rhog/rho_char -c_g_n = c_g/c_char -rhol_n = rhol/rho_char -c_l_n = c_l/c_char -Bg_n = Bg/stress_char -Bl_n = Bl/stress_char -G_g_n = G_g/stress_char -G_l_n = G_l/stress_char -patmos_n = patmos/stress_char -P_amp_n = P_amp/stress_char - -#geometry -dlengx = 15. -dlengy = 1. -dlengz = 1. -Ny = 25 -Nx = dlengx*Ny -Nz = dlengz*Ny -dx = dlengx/Nx -dy = dlengy/Ny -dz = dlengz/Nz -alphal_back = 1.0 -alphag_back = 0.0 -alphal_lung = 0.0 -alphag_lung = 1.0 - -interface_amp = 0.03 - -# time stepping requirements -time_end = 50 -cfl = 0.01 - -dt = cfl * dx/c_l_n -Nt = int(time_end/dt) -Nframes = 500 -tstart = 0 -tstop = Nt -tsave = int(Nt/Nframes) - -# Configuring case dictionary -print(json.dumps({ - # Logistics ================================================================ - 'run_time_info' : 'T', - #'sim_data' : 'T', - # ========================================================================== - - # Computational Domain Parameters ========================================== - 'x_domain%beg' : -dlengx/2., - 'x_domain%end' : dlengx/2., - 'y_domain%beg' : 0., - 'y_domain%end' : dlengy, - 'z_domain%beg' : 0., - 'z_domain%end' : dlengz, - 'm' : int(Nx), - 'n' : int(Ny), - 'p' : int(Nz), - 'stretch_x' : 'F', - 'a_x' : 4.0E+00, - 'x_a' : -5., - 'x_b' : 5., - 'loops_x' : 0, - 'dt' : dt, - 't_step_start' : tstart, - 't_step_stop' : tstop, - 't_step_save' : tsave, - # ========================================================================== - - # Simulation Algorithm Parameters ========================================== - 'num_patches' : 2, - 'model_eqns' : 3, - 'alt_soundspeed' : 'F', - 'num_fluids' : 2, - 'mpp_lim' : 'T', - 'mixture_err' : 'T', - 'time_stepper' : 3, - 'weno_order' : 5, - 'weno_eps' : 1.E-16, - 'weno_Re_flux' : 'F', - 'weno_avg' : 'F', - 'mapped_weno' : 'T', - 'null_weights' : 'F', - 'mp_weno' : 'T', - 'riemann_solver' : 2, - 'wave_speeds' : 1, - 'avg_state' : 2, - 'bc_x%beg' : -6, - 'bc_x%end' : -6, - 'bc_y%beg' : -1, - 'bc_y%end' : -1, - 'bc_z%beg' : -1, - 'bc_z%end' : -1, - # ========================================================================== - - # Turning on Hypoelasticity ================================================ - #'hypoelasticity' : 'T', - 'hyperelasticity' : 'F', - # ========================================================================== - - # Formatted Database Files Structure Parameters ============================ - 'format' : 1, - 'precision' : 2, - 'prim_vars_wrt' :'T', - 'parallel_io' :'T', - # ========================================================================== - - # acoustics setting ========================================================= - 'acoustic_source' : 'T', - 'num_source' : 1, - 'acoustic(1)%support' : 3, - 'acoustic(1)%loc(1)' : 4, - 'acoustic(1)%loc(2)' : dlengy/2, - #'acoustic(1)%loc(3)' : dlengz/2, - 'acoustic(1)%pulse' : 3, - 'acoustic(1)%npulse' : 1, - 'acoustic(1)%wavelength' : P_len, #wavelength of the signal - 'acoustic(1)%mag' : P_amp_n, - 'acoustic(1)%length' : dlengy, #length of the place ??? - 'acoustic(1)%height' : dlengz, - 'acoustic(1)%dir' : -math.pi, - #=========================================================================== - - # Patch 1: Background ====================================================== - 'patch_icpp(1)%geometry' : 9, - 'patch_icpp(1)%x_centroid' : 0., - 'patch_icpp(1)%y_centroid' : dlengy/2., - 'patch_icpp(1)%z_centroid' : dlengz/2., - 'patch_icpp(1)%length_x' : 2000, #dlengx, # - 'patch_icpp(1)%length_y' : dlengy, - 'patch_icpp(1)%length_z' : dlengz, - 'patch_icpp(1)%vel(1)' : 0.E+00, - 'patch_icpp(1)%vel(2)' : 0.E+00, - 'patch_icpp(1)%vel(3)' : 0.E+00, - 'patch_icpp(1)%pres' : patmos_n, - 'patch_icpp(1)%alpha_rho(1)' : rhol_n*alphal_back, - 'patch_icpp(1)%alpha_rho(2)' : rhog_n*alphag_back, - 'patch_icpp(1)%alpha(1)' : alphal_back, - 'patch_icpp(1)%alpha(2)' : alphag_back, - #'patch_icpp(1)%tau_e(1)' : 0.0, - - # ========================================================================== - - # Patch 2: Lung ============================================================ - 'patch_icpp(2)%geometry' : 13, - 'patch_icpp(2)%hcid' : 301, - #'patch_icpp(2)%geometry' : 9, - 'patch_icpp(2)%alter_patch(1)' : 'T', - 'patch_icpp(2)%x_centroid' : -998,#-dlengx/4., # - 'patch_icpp(2)%y_centroid' : dlengy/2., - 'patch_icpp(2)%z_centroid' : dlengz/2., - 'patch_icpp(2)%length_x' : 2000,#dlengx,#dlengx/2.+2, # - 'patch_icpp(2)%length_y' : dlengy, - 'patch_icpp(2)%length_z' : dlengz, - 'patch_icpp(2)%a(2)' : interface_amp, - 'patch_icpp(2)%vel(1)' : 0.E+00, - 'patch_icpp(2)%vel(2)' : 0.0, - 'patch_icpp(2)%vel(3)' : 0.0, - 'patch_icpp(2)%pres' : patmos_n, - 'patch_icpp(2)%alpha_rho(1)' : rhol_n*alphal_lung, - 'patch_icpp(2)%alpha_rho(2)' : rhog_n*alphag_lung, - 'patch_icpp(2)%alpha(1)' : alphal_lung, - 'patch_icpp(2)%alpha(2)' : alphag_lung, - # ========================================================================== - - # Fluids Physical Parameters =============================================== - 'fluid_pp(1)%gamma' : 1.E+00/(gammal-1.E+00), - 'fluid_pp(1)%pi_inf' : gammal*Bl_n/(gammal-1.E+00), - 'fluid_pp(1)%G' : G_l_n, - 'fluid_pp(2)%gamma' : 1.E+00/(gammag-1.E+00), - 'fluid_pp(2)%pi_inf' : gammag*Bg_n/(gammag-1.E+00), - 'fluid_pp(2)%G' : G_g_n, - #============================================================================== -})) - -# ============================================================================== diff --git a/examples/3D_lungwave/case.py b/examples/3D_lungwave/case.py index b7a2b9e131..de75d02f97 100644 --- a/examples/3D_lungwave/case.py +++ b/examples/3D_lungwave/case.py @@ -137,7 +137,7 @@ # ========================================================================== # Turning on Hypoelasticity ================================================ - #'hypoelasticity' : 'T', + 'hypoelasticity' : 'F', 'hyperelasticity' : 'F', # ========================================================================== diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index de6780bd3e..6fe61d4693 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -159,9 +159,9 @@ contains #endif !> Checks constraints on the elasticity parameters. - !! Called by s_check_inputs_common for pre-processing and simulation + !! Called by s_check_inputs_common for all three stages subroutine s_check_inputs_elasticity - @:PROHIBIT((.not. elasticity) .and. (hypoelasticity .or. hyperelasticity), & + @:PROHIBIT((hypoelasticity .or. hyperelasticity) .and. (.not. elasticity), & "Turn on elasticity to have either hyperelasticity or hypoelasticity") @:PROHIBIT(elasticity .and. .not. (hypoelasticity .or. hyperelasticity), & "Elasticity requires either hyperelasticity or hypoelasticity to be true") @@ -171,7 +171,7 @@ contains "Elasticity works only for model_eqns 2 and 3") #ifdef MFC_SIMULATION @:PROHIBIT(elasticity .and. fd_order /= 4) - @:PROHIBIT(hyperelasticity .and. f_is_default(hyper_model), & + @:PROHIBIT(hyperelasticity .and. hyper_model .le. 0, & "Set the hyper_model in the input file") #endif end subroutine s_check_inputs_elasticity diff --git a/toolchain/mfc/test/cases.py b/toolchain/mfc/test/cases.py index b302a46b54..6f3bf889b6 100644 --- a/toolchain/mfc/test/cases.py +++ b/toolchain/mfc/test/cases.py @@ -526,7 +526,7 @@ def alter_hypoelasticity(dimInfo): # Hypoelasticity checks for num_fluids in [1,2]: stack.push(f"Hypoelasticity -> {num_fluids} Fluid(s)", { - "hypoelasticity": 'T', "num_fluids": num_fluids, + "hypoelasticity": 'T', "num_fluids": num_fluids, "elasticity": 'T', 'riemann_solver': 1, 'fd_order': 4, 'fluid_pp(1)%gamma': 0.3, 'fluid_pp(1)%pi_inf': 7.8E+05, From 5972e12a364f6848c842043d717baf89acf9966e Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Mon, 23 Dec 2024 09:40:46 -0500 Subject: [PATCH 342/380] fix ups --- src/simulation/m_checker.fpp | 7 ------- src/simulation/m_hyperelastic.fpp | 4 ++-- 2 files changed, 2 insertions(+), 9 deletions(-) diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index 3f4a9eaf43..cb0991d5cc 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -25,13 +25,11 @@ contains subroutine s_check_inputs call s_check_inputs_compilers - call s_check_inputs_weno call s_check_inputs_riemann_solver call s_check_inputs_time_stepping call s_check_inputs_model_eqns call s_check_inputs_acoustic_src - call s_check_inputs_hypoelasticity call s_check_inputs_bubbles call s_check_inputs_adapt_dt call s_check_inputs_alt_soundspeed @@ -257,11 +255,6 @@ contains end subroutine s_check_inputs_acoustic_src - !> Checks constraints on hypoelasticity parameters - subroutine s_check_inputs_hypoelasticity - !@:PROHIBIT(hypoelasticity .and. riemann_solver /= 1, "hypoelasticity requires HLL Riemann solver (riemann_solver = 1)") - end subroutine - !> Checks constraints on bubble parameters subroutine s_check_inputs_bubbles @:PROHIBIT(bubbles .and. riemann_solver /= 2, "Bubble modeling requires HLLC Riemann solver (riemann_solver = 2)") diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index bbd7028c43..601712ca3d 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -232,7 +232,7 @@ contains real(wp) :: trace real(wp) :: f13 = 1_wp/3_wp - integer :: i !< Generic loop iterators + integer :: i ! tensor is the symmetric tensor & calculate the trace of the tensor trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) @@ -272,7 +272,7 @@ contains real(wp) :: trace real(wp) :: f13 = 1_wp/3_wp - integer :: i !< Generic loop iterators + integer :: i !TODO Make this 1D and 2D capable ! tensor is the symmetric tensor & calculate the trace of the tensor From 509806c9708bf52e65f4368dd890bf25b4f33b08 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Mon, 23 Dec 2024 09:55:24 -0500 Subject: [PATCH 343/380] one broken example for CI, one removed one --- examples/3D_bubble_channel/case.py | 384 ----------------------------- toolchain/mfc/test/cases.py | 2 +- 2 files changed, 1 insertion(+), 385 deletions(-) delete mode 100755 examples/3D_bubble_channel/case.py diff --git a/examples/3D_bubble_channel/case.py b/examples/3D_bubble_channel/case.py deleted file mode 100755 index 6fc04870c0..0000000000 --- a/examples/3D_bubble_channel/case.py +++ /dev/null @@ -1,384 +0,0 @@ -#!/usr/bin/env python3 -import math, json - -## 1 FOR BACKGROUND, 2 FOR BUBBLE, 3 FOR GEL -# Pressure [Pa] -p01 = 101325. -p02 = 101325 -p03 = p01 - -# Temperature [K] -T01 = 298.15 -T02 = 298.15 -T03 = T01 - -#### FLUID PROPERTIES #### - -### liquid water ### -# pi infty -piwl = 1.0E+09 -# qv -qvwl = -1167000 -# qv' -qvpwl = 0.0E0 -# cv -cvwl = 1816 -# cp -cpwl = 4267 -# gamma -gamwl = cpwl / cvwl - -## FOR PATCHES 1 & 2 ## - -# density -rho0wl1 = (p01 + piwl)/((gamwl-1)*cvwl*T01) -rho0wl2 = (p02 + piwl)/((gamwl-1)*cvwl*T02) -rho0wl3 = (p03 + piwl)/((gamwl-1)*cvwl*T03) - -# speed of sound FOR -c_wl1 = math.sqrt( gamwl * ( p01 + piwl ) / rho0wl1 ) -c_wl2 = math.sqrt( gamwl * ( p02 + piwl ) / rho0wl2 ) -c_wl3 = math.sqrt( gamwl * ( p03 + piwl ) / rho0wl3 ) - -# part for Gases - relations from IMR -Ru = 8.3144598 # Universal gas constant (J/mol-K) - -### Vapor water ### -Rv = Ru/(18.01528e-3) # Gas constant for vapor (Ru/molecular weight) (J/kg-K) -# gamma -gamwv = 1.4 -# cp -cpwv = Rv * gamwv/(gamwv-1) -# cv -cvwv = cpwv/gamwv -# pi infinity -piwv = 0.0E0 -# qv -qvwv = 2030000 -# qv' -qvpwv = -23400 - -## FOR PATCHES 1 & 2 ## - -# density -rho0wv1 = (p01 + piwv)/((gamwv-1)*cvwv*T01) -rho0wv2 = (p02 + piwv)/((gamwv-1)*cvwv*T02) -rho0wv3 = (p03 + piwv)/((gamwv-1)*cvwv*T03) - -# speed of sound -c_wv1 = math.sqrt( gamwv * ( p01 + piwv ) / rho0wv1 ) -c_wv2 = math.sqrt( gamwv * ( p02 + piwv ) / rho0wv2 ) -c_wv3 = math.sqrt( gamwv * ( p03 + piwv ) / rho0wv3 ) - -### Air ### - -Ra = Ru/(28.966e-3) # Gas constant for air (Ru/molecular weight) (J/kg-K) -gamwa = 1.4 -# cp -cpa = Ra * gamwa/(gamwa-1) -# cv -cva = cpa/gamwa -# pi infinity -pia = 0.0E0 -# qv -qvwa = 0.0E0 -# qv' -qvpwa = 0.0E0 - -## FOR PATCHES 1 & 2 ## - -# density -rho0wa1 = (p01 + pia)/((gamwa-1)*cva*T01) -rho0wa2 = (p02 + pia)/((gamwa-1)*cva*T02) -rho0wa3 = (p03 + pia)/((gamwa-1)*cva*T03) - -# Speed of sound -c_a1 = math.sqrt( gamwa * ( p01 + pia ) / rho0wa1 ) -c_a2 = math.sqrt( gamwa * ( p02 + pia ) / rho0wa2 ) -c_a3 = math.sqrt( gamwa * ( p03 + pia ) / rho0wa3 ) - -### 3% polyacrylamide gel ### - -# gamma -gamwg = gamwl #2.35 -# pi infty -pig = piwl #1.1754E+09 -# qv -qvwg = qvwl #0.0E0 -# qv' -qvpwg = qvpwl #0.0E0 -# cv -cvg = cvwl -# cp -cpg = gamwg*cvg - -## FOR PATCHES 1 & 2 & 3 ## - -# density -rho0wg1 = (p01 + pig)/((gamwg-1)*cvg*T01) -rho0wg2 = (p02 + pig)/((gamwg-1)*cvg*T02) -rho0wg3 = (p03 + pig)/((gamwg-1)*cvg*T03) - -# Speed of sound -c_g1 = math.sqrt( gamwg * ( p01 + pig ) / rho0wg1 ) -c_g2 = math.sqrt( gamwg * ( p02 + pig ) / rho0wg2 ) -c_g3 = math.sqrt( gamwg * ( p03 + pig ) / rho0wg3 ) - -## SHOCK RELATIONS -p02Op01 = p02 / p01 - -# Mach number of the shocked region - this should agree with Min, if everything is correct -Ms = math.sqrt( ( gamwa + 1. ) / ( 2. * gamwa ) * ( p02Op01 - 1. ) * ( p02 / ( p02 + pia ) ) + 1.0 ) - -# shock speed -ss = Ms * c_a1 - -### volume fractions for each of the patches ### -C0 = 0.25 # vapor concentration for IMR - -# patch 1: liquid water -liq_wg = 0 -liq_wa = 0*1.00E-15 -liq_wv = 1.00E-9 -liq_wl = 1.00E00 - liq_wv - liq_wa - liq_wg -# water vapor -vap_wl = 1.00E-9 -vap_wv = 1 / ( ( 1 - C0 ) / C0 * rho0wv2 / rho0wa2 + 1 ) -vap_wa = 0*1.00E-15 -vap_wg = 0 -vap_tot = vap_wl + vap_wv + vap_wa + vap_wg -# air -air_wl = 1.00E-15 -air_wv = vap_tot -air_wg = 0 -air_wa = 0*(1.00E00 - air_wl - air_wv - air_wg) -# bubble -bub_wl = 1.0E-9 -bub_wv = 1.0-bub_wl -bub_wg = 0 -bub_wa = 0*(1 - bub_wl - bub_wv - bub_wg) -# gel -gel_wl = 0 -gel_wv = 0 -gel_wa = 0 -gel_wg = 1.00E00 - gel_wl - gel_wv - gel_wa - -## Elasticity -Gl = 0 -Gv = 0 -Ga = 0 -Gg = 0.57E+03 - -## SIMULATION PARAMETERS - -# CFL - -# Bubble Initial Radius -R0 = 50E-06 - -# number of elements -Nx = 249 #404 #249 -Ny = 124 #179 #124 -Nz = 124 #179 #124 -Nx0 = Nx - -# domain boundaries -lref = 2*R0 -xb = -lref -xe = lref - -yb = 0.00 -ye = 2*lref - -zb = 0.00 -ze = 2*lref - -lenx = ( xe - xb ) -leny = ( ye - yb ) -lenz = ( ze - zb ) - -xcenl = 0. -ycenl = leny/2. -zcenl = lenz/2. - -#xdist = 6.51E-10 #2.17E-5 -#sod = xdist/R0 -sod = 0 -xcenb = sod*R0 #neg for bub in liq; pos bub in gel -ycenb = 0.00 -zcenb = 0.00 - -xceng = xe / 2. -yceng = ycenl -zceng = zcenl - -# typical cell size -dx = ( xe - xb ) / Nx -dy = ( ye - yb ) / Ny -dz = ( ze - zb ) / Nz -#print(dx) -PPBR_x = R0 / dx -PPBR_y = R0 / dy -PPBR_z = R0 / dz -#print(PPBR_x) -#print(PPBR_y) - -# save frequency = SF + 1 (because the initial state, 0.dat, is also saved) -SF = 100 - -# Critical time-step -tc = 0.915 * R0 * math.sqrt( rho0wl1 / p01 ) - -# making Nt divisible by SF -# tendA = 1.5 * tc -tend = 1.2 * tc - -# 1 - ensure NtA is sufficient to go a little beyond tendA -# NtA = int( tendA // dt + 1 ) - -# Array of saves. it is the same as Nt/Sf = t_step_save -# AS = int( NtA // SF + 1 ) - -# Nt = total number of steps. Ensure Nt > NtA (so the total tendA is covered) -# Nt = AS * SF -#Nt = int(2.5E3 * tend // tc * Nx / Nx0 + 1) -Nt = int(1E6 * tend // tc * Nx / Nx0 + 1) -#print(Nt) -dt = tend / Nt - -AS = int( Nt//SF ) -tstart = 0#2184 -# Total physical time -# tend = Nt * dt - -# Configuring case dictionary ================================================== -print(json.dumps({ - # Logistics ================================================ - 'run_time_info': 'T', - # ========================================================== - # Computational Domain Parameters ========================== - 'x_domain%beg' : xb, - 'x_domain%end' : xe, - 'y_domain%beg' : yb, - 'y_domain%end' : ye, - 'z_domain%beg' : zb, - 'z_domain%end' : ze, - 'stretch_x' : 'F', - 'loops_x' : 1, - 'a_x' : 4.0E0, - 'x_a' : -1.75*R0*(abs(sod)+1), - 'x_b' : 5*R0, - 'stretch_y' : 'F', - 'loops_y' : 2, - 'a_y' : 4.0E0, - 'y_a' : -2*R0*abs(sod), - 'y_b' : 2*R0*abs(sod), - 'stretch_z' : 'F', - 'loops_z' : 2, - 'a_z' : 4.0E0, - 'z_a' : -2*R0*abs(sod), - 'z_b' : 2*R0*abs(sod), - 'cyl_coord' : 'F', - 'm' : Nx, - 'n' : Ny, - 'p' : Nz, - 'dt' : dt, - 't_step_start' : tstart, - 't_step_stop' : Nt, - 't_step_save' : 1, - # ========================================================== - # Simulation Algorithm Parameters ========================== - 'num_patches' : 2, - 'model_eqns' : 3, - 'num_fluids' : 2, - #'alt_soundspeed' : 'T', - #'hypoelasticity' : 'F', - #'hyperelasticity' : 'F', - 'mpp_lim' : 'T', - 'mixture_err' : 'T', - #'relax' : 'T', - #'relax_model' : 6, - #'palpha_eps' : 1.0E-6, - #'ptgalpha_eps' : 1.0E-2, - 'time_stepper' : 3, - 'weno_order' : 5, - 'weno_eps' : 1.0E-16, - 'weno_Re_flux' : 'F', - 'weno_avg' : 'F', - 'mapped_weno' : 'F', - 'null_weights' : 'F', - 'mp_weno' : 'T', - 'riemann_solver' : 2, - 'wave_speeds' : 1, - 'avg_state' : 2, - 'bc_x%beg' : -16, #-2, - 'bc_x%end' : -16, - 'bc_y%beg' : -2, - 'bc_y%end' : -6, - 'bc_z%beg' : -2, - 'bc_z%end' : -6, - # ========================================================== - # Formatted Database Files Structure Parameters ============ - 'format' : 1, - 'precision' : 2, - 'prim_vars_wrt':'T', - 'parallel_io' :'T', - 'probe_wrt' :'T', - 'fd_order' : 1, - 'num_probes' : 1, - 'probe(1)%x' : 0., - 'probe(1)%y' : 0., - 'probe(1)%z' : 0., - # ========================================================== - # Patch 1: High pressured water ============================ - # Specify the cubic water background grid geometry - 'patch_icpp(1)%geometry' : 9, - 'patch_icpp(1)%x_centroid' : 20*xcenl, - 'patch_icpp(1)%y_centroid' : 20*ycenl, - 'patch_icpp(1)%z_centroid' : 20*zcenl, - 'patch_icpp(1)%length_x' : 20*lenx, - 'patch_icpp(1)%length_y' : 20*leny, - 'patch_icpp(1)%length_z' : 20*lenz, - 'patch_icpp(1)%vel(1)' : 0.0E+00, - 'patch_icpp(1)%vel(2)' : 0.0E+00, - 'patch_icpp(1)%vel(3)' : 0.0E+00, - 'patch_icpp(1)%pres' : p01, - 'patch_icpp(1)%alpha_rho(1)' : liq_wl * rho0wl1, - 'patch_icpp(1)%alpha_rho(2)' : liq_wv * rho0wv1, - 'patch_icpp(1)%alpha(1)' : liq_wl, - 'patch_icpp(1)%alpha(2)' : liq_wv, - # ========================================================== - # Patch 2: (Vapor) Bubble ================================== - 'patch_icpp(2)%geometry' : 8, - 'patch_icpp(2)%x_centroid' : xcenb, - 'patch_icpp(2)%y_centroid' : ycenb, - 'patch_icpp(2)%z_centroid' : zcenb, - 'patch_icpp(2)%radius' : R0, - 'patch_icpp(2)%smoothen' : 'T', - 'patch_icpp(2)%smooth_patch_id': 1, - 'patch_icpp(2)%smooth_coeff' : 0.5E+00, - 'patch_icpp(2)%vel(1)' : 0.0E+00, - 'patch_icpp(2)%vel(2)' : 0.0E+00, - 'patch_icpp(2)%vel(3)' : 0.0E+00, - 'patch_icpp(2)%pres' : p02, - 'patch_icpp(2)%alpha_rho(1)' : bub_wl*rho0wl2, - 'patch_icpp(2)%alpha_rho(2)' : bub_wv*rho0wv2, - 'patch_icpp(2)%alpha(1)' : bub_wl, - 'patch_icpp(2)%alpha(2)' : bub_wv, - 'patch_icpp(2)%alter_patch(1)' : 'T', - # ========================================================== - # Fluids Physical Parameters =============================== - 'fluid_pp(1)%gamma' : 1.0E+00 / ( gamwl - 1 ), - 'fluid_pp(1)%pi_inf' : gamwl * piwl / ( gamwl - 1 ), - 'fluid_pp(1)%cv' : cvwl, - 'fluid_pp(1)%qv' : qvwl, - 'fluid_pp(1)%qvp' : qvpwl, - #'fluid_pp(1)%G' : Gl, - 'fluid_pp(2)%gamma' : 1.0E+00 / ( gamwv - 1 ), - 'fluid_pp(2)%pi_inf' : gamwv * piwv / ( gamwv - 1 ), - 'fluid_pp(2)%cv' : cvwv, - 'fluid_pp(2)%qv' : qvwv, - 'fluid_pp(2)%qvp' : qvpwv, - #'fluid_pp(2)%G' : Gv, - # ========================================================== -})) diff --git a/toolchain/mfc/test/cases.py b/toolchain/mfc/test/cases.py index b302a46b54..4d435d790c 100644 --- a/toolchain/mfc/test/cases.py +++ b/toolchain/mfc/test/cases.py @@ -808,7 +808,7 @@ def foreach_example(): continue # # List of currently broken examples -> currently attempting to fix! - brokenCases = ["2D_ibm_cfl_dt", "1D_sodHypo", "2D_viscous", "2D_laplace_pressure_jump", "2D_bubbly_steady_shock", "2D_advection", "2D_hardcodied_ic", "2D_ibm_multiphase", "2D_acoustic_broadband", "1D_inert_shocktube", "1D_reactive_shocktube", "2D_ibm_steady_shock", "3D_performance_test", "3D_ibm_stl_ellipsoid", "3D_sphbubcollapse", "2D_ibm_stl_wedge", "3D_ibm_stl_pyramid", "3D_ibm_bowshock", "3D_turb_mixing", "2D_mixing_artificial_Ma"] + brokenCases = ["2D_ibm_cfl_dt", "1D_sodHypo", "2D_viscous", "2D_laplace_pressure_jump", "2D_bubbly_steady_shock", "2D_advection", "2D_hardcodied_ic", "2D_ibm_multiphase", "2D_acoustic_broadband", "1D_inert_shocktube", "1D_reactive_shocktube", "2D_ibm_steady_shock", "3D_performance_test", "3D_ibm_stl_ellipsoid", "3D_sphbubcollapse", "2D_ibm_stl_wedge", "3D_ibm_stl_pyramid", "3D_ibm_bowshock", "3D_turb_mixing", "2D_mixing_artificial_Ma", "3D_hyper_bubingel"] if path in brokenCases: continue name = f"{path.split('_')[0]} -> Example -> {'_'.join(path.split('_')[1:])}" From 2a3e593128af4755dd0dfb71e9d9fc28cdeb2319 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Mon, 23 Dec 2024 11:50:07 -0500 Subject: [PATCH 344/380] another bokren case! --- toolchain/mfc/test/cases.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/toolchain/mfc/test/cases.py b/toolchain/mfc/test/cases.py index 4d435d790c..f497c39b64 100644 --- a/toolchain/mfc/test/cases.py +++ b/toolchain/mfc/test/cases.py @@ -807,8 +807,8 @@ def foreach_example(): if path == "scaling": continue - # # List of currently broken examples -> currently attempting to fix! - brokenCases = ["2D_ibm_cfl_dt", "1D_sodHypo", "2D_viscous", "2D_laplace_pressure_jump", "2D_bubbly_steady_shock", "2D_advection", "2D_hardcodied_ic", "2D_ibm_multiphase", "2D_acoustic_broadband", "1D_inert_shocktube", "1D_reactive_shocktube", "2D_ibm_steady_shock", "3D_performance_test", "3D_ibm_stl_ellipsoid", "3D_sphbubcollapse", "2D_ibm_stl_wedge", "3D_ibm_stl_pyramid", "3D_ibm_bowshock", "3D_turb_mixing", "2D_mixing_artificial_Ma", "3D_hyper_bubingel"] + # List of currently broken examples -> currently attempting to fix! + brokenCases = ["2D_ibm_cfl_dt", "1D_sodHypo", "2D_viscous", "2D_laplace_pressure_jump", "2D_bubbly_steady_shock", "2D_advection", "2D_hardcodied_ic", "2D_ibm_multiphase", "2D_acoustic_broadband", "1D_inert_shocktube", "1D_reactive_shocktube", "2D_ibm_steady_shock", "3D_performance_test", "3D_ibm_stl_ellipsoid", "3D_sphbubcollapse", "2D_ibm_stl_wedge", "3D_ibm_stl_pyramid", "3D_ibm_bowshock", "3D_turb_mixing", "2D_mixing_artificial_Ma", "3D_hyper_bubingel", "3D_hyper_bubinwater"] if path in brokenCases: continue name = f"{path.split('_')[0]} -> Example -> {'_'.join(path.split('_')[1:])}" From a4feb6123f8961aa42634647385e7857ea17ab51 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 23 Dec 2024 17:38:10 -0600 Subject: [PATCH 345/380] RMT now with HLL, need to build test cases --- src/common/m_derived_types.fpp | 4 - src/pre_process/include/3dHardcodedIC.fpp | 2 +- src/simulation/m_riemann_solvers.fpp | 95 +++++++++++------------ 3 files changed, 46 insertions(+), 55 deletions(-) diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index 1199145784..aa1ce1fee9 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -168,7 +168,6 @@ module m_derived_types !! patch geometries. It is specified through its x-, y-, and z-components !! respectively. - type(ic_model_parameters) :: model !< real(wp) :: epsilon, beta !< !! The isentropic vortex parameters for the amplitude of the disturbance and !! domain of influence. @@ -178,9 +177,6 @@ module m_derived_types logical :: non_axis_sym - real(wp) :: a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 !< - !! The parameters needed for the spherical harmonic patch - real(wp), dimension(3) :: normal !< !! Normal vector indicating the orientation of the patch. It is specified !! through its x-, y- and z-components, respectively. diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp index de8a4c93b2..a59f7b3c68 100644 --- a/src/pre_process/include/3dHardcodedIC.fpp +++ b/src/pre_process/include/3dHardcodedIC.fpp @@ -62,7 +62,7 @@ case (302) ! (3D lung geometry in X direction - axisym, with smoothing) lam = 200.e-06_wp - amp = patch_icpp(patch_id)%a2 + amp = patch_icpp(patch_id)%a(2) h = 0.125_wp*amp intH = amp/2._wp*(sin(2._wp*pi*y_cc(j)/lam + pi/2._wp) + sin(2._wp*pi*z_cc(k)/lam + pi/2._wp)) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 6642af7a22..34757f50bf 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -549,7 +549,7 @@ contains tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) ! Elastic contribution to energy if G large enough !TODO take out if statement if stable without - if ((G_L > 1000) .and. (G_R > 1000)) then + if ((G_L > verysmall) .and. (G_R > verysmall)) then E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4._wp*G_L) E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4._wp*G_R) ! Additional terms in 2D and 3D @@ -561,37 +561,31 @@ contains end do end if - ! elastic energy update - !if ( hyperelasticity ) then - ! G_L = 0._wp - ! G_R = 0._wp - ! - ! !$acc loop seq - ! do i = 1, num_fluids - ! G_L = G_L + alpha_L(i)*Gs(i) - ! G_R = G_R + alpha_R(i)*Gs(i) - ! end do - ! ! Elastic contribution to energy if G large enough - ! if ((G_L > 1e-3_wp) .and. (G_R > 1e-3_wp)) then - ! E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) - ! E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) - ! !$acc loop seq - ! do i = 1, b_size-1 - ! tau_e_L(i) = G_L*qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) - ! tau_e_R(i) = G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) - ! end do - ! !$acc loop seq - ! do i = 1, b_size-1 - ! tau_e_L(i) = 0_wp - ! tau_e_R(i) = 0_wp - ! end do - ! !$acc loop seq - ! do i = 1, num_dims - ! xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) - ! xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) - ! end do - ! end if - !end if + ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY + if (hyperelasticity) then + !$acc loop seq + do i = 1, num_dims + xi_field_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) + xi_field_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, xibeg - 1 + i) + end do + G_L = 0_wp; G_R = 0_wp; + !$acc loop seq + do i = 1, num_fluids + ! Mixture left and right shear modulus + G_L = G_L + alpha_L(i)*Gs(i) + G_R = G_R + alpha_R(i)*Gs(i) + end do + ! Elastic contribution to energy if G large enough + if (G_L > verysmall .and. G_R > verysmall) then + E_L = E_L + G_L*qL_prim_rs${XYZ}$_vf(j, k, l, xiend + 1) + E_R = E_R + G_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, xiend + 1) + end if + !$acc loop seq + do i = 1, b_size - 1 + tau_e_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) + tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) + end do + end if ! Enthalpy with elastic energy H_L = (E_L + pres_L)/rho_L @@ -648,6 +642,7 @@ contains (s_R - vel_R(dir_idx(1)))) & /(rho_L*(s_L - vel_L(dir_idx(1))) - & rho_R*(s_R - vel_R(dir_idx(1)))) + elseif (wave_speeds == 2) then pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(dir_idx(1)) - & @@ -705,7 +700,7 @@ contains - rho_R*vel_R(dir_idx(i)))) & /(s_M - s_P) end do - else if (hypoelasticity) then + else if (elasticity) then !$acc loop seq do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & @@ -737,14 +732,14 @@ contains end do end if - ! Energy + ! ENERGY UPDATE if (bubbles) then flux_rs${XYZ}$_vf(j, k, l, E_idx) = & (s_M*vel_R(dir_idx(1))*(E_R + pres_R - ptilde_R) & - s_P*vel_L(dir_idx(1))*(E_L + pres_L - ptilde_L) & + s_M*s_P*(E_L - E_R)) & /(s_M - s_P) - else if (hypoelasticity) then + else if (elasticity) then !TODO: simplify this so it's not split into 3 if (num_dims == 1) then flux_rs${XYZ}$_vf(j, k, l, E_idx) = & @@ -785,9 +780,9 @@ contains /(s_M - s_P) end if - ! Elastic Stresses + ! ELASTIC STRESSES FLUX. if (hypoelasticity) then - do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow + do i = 1, strxe - strxb + 1 flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & (s_M*(rho_R*vel_R(dir_idx(1)) & *tau_e_R(i)) & @@ -799,7 +794,19 @@ contains end do end if - ! Advection + ! REFERENCE MAP FLUX. + if (hyperelasticity) then + do i = 1, num_dims + flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & + (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & + - s_P*rho_L*vel_L(dir_idx(1))*xi_field_L(i) & + + s_M*s_P*(rho_L*xi_field_L(i) & + - rho_R*xi_field_R(i))) & + /(s_M - s_P) + end do + end if + + ! ADVECTION FLUX. !$acc loop seq do i = advxb, advxe flux_rs${XYZ}$_vf(j, k, l, i) = & @@ -812,18 +819,6 @@ contains /(s_M - s_P) end do - ! Xi field - !if ( hyperelasticity ) then - ! do i = 1, num_dims - ! flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & - ! (s_M*rho_R*vel_R(dir_idx(1))*xi_field_R(i) & - ! - s_P*rho_L*vel_L(dir_idx(1))*xi_field_L(i) & - ! + s_M*s_P*(rho_L*xi_field_L(i) & - ! - rho_R*xi_field_R(i))) & - ! /(s_M - s_P) - ! end do - !end if - ! Div(U)? !$acc loop seq do i = 1, num_dims From c227fbf2bd47f55cea6dffcebe1d9bdd695effd5 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 23 Dec 2024 17:56:25 -0600 Subject: [PATCH 346/380] additional clean up for interface energy data --- src/post_process/m_start_up.f90 | 22 ---------------------- 1 file changed, 22 deletions(-) diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index cfb8715cbe..cbbfd6eab8 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -619,18 +619,6 @@ subroutine s_save_data(t_step, varname, pres, c, H) -offset_y%beg:n + offset_y%end, & -offset_z%beg:p + offset_z%end) - !do k = -offset_z%beg, p + offset_z%end - ! do j = -offset_y%beg, n + offset_y%end - ! do i = -offset_x%beg, m + offset_x%end - ! if (q_sf(i,j,k) > 0.5) then - ! q_sf(i,j,k) = 100000 + 8/0.15 - ! else - ! q_sf(i,j,k) = 100000 - ! end if - ! end do - ! end do - !end do - write (varname, '(A,I0)') 'color_function' call s_write_variable_to_formatted_database_file(varname, t_step) varname(:) = ' ' @@ -711,11 +699,6 @@ subroutine s_save_data(t_step, varname, pres, c, H) end if end if -! if (proc_rank == 0 .and. sim_data) then -! close (211) -! close (251) -! end if - if (sim_data .and. proc_rank == 0) then call s_close_intf_data_file() call s_close_energy_data_file() @@ -779,11 +762,6 @@ subroutine s_finalize_modules ! Disassociate pointers for serial and parallel I/O s_read_data_files => null() -! if (sim_data .and. proc_rank == 0) then -! call s_close_intf_data_file() -! call s_close_energy_data_file() -! end if - ! Deallocation procedures for the modules call s_finalize_data_output_module() call s_finalize_derived_variables_module() From e080104940f90f9a5645425d893336764982ae17 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 23 Dec 2024 19:35:36 -0600 Subject: [PATCH 347/380] clean up of the code --- src/post_process/m_data_output.fpp | 42 +++++++++++++++--------------- src/post_process/m_start_up.f90 | 2 +- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 04e9ac1be6..63a6f8eef3 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -579,7 +579,7 @@ contains ! Relative path to a file in the case directory character(LEN=path_len + 3*name_len) :: file_path - ! Kymo information is in binary database format + ! Kymo information is in binary database format ! Generates relative path to database, opened for current time-step write (file_path, '(A)') '/kymo_data.dat' file_path = trim(case_dir)//trim(file_path) @@ -590,7 +590,7 @@ contains POSITION='append', & STATUS='unknown') - end subroutine s_open_kymo_data_file ! ---------------------------------------- + end subroutine s_open_kymo_data_file ! ---------------------------------------- subroutine s_write_grid_to_formatted_database_file(t_step) ! ----------- ! Description: The general objective of this subroutine is to write the @@ -1244,32 +1244,32 @@ contains real(kind(0d0)) :: vonMises_d, vonMises_h1 !< selected planes for kymograph comparison real(kind(0d0)) :: vonMises_h2, vonMises_h3 ! Date: Mon, 23 Dec 2024 19:46:59 -0600 Subject: [PATCH 348/380] fixing wp issues --- src/post_process/m_data_output.fpp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 63a6f8eef3..f563a71188 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -1241,9 +1241,9 @@ contains subroutine s_write_kymo_data_file(q_prim_vf) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer :: j, k, l, t !< Generic loop iterators - real(kind(0d0)) :: vonMises_d, vonMises_h1 !< selected planes for kymograph comparison - real(kind(0d0)) :: vonMises_h2, vonMises_h3 ! Date: Mon, 23 Dec 2024 20:03:51 -0600 Subject: [PATCH 349/380] added examples to be made tests after verifying --- examples/1D_hyper_impact_strong/case.py | 102 ++++++++++++++++++++++ examples/1D_hyper_impact_weak/case.py | 102 ++++++++++++++++++++++ examples/1D_hyper_impact_weak/original.py | 102 ++++++++++++++++++++++ examples/1D_hypo_impact_strong/case.py | 102 ++++++++++++++++++++++ examples/1D_hypo_impact_weak/case.py | 95 ++++++++++++++++++++ submit_hyper.sh | 9 -- 6 files changed, 503 insertions(+), 9 deletions(-) create mode 100755 examples/1D_hyper_impact_strong/case.py create mode 100755 examples/1D_hyper_impact_weak/case.py create mode 100755 examples/1D_hyper_impact_weak/original.py create mode 100755 examples/1D_hypo_impact_strong/case.py create mode 100755 examples/1D_hypo_impact_weak/case.py delete mode 100755 submit_hyper.sh diff --git a/examples/1D_hyper_impact_strong/case.py b/examples/1D_hyper_impact_strong/case.py new file mode 100755 index 0000000000..2672fab741 --- /dev/null +++ b/examples/1D_hyper_impact_strong/case.py @@ -0,0 +1,102 @@ +#!/usr/bin/env python3 +import math +import json + +#Numerical setup +Nx = 201 +dx = 1./(1.*(Nx+1)) + +Tend = 41E-06 +Nt = 4000 +mydt = Tend/(1.*Nt) + +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================ + 'run_time_info' : 'T', + # ========================================================== + + # Computational Domain Parameters ========================== + 'x_domain%beg' : 0.E+00, + 'x_domain%end' : 1.E+00, +# 'y_domain%beg' : 0.E+00, +# 'y_domain%end' : 0.002, + 'm' : Nx, + 'n' : 0, + 'p' : 0, + 'dt' : mydt, + 't_step_start' : 0, + 't_step_stop' : int(Nt), + 't_step_save' : int(Nt/200), + # ========================================================== + + # Simulation Algorithm Parameters ========================== + 'num_patches' : 2, + 'model_eqns' : 2, + 'alt_soundspeed' : 'F', + 'num_fluids' : 1, + 'mpp_lim' : 'F', + 'mixture_err' : 'F', + 'time_stepper' : 3, + 'weno_order' : 5, + 'weno_eps' : 1.E-16, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'F', + 'null_weights' : 'F', + 'mp_weno' : 'T', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -3, + 'bc_x%end' : -3, + #'bc_y%beg' : -3, + #'bc_y%end' : -3, + # ========================================================== + + # Turning on Hypoelasticity ================================ + 'hyperelasticity' : 'T', + # ========================================================== + + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'F', + # ========================================================== + + # Patch 1 L ================================================ + 'patch_icpp(1)%geometry' : 1, + 'patch_icpp(1)%x_centroid' : 0.25, + # 'patch_icpp(1)%y_centroid' : 0.001, + 'patch_icpp(1)%length_x' : 0.5, + # 'patch_icpp(1)%length_y' : 0.002, + 'patch_icpp(1)%vel(1)' : 1000, + # 'patch_icpp(1)%vel(2)' : 100*0, + 'patch_icpp(1)%pres' : 1.E+5, + 'patch_icpp(1)%alpha_rho(1)' : 1000, + 'patch_icpp(1)%alpha(1)' : 1., + 'patch_icpp(1)%tau_e(1)' : 0.0, + # ========================================================== + + # Patch 2 R ================================================ + 'patch_icpp(2)%geometry' : 1, + 'patch_icpp(2)%x_centroid' : 0.75, +# 'patch_icpp(2)%y_centroid' : 0.001, + 'patch_icpp(2)%length_x' : 0.5, +# 'patch_icpp(2)%length_y' : 0.002, + 'patch_icpp(2)%vel(1)' : 1000, +# 'patch_icpp(2)%vel(2)' : -100*0, + 'patch_icpp(2)%pres' : 1.E+05, + 'patch_icpp(2)%alpha_rho(1)' : 1000, + 'patch_icpp(2)%alpha(1)' : 1., + 'patch_icpp(2)%tau_e(1)' : 0.0, + # ========================================================== + + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1.E+00/(4.4E+00-1.E+00), + 'fluid_pp(1)%pi_inf' : 4.4E+00*6.E+08/(4.4E+00 - 1.E+00), + 'fluid_pp(1)%G' : 1E+010, + # ========================================================== +})) +# ============================================================================== diff --git a/examples/1D_hyper_impact_weak/case.py b/examples/1D_hyper_impact_weak/case.py new file mode 100755 index 0000000000..cedf1d86e2 --- /dev/null +++ b/examples/1D_hyper_impact_weak/case.py @@ -0,0 +1,102 @@ +#!/usr/bin/env python3 +import math +import json + +#Numerical setup +Nx = 201 +dx = 1./(1.*(Nx+1)) + +Tend = 64E-06 +Nt = 4000 +mydt = Tend/(1.E+00*Nt) +#print(mydt) +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================ + 'run_time_info' : 'T', + # ========================================================== + + # Computational Domain Parameters ========================== + 'x_domain%beg' : 0.E+00, + 'x_domain%end' : 1.E+00, + 'y_domain%beg' : 0.E+00, + 'y_domain%end' : 0.002, + 'm' : Nx, + 'n' : 0, + 'p' : 0, + 'dt' : mydt, + 't_step_start' : 0, + 't_step_stop' : int(Nt), + 't_step_save' : int(Nt/200), + # ========================================================== + + # Simulation Algorithm Parameters ========================== + 'num_patches' : 2, + 'model_eqns' : 3, + 'alt_soundspeed' : 'F', + 'num_fluids' : 1, + 'mpp_lim' : 'F', + 'mixture_err' : 'F', + 'time_stepper' : 3, + 'weno_order' : 5, + 'weno_eps' : 1.E-16, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'F', + 'null_weights' : 'F', + 'mp_weno' : 'T', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -3, + 'bc_x%end' : -3, + 'bc_y%beg' : -3, + 'bc_y%end' : -3, + # ========================================================== + + # Turning on Hyperelasticity ================================ + 'hyperelasticity' : 'T', + # ========================================================== + + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'F', + # ========================================================== + + # Patch 1 L ================================================ + 'patch_icpp(1)%geometry' : 1, + 'patch_icpp(1)%x_centroid' : 0.25, + 'patch_icpp(1)%y_centroid' : 0.001, + 'patch_icpp(1)%length_x' : 0.5, + 'patch_icpp(1)%length_y' : 0.002, + 'patch_icpp(1)%vel(1)' : 10, + 'patch_icpp(1)%vel(2)' : 0, + 'patch_icpp(1)%pres' : 1.E+5, + 'patch_icpp(1)%alpha_rho(1)' : 1000, + 'patch_icpp(1)%alpha(1)' : 1., + 'patch_icpp(1)%tau_e(1)' : 0.0, + # ========================================================== + + # Patch 2 R ================================================ + 'patch_icpp(2)%geometry' : 1, + 'patch_icpp(2)%x_centroid' : 0.75, + 'patch_icpp(2)%y_centroid' : 0.001, + 'patch_icpp(2)%length_x' : 0.5, + 'patch_icpp(2)%length_y' : 0.002, + 'patch_icpp(2)%vel(1)' : -10, #10, + 'patch_icpp(2)%vel(2)' : 0, + 'patch_icpp(2)%pres' : 1.E+05, + 'patch_icpp(2)%alpha_rho(1)' : 1000, + 'patch_icpp(2)%alpha(1)' : 1., + 'patch_icpp(2)%tau_e(1)' : 0.0, + # ========================================================== + + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1.E+00/(4.4E+00-1.E+00), + 'fluid_pp(1)%pi_inf' : 4.4E+00*6.E+08/(4.4E+00 - 1.E+00), + 'fluid_pp(1)%G' : 1.E+00, #.E+010, + # ========================================================== +})) +# ============================================================================== diff --git a/examples/1D_hyper_impact_weak/original.py b/examples/1D_hyper_impact_weak/original.py new file mode 100755 index 0000000000..ed42d9824b --- /dev/null +++ b/examples/1D_hyper_impact_weak/original.py @@ -0,0 +1,102 @@ +#!/usr/bin/env python3 +import math +import json + +#Numerical setup +Nx = 201 +dx = 1./(1.*(Nx+1)) + +Tend = 64E-06 +Nt = 4000 +mydt = Tend/(1.E+00*Nt) +#print(mydt) +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================ + 'run_time_info' : 'T', + # ========================================================== + + # Computational Domain Parameters ========================== + 'x_domain%beg' : 0.E+00, + 'x_domain%end' : 1.E+00, +# 'y_domain%beg' : 0.E+00, +# 'y_domain%end' : 0.002, + 'm' : Nx, + 'n' : 0, + 'p' : 0, + 'dt' : mydt, + 't_step_start' : 0, + 't_step_stop' : int(Nt), + 't_step_save' : int(Nt/200), + # ========================================================== + + # Simulation Algorithm Parameters ========================== + 'num_patches' : 2, + 'model_eqns' : 3, + 'alt_soundspeed' : 'F', + 'num_fluids' : 1, + 'mpp_lim' : 'F', + 'mixture_err' : 'F', + 'time_stepper' : 3, + 'weno_order' : 5, + 'weno_eps' : 1.E-16, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'F', + 'null_weights' : 'F', + 'mp_weno' : 'T', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -3, + 'bc_x%end' : -3, + #'bc_y%beg' : -3, + #'bc_y%end' : -3, + # ========================================================== + + # Turning on Hyperelasticity ================================ + 'hyperelasticity' : 'T', + # ========================================================== + + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'F', + # ========================================================== + + # Patch 1 L ================================================ + 'patch_icpp(1)%geometry' : 1, + 'patch_icpp(1)%x_centroid' : 0.25, + # 'patch_icpp(1)%y_centroid' : 0.001, + 'patch_icpp(1)%length_x' : 0.5, + # 'patch_icpp(1)%length_y' : 0.002, + 'patch_icpp(1)%vel(1)' : 10, + # 'patch_icpp(1)%vel(2)' : 100*0, + 'patch_icpp(1)%pres' : 1.E+5, + 'patch_icpp(1)%alpha_rho(1)' : 1000, + 'patch_icpp(1)%alpha(1)' : 1., + 'patch_icpp(1)%tau_e(1)' : 0.0, + # ========================================================== + + # Patch 2 R ================================================ + 'patch_icpp(2)%geometry' : 1, + 'patch_icpp(2)%x_centroid' : 0.75, +# 'patch_icpp(2)%y_centroid' : 0.001, + 'patch_icpp(2)%length_x' : 0.5, +# 'patch_icpp(2)%length_y' : 0.002, + 'patch_icpp(2)%vel(1)' : 10, #-10, +# 'patch_icpp(2)%vel(2)' : -100*0, + 'patch_icpp(2)%pres' : 1.E+05, + 'patch_icpp(2)%alpha_rho(1)' : 1000, + 'patch_icpp(2)%alpha(1)' : 1., + 'patch_icpp(2)%tau_e(1)' : 0.0, + # ========================================================== + + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1.E+00/(4.4E+00-1.E+00), + 'fluid_pp(1)%pi_inf' : 4.4E+00*6.E+08/(4.4E+00 - 1.E+00), + 'fluid_pp(1)%G' : 1.E+00, #.E+010, + # ========================================================== +})) +# ============================================================================== diff --git a/examples/1D_hypo_impact_strong/case.py b/examples/1D_hypo_impact_strong/case.py new file mode 100755 index 0000000000..4cf6405d45 --- /dev/null +++ b/examples/1D_hypo_impact_strong/case.py @@ -0,0 +1,102 @@ +#!/usr/bin/env python3 +import math +import json + +#Numerical setup +Nx = 201 +dx = 1./(1.*(Nx+1)) + +Tend = 41E-06 +Nt = 4000 +mydt = Tend/(1.*Nt) + +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================ + 'run_time_info' : 'T', + # ========================================================== + + # Computational Domain Parameters ========================== + 'x_domain%beg' : 0.E+00, + 'x_domain%end' : 1.E+00, +# 'y_domain%beg' : 0.E+00, +# 'y_domain%end' : 0.002, + 'm' : Nx, + 'n' : 0, + 'p' : 0, + 'dt' : mydt, + 't_step_start' : 0, + 't_step_stop' : int(Nt), + 't_step_save' : int(Nt/200), + # ========================================================== + + # Simulation Algorithm Parameters ========================== + 'num_patches' : 2, + 'model_eqns' : 2, + 'alt_soundspeed' : 'F', + 'num_fluids' : 1, + 'mpp_lim' : 'F', + 'mixture_err' : 'F', + 'time_stepper' : 3, + 'weno_order' : 5, + 'weno_eps' : 1.E-16, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'F', + 'null_weights' : 'F', + 'mp_weno' : 'T', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -3, + 'bc_x%end' : -3, + #'bc_y%beg' : -3, + #'bc_y%end' : -3, + # ========================================================== + + # Turning on Hypoelasticity ================================ + 'hypoelasticity' : 'T', + # ========================================================== + + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'F', + # ========================================================== + + # Patch 1 L ================================================ + 'patch_icpp(1)%geometry' : 1, + 'patch_icpp(1)%x_centroid' : 0.25, + # 'patch_icpp(1)%y_centroid' : 0.001, + 'patch_icpp(1)%length_x' : 0.5, + # 'patch_icpp(1)%length_y' : 0.002, + 'patch_icpp(1)%vel(1)' : 1000, + # 'patch_icpp(1)%vel(2)' : 100*0, + 'patch_icpp(1)%pres' : 1.E+5, + 'patch_icpp(1)%alpha_rho(1)' : 1000, + 'patch_icpp(1)%alpha(1)' : 1., + 'patch_icpp(1)%tau_e(1)' : 0.0, + # ========================================================== + + # Patch 2 R ================================================ + 'patch_icpp(2)%geometry' : 1, + 'patch_icpp(2)%x_centroid' : 0.75, +# 'patch_icpp(2)%y_centroid' : 0.001, + 'patch_icpp(2)%length_x' : 0.5, +# 'patch_icpp(2)%length_y' : 0.002, + 'patch_icpp(2)%vel(1)' : 1000, +# 'patch_icpp(2)%vel(2)' : -100*0, + 'patch_icpp(2)%pres' : 1.E+05, + 'patch_icpp(2)%alpha_rho(1)' : 1000, + 'patch_icpp(2)%alpha(1)' : 1., + 'patch_icpp(2)%tau_e(1)' : 0.0, + # ========================================================== + + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1.E+00/(4.4E+00-1.E+00), + 'fluid_pp(1)%pi_inf' : 4.4E+00*6.E+08/(4.4E+00 - 1.E+00), + 'fluid_pp(1)%G' : 1E+010, + # ========================================================== +})) +# ============================================================================== diff --git a/examples/1D_hypo_impact_weak/case.py b/examples/1D_hypo_impact_weak/case.py new file mode 100755 index 0000000000..956203ec95 --- /dev/null +++ b/examples/1D_hypo_impact_weak/case.py @@ -0,0 +1,95 @@ +#!/usr/bin/env python3 +import math +import json + +#Numerical setup +Nx = 201 +dx = 1./(1.*(Nx+1)) + +Tend = 64E-06 +Nt = 4000 +mydt = Tend/(1.*Nt) + +# Configuring case dictionary +print(json.dumps({ + # Logistics ================================================ + 'run_time_info' : 'T', + # ========================================================== + + # Computational Domain Parameters ========================== + 'x_domain%beg' : 0.E+00, + 'x_domain%end' : 1.E+00, + 'm' : Nx, + 'n' : 0, + 'p' : 0, + 'dt' : mydt, + 't_step_start' : 0, + 't_step_stop' : int(Nt), + 't_step_save' : int(Nt/200), + # ========================================================== + # Simulation Algorithm Parameters ========================== + 'num_patches' : 2, + 'model_eqns' : 2, + 'alt_soundspeed' : 'F', + 'num_fluids' : 2, + 'mpp_lim' : 'F', + 'mixture_err' : 'F', + 'time_stepper' : 3, + 'weno_order' : 5, + 'weno_eps' : 1.E-16, + 'weno_Re_flux' : 'F', + 'weno_avg' : 'F', + 'mapped_weno' : 'F', + 'null_weights' : 'F', + 'mp_weno' : 'T', + 'riemann_solver' : 2, + 'wave_speeds' : 1, + 'avg_state' : 2, + 'bc_x%beg' : -3, + 'bc_x%end' : -3, + # ========================================================== + + # Turning on Hypoelasticity ================================ + 'hypoelasticity' : 'T', + # ========================================================== + + # Formatted Database Files Structure Parameters ============ + 'format' : 1, + 'precision' : 2, + 'prim_vars_wrt' :'T', + 'parallel_io' :'F', + # ========================================================== + # Patch 1 L ================================================ + 'patch_icpp(1)%geometry' : 1, + 'patch_icpp(1)%x_centroid' : 0.25, + 'patch_icpp(1)%length_x' : 0.5, + 'patch_icpp(1)%vel(1)' : 10, + 'patch_icpp(1)%pres' : 1.E+5, + 'patch_icpp(1)%alpha_rho(1)' : 1000, + 'patch_icpp(1)%alpha_rho(2)' : 0., + 'patch_icpp(1)%alpha(1)' : 1., + 'patch_icpp(1)%alpha(2)' : 0., + 'patch_icpp(1)%tau_e(1)' : 0.0, + # ========================================================== + # Patch 2 R ================================================ + 'patch_icpp(2)%geometry' : 1, + 'patch_icpp(2)%x_centroid' : 0.75, + 'patch_icpp(2)%length_x' : 0.5, + 'patch_icpp(2)%vel(1)' : -10, + 'patch_icpp(2)%pres' : 1.E+05, + 'patch_icpp(2)%alpha_rho(1)' : 0., + 'patch_icpp(2)%alpha_rho(2)' : 1000, + 'patch_icpp(2)%alpha(1)' : 0., + 'patch_icpp(2)%alpha(2)' : 1., + 'patch_icpp(2)%tau_e(1)' : 0.0, + # ========================================================== + # Fluids Physical Parameters =============================== + 'fluid_pp(1)%gamma' : 1.E+00/(4.4E+00-1.E+00), + 'fluid_pp(1)%pi_inf' : 4.4E+00*6.E+08/(4.4E+00 - 1.E+00), + 'fluid_pp(1)%G' : 1E+010, + 'fluid_pp(2)%gamma' : 1.E+00/(4.4E+00-1.E+00), + 'fluid_pp(2)%pi_inf' : 4.4E+00*6.E+08/(4.4E+00 - 1.E+00), + 'fluid_pp(2)%G' : 1E+010, + # ========================================================== +})) +# ============================================================================== diff --git a/submit_hyper.sh b/submit_hyper.sh deleted file mode 100755 index 34dba386de..0000000000 --- a/submit_hyper.sh +++ /dev/null @@ -1,9 +0,0 @@ -#!/bin/bash - -#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -./mfc.sh run /projects/bciv/mcarcanabarbosa/kymo/geldef.py -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta -#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t pre_process -c oscar -#./mfc.sh run ./examples/3D_hyperelasticity/hyper_gel.py -p batch -N 1 -n 4 -g 0 -w 01:00:00 -# test1 -t simulation -c oscar -#./mfc.sh run /scratch/bciv/rodrigu1/cav2024/hyper/hyper_gel.py -p gpuA40x4 -N 1 -n 1 -g 1 -w 01:00:00 -# test1 -t post_process -a bciv-delta-gpu -c delta - -#./mfc.sh run /projects/bciv/mcarcanabarbosa/ctr/gel/geldef.py -p gpuA100x4 -N 1 -n 4 -g 1 -w 01:00:00 -#gel25 -t post_process -a bciv-delta-gpu -c delta From 69a6015580d642c0101edaf1331831d20bc8b8e5 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 23 Dec 2024 23:23:28 -0600 Subject: [PATCH 350/380] added variables to mpi_proxy --- src/simulation/m_mpi_proxy.fpp | 2 +- toolchain/mfc/test/cases.py | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index b1387af87d..0829d5f93f 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -195,7 +195,7 @@ contains & 'bc_z%grcbc_in', 'bc_z%grcbc_out', 'bc_z%grcbc_vel_out', & & 'cfl_adap_dt', 'cfl_const_dt', 'cfl_dt', 'surface_tension', & & 'viscous', 'shear_stress', 'bulk_stress', & - & 'hyperelasticity', 'elasticity' ] + & 'hyperelasticity', 'elasticity', 'hyper_model' ] call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) #:endfor diff --git a/toolchain/mfc/test/cases.py b/toolchain/mfc/test/cases.py index b4163e0e17..4164885f59 100644 --- a/toolchain/mfc/test/cases.py +++ b/toolchain/mfc/test/cases.py @@ -526,7 +526,7 @@ def alter_hypoelasticity(dimInfo): # Hypoelasticity checks for num_fluids in [1,2]: stack.push(f"Hypoelasticity -> {num_fluids} Fluid(s)", { - "hypoelasticity": 'T', "num_fluids": num_fluids, "elasticity": 'T', + 'hypoelasticity': 'T', 'num_fluids': num_fluids, 'elasticity': 'T', 'riemann_solver': 1, 'fd_order': 4, 'fluid_pp(1)%gamma': 0.3, 'fluid_pp(1)%pi_inf': 7.8E+05, From c7f4484181107ab387f93d0ce633fd810c8e12b5 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 24 Dec 2024 19:17:44 -0600 Subject: [PATCH 351/380] added boundary condition checker for hyperelasticity --- src/common/m_checker_common.fpp | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index 74dff47b66..df1d6a66ba 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -169,11 +169,19 @@ contains "Elasticity does not work for model_eqns = 1") @:PROHIBIT(elasticity .and. model_eqns > 3, & "Elasticity works only for model_eqns 2 and 3") + #:for X in ['x', 'y', 'z'] + #:for BOUND in ['beg', 'end'] + @:PROHIBIT(hyperelasticity .and. ((bc_${X}$%${BOUND}$ /= -2) .or. (bc_${X}$%${BOUND}$ /= -3)), & + "bc_${X}$%${BOUND}$ is not supported") + #:endfor + #:endfor + #ifdef MFC_SIMULATION @:PROHIBIT(elasticity .and. fd_order /= 4) @:PROHIBIT(hyperelasticity .and. hyper_model .le. 0, & "Set the hyper_model in the input file") #endif + end subroutine s_check_inputs_elasticity !> Checks constraints on dimensionality and the number of cells for the grid. From d3479b1fd49916c74f22f2df130fa52a01c56ee0 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 24 Dec 2024 21:58:37 -0600 Subject: [PATCH 352/380] reverted the elasticity flag --- src/common/m_checker_common.fpp | 8 ++------ src/post_process/m_global_parameters.fpp | 2 ++ src/post_process/m_mpi_proxy.fpp | 3 ++- src/post_process/m_start_up.f90 | 2 +- src/pre_process/m_global_parameters.fpp | 1 + src/pre_process/m_mpi_proxy.fpp | 2 +- src/pre_process/m_start_up.fpp | 2 +- src/simulation/m_global_parameters.fpp | 2 ++ src/simulation/m_mpi_proxy.fpp | 2 +- src/simulation/m_start_up.fpp | 2 +- toolchain/mfc/run/case_dicts.py | 1 - toolchain/mfc/test/cases.py | 2 +- 12 files changed, 15 insertions(+), 14 deletions(-) diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index df1d6a66ba..8182440478 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -161,13 +161,9 @@ contains !> Checks constraints on the elasticity parameters. !! Called by s_check_inputs_common for all three stages subroutine s_check_inputs_elasticity - @:PROHIBIT((hypoelasticity .or. hyperelasticity) .and. (.not. elasticity), & - "Turn on elasticity to have either hyperelasticity or hypoelasticity") - @:PROHIBIT(elasticity .and. .not. (hypoelasticity .or. hyperelasticity), & - "Elasticity requires either hyperelasticity or hypoelasticity to be true") - @:PROHIBIT(elasticity .and. model_eqns == 1, & + @:PROHIBIT((hypoelasticity .or. hyperelasticity) .and. model_eqns == 1, & "Elasticity does not work for model_eqns = 1") - @:PROHIBIT(elasticity .and. model_eqns > 3, & + @:PROHIBIT((hypoelasticity .or. hyperelasticity) .and. model_eqns > 3, & "Elasticity works only for model_eqns 2 and 3") #:for X in ['x', 'y', 'z'] #:for BOUND in ['beg', 'end'] diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 3a927ef58d..5f169d6437 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -649,6 +649,8 @@ contains end if end if + if (hypoelasticity .or. hyperelasticity) elasticity = .true. + if (elasticity) then stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp index a9fdb4dffa..2d1e005451 100644 --- a/src/post_process/m_mpi_proxy.fpp +++ b/src/post_process/m_mpi_proxy.fpp @@ -170,7 +170,8 @@ contains & 'prim_vars_wrt', 'c_wrt', 'qm_wrt','schlieren_wrt', 'bubbles_euler', 'qbmm', & & 'polytropic', 'polydisperse', 'file_per_process', 'relax', 'cf_wrt', & & 'adv_n', 'ib', 'cfl_adap_dt', 'cfl_const_dt', 'cfl_dt', & - & 'surface_tension', 'hyperelasticity', 'elasticity', 'kymograph', 'bubbles_lagrange', 'rkck_adap_dt' ] + & 'surface_tension', 'hyperelasticity', 'kymograph', & + & 'bubbles_lagrange', 'rkck_adap_dt' ] call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) #:endfor diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 5f1fcf2d00..31e366535d 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -85,7 +85,7 @@ subroutine s_read_input_file relax_model, cf_wrt, sigma, adv_n, ib, num_ibs, & cfl_adap_dt, cfl_const_dt, t_save, t_stop, n_start, & cfl_target, surface_tension, bubbles_lagrange, rkck_adap_dt, & - sim_data, hyperelasticity, kymograph, elasticity + sim_data, hyperelasticity, kymograph ! Inquiring the status of the post_process.inp file file_loc = 'post_process.inp' diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 365a3928ca..e87a31d4c9 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -736,6 +736,7 @@ contains end if end if + if (hypoelasticity .or. hyperelasticity) elasticity = .true. if (elasticity) then ! creates stress indices for both hypo and hyperelasticity stress_idx%beg = sys_size + 1 diff --git a/src/pre_process/m_mpi_proxy.fpp b/src/pre_process/m_mpi_proxy.fpp index 0665e4664c..6077ae2e82 100644 --- a/src/pre_process/m_mpi_proxy.fpp +++ b/src/pre_process/m_mpi_proxy.fpp @@ -57,7 +57,7 @@ contains & 'mixlayer_perturb', 'bubbles_euler', 'polytropic', 'polydisperse',& & 'qbmm', 'file_per_process', 'adv_n', 'ib' , 'cfl_adap_dt', & & 'cfl_const_dt', 'cfl_dt', 'surface_tension', & - & 'hyperelasticity', 'pre_stress', 'elasticity'] + & 'hyperelasticity', 'pre_stress'] call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) #:endfor call MPI_BCAST(fluid_rho(1), num_fluids_max, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index 2f993506a0..b64fd28ff3 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -143,7 +143,7 @@ contains palpha_eps, ptgalpha_eps, ib, num_ibs, patch_ib, & sigma, adv_n, cfl_adap_dt, cfl_const_dt, n_start, & n_start_old, surface_tension, hyperelasticity, pre_stress, & - elasticity, rkck_adap_dt + rkck_adap_dt ! Inquiring the status of the pre_process.inp file file_loc = 'pre_process.inp' diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 14b0b39692..a87ea331be 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -1018,6 +1018,8 @@ contains end if ! END: Volume Fraction Model ======================================= + if (hypoelasticity .or. hyperelasticity) elasticity = .true. + if (elasticity) then ! creates stress indices for both hypo and hyperelasticity stress_idx%beg = sys_size + 1 diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index f62c24014c..68cf03af52 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -197,7 +197,7 @@ contains & 'bc_z%grcbc_in', 'bc_z%grcbc_out', 'bc_z%grcbc_vel_out', & & 'cfl_adap_dt', 'cfl_const_dt', 'cfl_dt', 'surface_tension', & & 'viscous', 'shear_stress', 'bulk_stress', 'bubbles_lagrange', & - & 'hyperelasticity', 'elasticity', 'hyper_model', 'rkck_adap_dt' ] + & 'hyperelasticity', 'hyper_model', 'rkck_adap_dt' ] call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) #:endfor diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 5c5e38a30f..8bbac890d5 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -172,7 +172,7 @@ contains g_x, g_y, g_z, n_start, t_save, t_stop, & cfl_adap_dt, cfl_const_dt, cfl_target, & viscous, surface_tension, & - hyperelasticity, R0ref, elasticity, & + hyperelasticity, R0ref, & bubbles_lagrange, lag_params, & rkck_adap_dt, rkck_tolerance diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index afeebeaa5d..b0c3164936 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -22,7 +22,6 @@ def analytic(self): return self.STR COMMON = { - 'elasticity': ParamType.LOG, 'hypoelasticity': ParamType.LOG, 'hyperelasticity': ParamType.LOG, 'cyl_coord': ParamType.LOG, diff --git a/toolchain/mfc/test/cases.py b/toolchain/mfc/test/cases.py index cecfa1c9dc..dd32665b9d 100644 --- a/toolchain/mfc/test/cases.py +++ b/toolchain/mfc/test/cases.py @@ -525,7 +525,7 @@ def alter_hypoelasticity(dimInfo): # Hypoelasticity checks for num_fluids in [1,2]: stack.push(f"Hypoelasticity -> {num_fluids} Fluid(s)", { - 'hypoelasticity': 'T', 'num_fluids': num_fluids, 'elasticity': 'T', + 'hypoelasticity': 'T', 'num_fluids': num_fluids, 'riemann_solver': 1, 'fd_order': 4, 'fluid_pp(1)%gamma': 0.3, 'fluid_pp(1)%pi_inf': 7.8E+05, From b7d6bdb6cc8edafa35cd8f31ba2e2ceeb706707f Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 24 Dec 2024 22:03:15 -0600 Subject: [PATCH 353/380] formatted code again --- src/post_process/m_mpi_proxy.fpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp index 2d1e005451..6ba1fa3b1c 100644 --- a/src/post_process/m_mpi_proxy.fpp +++ b/src/post_process/m_mpi_proxy.fpp @@ -170,7 +170,7 @@ contains & 'prim_vars_wrt', 'c_wrt', 'qm_wrt','schlieren_wrt', 'bubbles_euler', 'qbmm', & & 'polytropic', 'polydisperse', 'file_per_process', 'relax', 'cf_wrt', & & 'adv_n', 'ib', 'cfl_adap_dt', 'cfl_const_dt', 'cfl_dt', & - & 'surface_tension', 'hyperelasticity', 'kymograph', & + & 'surface_tension', 'hyperelasticity', 'kymograph', & & 'bubbles_lagrange', 'rkck_adap_dt' ] call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) #:endfor From c46589144f7d72c5d3c72b0eedf7e3dfb9b67b3a Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Tue, 24 Dec 2024 22:08:38 -0600 Subject: [PATCH 354/380] fixed example files --- examples/1D_hypo_2materials/case.py | 1 - examples/1D_impact/case.py | 1 - examples/1D_sodHypo/case.py | 1 - examples/3D_hyper_bubingel/case.py | 1 - examples/3D_hyper_bubinwater/case.py | 1 - 5 files changed, 5 deletions(-) diff --git a/examples/1D_hypo_2materials/case.py b/examples/1D_hypo_2materials/case.py index 3e517fa4d2..94ce8d7258 100755 --- a/examples/1D_hypo_2materials/case.py +++ b/examples/1D_hypo_2materials/case.py @@ -51,7 +51,6 @@ # ========================================================== # Turning on Hypoelasticity ================================ - 'elasticity' : 'T', 'hypoelasticity' : 'T', 'fd_order' : 4, # ========================================================== diff --git a/examples/1D_impact/case.py b/examples/1D_impact/case.py index cfcd536bff..c825b1df6b 100755 --- a/examples/1D_impact/case.py +++ b/examples/1D_impact/case.py @@ -51,7 +51,6 @@ # ========================================================== # Turning on Hypoelasticity ================================ - 'elasticity' : 'T', 'hypoelasticity' : 'T', 'fd_order' : 4, # ========================================================== diff --git a/examples/1D_sodHypo/case.py b/examples/1D_sodHypo/case.py index 3c8c792de3..3d5b551006 100755 --- a/examples/1D_sodHypo/case.py +++ b/examples/1D_sodHypo/case.py @@ -51,7 +51,6 @@ # ========================================================== # Turning on Hypoelasticity ================================ - 'elasticity' : 'T', 'hypoelasticity' : 'T', # ========================================================== diff --git a/examples/3D_hyper_bubingel/case.py b/examples/3D_hyper_bubingel/case.py index 933770c5ab..4652c0e804 100755 --- a/examples/3D_hyper_bubingel/case.py +++ b/examples/3D_hyper_bubingel/case.py @@ -292,7 +292,6 @@ 'num_patches' : 3, 'model_eqns' : 3, 'num_fluids' : 4, - 'elasticity' : 'T', 'hypoelasticity' : 'F', 'hyperelasticity' : 'T', 'mpp_lim' : 'T', diff --git a/examples/3D_hyper_bubinwater/case.py b/examples/3D_hyper_bubinwater/case.py index ccb1cc51d2..9d9216ad3b 100755 --- a/examples/3D_hyper_bubinwater/case.py +++ b/examples/3D_hyper_bubinwater/case.py @@ -287,7 +287,6 @@ 'num_patches' : 3, 'model_eqns' : 3, 'num_fluids' : 4, - 'elasticity' : 'T', 'hypoelasticity' : 'F', 'hyperelasticity' : 'T', 'mpp_lim' : 'T', From 3009d3a6dee4affa1773f4cf0bdbfac80a1f69f9 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 25 Dec 2024 14:46:04 -0600 Subject: [PATCH 355/380] small changes to the example cases --- src/common/m_checker_common.fpp | 2 +- toolchain/mfc/test/cases.py | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index 8182440478..79a5ec4d4f 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -167,7 +167,7 @@ contains "Elasticity works only for model_eqns 2 and 3") #:for X in ['x', 'y', 'z'] #:for BOUND in ['beg', 'end'] - @:PROHIBIT(hyperelasticity .and. ((bc_${X}$%${BOUND}$ /= -2) .or. (bc_${X}$%${BOUND}$ /= -3)), & + @:PROHIBIT(hyperelasticity .and. ((bc_${X}$%${BOUND}$ .lt. -3)), & "bc_${X}$%${BOUND}$ is not supported") #:endfor #:endfor diff --git a/toolchain/mfc/test/cases.py b/toolchain/mfc/test/cases.py index dd32665b9d..a9320119b5 100644 --- a/toolchain/mfc/test/cases.py +++ b/toolchain/mfc/test/cases.py @@ -848,7 +848,7 @@ def foreach_example(): continue # List of currently broken examples -> currently attempting to fix! - brokenCases = ["2D_ibm_cfl_dt", "1D_sodHypo", "2D_viscous", "2D_laplace_pressure_jump", "2D_bubbly_steady_shock", "2D_advection", "2D_hardcodied_ic", "2D_ibm_multiphase", "2D_acoustic_broadband", "1D_inert_shocktube", "1D_reactive_shocktube", "2D_ibm_steady_shock", "3D_performance_test", "3D_ibm_stl_ellipsoid", "3D_sphbubcollapse", "2D_ibm_stl_wedge", "3D_ibm_stl_pyramid", "3D_ibm_bowshock", "3D_turb_mixing", "2D_mixing_artificial_Ma", "3D_lagrange_bubblescreen", "3D_hyper_bubingel", "3D_hyper_bubinwater"] + brokenCases = ["2D_ibm_cfl_dt", "1D_sodHypo", "2D_viscous", "2D_laplace_pressure_jump", "2D_bubbly_steady_shock", "2D_advection", "2D_hardcodied_ic", "2D_ibm_multiphase", "2D_acoustic_broadband", "1D_inert_shocktube", "1D_reactive_shocktube", "2D_ibm_steady_shock", "3D_performance_test", "3D_ibm_stl_ellipsoid", "3D_sphbubcollapse", "2D_ibm_stl_wedge", "3D_ibm_stl_pyramid", "3D_ibm_bowshock", "3D_turb_mixing", "2D_mixing_artificial_Ma", "3D_lagrange_bubblescreen", "3D_hyper_bubingel", "3D_hyper_bubinwater", "1D_hyper_impact_strong", "1D_hyper_impact_weak", "1D_hypo_impact_strong", "1D_hypo_impact_weak" ] if path in brokenCases: continue name = f"{path.split('_')[0]} -> Example -> {'_'.join(path.split('_')[1:])}" From 59f1c2329fad2f312be9470b6a0dbeb257837694 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 25 Dec 2024 18:18:56 -0600 Subject: [PATCH 356/380] cleaned up the post_process for hyperelastic output --- src/post_process/m_start_up.f90 | 15 +++------------ 1 file changed, 3 insertions(+), 12 deletions(-) diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 9473adcbac..b03e5a4880 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -371,10 +371,7 @@ subroutine s_save_data(t_step, varname, pres, c, H) if (elasticity) then if (prim_vars_wrt) then do i = 1, stress_idx%end - stress_idx%beg + 1 - q_sf = q_prim_vf(i - 1 + stress_idx%beg)%sf( & - -offset_x%beg:m + offset_x%end, & - -offset_y%beg:n + offset_y%end, & - -offset_z%beg:p + offset_z%end) + q_sf = q_prim_vf(i - 1 + stress_idx%beg)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) write (varname, '(A,I0)') 'tau', i call s_write_variable_to_formatted_database_file(varname, t_step) @@ -385,20 +382,14 @@ subroutine s_save_data(t_step, varname, pres, c, H) if (hyperelasticity) then if (prim_vars_wrt) then do i = 1, xiend - xibeg + 1 - q_sf = q_prim_vf(i - 1 + xibeg)%sf( & - -offset_x%beg:m + offset_x%end, & - -offset_y%beg:n + offset_y%end, & - -offset_z%beg:p + offset_z%end) + q_sf = q_prim_vf(i - 1 + xibeg)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) write (varname, '(A,I0)') 'xi', i call s_write_variable_to_formatted_database_file(varname, t_step) varname(:) = ' ' end do - q_sf = q_prim_vf(xiend + 1)%sf( & - -offset_x%beg:m + offset_x%end, & - -offset_y%beg:n + offset_y%end, & - -offset_z%beg:p + offset_z%end) + q_sf = q_prim_vf(xiend + 1)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) write (varname, '(A,I0)') 'vonMises' call s_write_variable_to_formatted_database_file(varname, t_step) From 9402b8cc614a3a8b688332f49d896789f0754217 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Fri, 27 Dec 2024 10:13:24 -0500 Subject: [PATCH 357/380] cleaning cases --- examples/1D_hyper_impact_strong/case.py | 9 --------- examples/1D_hyper_impact_weak/case.py | 9 --------- examples/1D_hyper_impact_weak/original.py | 9 --------- examples/1D_hypo_impact_strong/case.py | 9 --------- examples/1D_hypo_impact_weak/case.py | 9 --------- examples/3D_hyper_bubingel/case.py | 8 -------- examples/3D_hyper_bubinwater/case.py | 8 -------- 7 files changed, 61 deletions(-) diff --git a/examples/1D_hyper_impact_strong/case.py b/examples/1D_hyper_impact_strong/case.py index 6c0143d5f2..81ba0f648f 100755 --- a/examples/1D_hyper_impact_strong/case.py +++ b/examples/1D_hyper_impact_strong/case.py @@ -16,7 +16,6 @@ { # Logistics ================================================ "run_time_info": "T", - # ========================================================== # Computational Domain Parameters ========================== "x_domain%beg": 0.0e00, "x_domain%end": 1.0e00, @@ -29,7 +28,6 @@ "t_step_start": 0, "t_step_stop": int(Nt), "t_step_save": int(Nt / 200), - # ========================================================== # Simulation Algorithm Parameters ========================== "num_patches": 2, "model_eqns": 2, @@ -52,16 +50,13 @@ "bc_x%end": -3, #'bc_y%beg' : -3, #'bc_y%end' : -3, - # ========================================================== # Turning on Hypoelasticity ================================ "hyperelasticity": "T", - # ========================================================== # Formatted Database Files Structure Parameters ============ "format": 1, "precision": 2, "prim_vars_wrt": "T", "parallel_io": "F", - # ========================================================== # Patch 1 L ================================================ "patch_icpp(1)%geometry": 1, "patch_icpp(1)%x_centroid": 0.25, @@ -74,7 +69,6 @@ "patch_icpp(1)%alpha_rho(1)": 1000, "patch_icpp(1)%alpha(1)": 1.0, "patch_icpp(1)%tau_e(1)": 0.0, - # ========================================================== # Patch 2 R ================================================ "patch_icpp(2)%geometry": 1, "patch_icpp(2)%x_centroid": 0.75, @@ -87,13 +81,10 @@ "patch_icpp(2)%alpha_rho(1)": 1000, "patch_icpp(2)%alpha(1)": 1.0, "patch_icpp(2)%tau_e(1)": 0.0, - # ========================================================== # Fluids Physical Parameters =============================== "fluid_pp(1)%gamma": 1.0e00 / (4.4e00 - 1.0e00), "fluid_pp(1)%pi_inf": 4.4e00 * 6.0e08 / (4.4e00 - 1.0e00), "fluid_pp(1)%G": 1e010, - # ========================================================== } ) ) -# ============================================================================== diff --git a/examples/1D_hyper_impact_weak/case.py b/examples/1D_hyper_impact_weak/case.py index bd2097dac7..614a61e828 100755 --- a/examples/1D_hyper_impact_weak/case.py +++ b/examples/1D_hyper_impact_weak/case.py @@ -16,7 +16,6 @@ { # Logistics ================================================ "run_time_info": "T", - # ========================================================== # Computational Domain Parameters ========================== "x_domain%beg": 0.0e00, "x_domain%end": 1.0e00, @@ -29,7 +28,6 @@ "t_step_start": 0, "t_step_stop": int(Nt), "t_step_save": int(Nt / 200), - # ========================================================== # Simulation Algorithm Parameters ========================== "num_patches": 2, "model_eqns": 3, @@ -52,16 +50,13 @@ "bc_x%end": -3, "bc_y%beg": -3, "bc_y%end": -3, - # ========================================================== # Turning on Hyperelasticity ================================ "hyperelasticity": "T", - # ========================================================== # Formatted Database Files Structure Parameters ============ "format": 1, "precision": 2, "prim_vars_wrt": "T", "parallel_io": "F", - # ========================================================== # Patch 1 L ================================================ "patch_icpp(1)%geometry": 1, "patch_icpp(1)%x_centroid": 0.25, @@ -74,7 +69,6 @@ "patch_icpp(1)%alpha_rho(1)": 1000, "patch_icpp(1)%alpha(1)": 1.0, "patch_icpp(1)%tau_e(1)": 0.0, - # ========================================================== # Patch 2 R ================================================ "patch_icpp(2)%geometry": 1, "patch_icpp(2)%x_centroid": 0.75, @@ -87,13 +81,10 @@ "patch_icpp(2)%alpha_rho(1)": 1000, "patch_icpp(2)%alpha(1)": 1.0, "patch_icpp(2)%tau_e(1)": 0.0, - # ========================================================== # Fluids Physical Parameters =============================== "fluid_pp(1)%gamma": 1.0e00 / (4.4e00 - 1.0e00), "fluid_pp(1)%pi_inf": 4.4e00 * 6.0e08 / (4.4e00 - 1.0e00), "fluid_pp(1)%G": 1.0e00, # .E+010, - # ========================================================== } ) ) -# ============================================================================== diff --git a/examples/1D_hyper_impact_weak/original.py b/examples/1D_hyper_impact_weak/original.py index 0bfc7b4942..bda9447413 100755 --- a/examples/1D_hyper_impact_weak/original.py +++ b/examples/1D_hyper_impact_weak/original.py @@ -16,7 +16,6 @@ { # Logistics ================================================ "run_time_info": "T", - # ========================================================== # Computational Domain Parameters ========================== "x_domain%beg": 0.0e00, "x_domain%end": 1.0e00, @@ -29,7 +28,6 @@ "t_step_start": 0, "t_step_stop": int(Nt), "t_step_save": int(Nt / 200), - # ========================================================== # Simulation Algorithm Parameters ========================== "num_patches": 2, "model_eqns": 3, @@ -52,16 +50,13 @@ "bc_x%end": -3, #'bc_y%beg' : -3, #'bc_y%end' : -3, - # ========================================================== # Turning on Hyperelasticity ================================ "hyperelasticity": "T", - # ========================================================== # Formatted Database Files Structure Parameters ============ "format": 1, "precision": 2, "prim_vars_wrt": "T", "parallel_io": "F", - # ========================================================== # Patch 1 L ================================================ "patch_icpp(1)%geometry": 1, "patch_icpp(1)%x_centroid": 0.25, @@ -74,7 +69,6 @@ "patch_icpp(1)%alpha_rho(1)": 1000, "patch_icpp(1)%alpha(1)": 1.0, "patch_icpp(1)%tau_e(1)": 0.0, - # ========================================================== # Patch 2 R ================================================ "patch_icpp(2)%geometry": 1, "patch_icpp(2)%x_centroid": 0.75, @@ -87,13 +81,10 @@ "patch_icpp(2)%alpha_rho(1)": 1000, "patch_icpp(2)%alpha(1)": 1.0, "patch_icpp(2)%tau_e(1)": 0.0, - # ========================================================== # Fluids Physical Parameters =============================== "fluid_pp(1)%gamma": 1.0e00 / (4.4e00 - 1.0e00), "fluid_pp(1)%pi_inf": 4.4e00 * 6.0e08 / (4.4e00 - 1.0e00), "fluid_pp(1)%G": 1.0e00, # .E+010, - # ========================================================== } ) ) -# ============================================================================== diff --git a/examples/1D_hypo_impact_strong/case.py b/examples/1D_hypo_impact_strong/case.py index b6001500db..2b49f8f7bd 100755 --- a/examples/1D_hypo_impact_strong/case.py +++ b/examples/1D_hypo_impact_strong/case.py @@ -16,7 +16,6 @@ { # Logistics ================================================ "run_time_info": "T", - # ========================================================== # Computational Domain Parameters ========================== "x_domain%beg": 0.0e00, "x_domain%end": 1.0e00, @@ -29,7 +28,6 @@ "t_step_start": 0, "t_step_stop": int(Nt), "t_step_save": int(Nt / 200), - # ========================================================== # Simulation Algorithm Parameters ========================== "num_patches": 2, "model_eqns": 2, @@ -52,16 +50,13 @@ "bc_x%end": -3, #'bc_y%beg' : -3, #'bc_y%end' : -3, - # ========================================================== # Turning on Hypoelasticity ================================ "hypoelasticity": "T", - # ========================================================== # Formatted Database Files Structure Parameters ============ "format": 1, "precision": 2, "prim_vars_wrt": "T", "parallel_io": "F", - # ========================================================== # Patch 1 L ================================================ "patch_icpp(1)%geometry": 1, "patch_icpp(1)%x_centroid": 0.25, @@ -74,7 +69,6 @@ "patch_icpp(1)%alpha_rho(1)": 1000, "patch_icpp(1)%alpha(1)": 1.0, "patch_icpp(1)%tau_e(1)": 0.0, - # ========================================================== # Patch 2 R ================================================ "patch_icpp(2)%geometry": 1, "patch_icpp(2)%x_centroid": 0.75, @@ -87,13 +81,10 @@ "patch_icpp(2)%alpha_rho(1)": 1000, "patch_icpp(2)%alpha(1)": 1.0, "patch_icpp(2)%tau_e(1)": 0.0, - # ========================================================== # Fluids Physical Parameters =============================== "fluid_pp(1)%gamma": 1.0e00 / (4.4e00 - 1.0e00), "fluid_pp(1)%pi_inf": 4.4e00 * 6.0e08 / (4.4e00 - 1.0e00), "fluid_pp(1)%G": 1e010, - # ========================================================== } ) ) -# ============================================================================== diff --git a/examples/1D_hypo_impact_weak/case.py b/examples/1D_hypo_impact_weak/case.py index 713e2d51a6..b8b93af3d1 100755 --- a/examples/1D_hypo_impact_weak/case.py +++ b/examples/1D_hypo_impact_weak/case.py @@ -16,7 +16,6 @@ { # Logistics ================================================ "run_time_info": "T", - # ========================================================== # Computational Domain Parameters ========================== "x_domain%beg": 0.0e00, "x_domain%end": 1.0e00, @@ -27,7 +26,6 @@ "t_step_start": 0, "t_step_stop": int(Nt), "t_step_save": int(Nt / 200), - # ========================================================== # Simulation Algorithm Parameters ========================== "num_patches": 2, "model_eqns": 2, @@ -48,16 +46,13 @@ "avg_state": 2, "bc_x%beg": -3, "bc_x%end": -3, - # ========================================================== # Turning on Hypoelasticity ================================ "hypoelasticity": "T", - # ========================================================== # Formatted Database Files Structure Parameters ============ "format": 1, "precision": 2, "prim_vars_wrt": "T", "parallel_io": "F", - # ========================================================== # Patch 1 L ================================================ "patch_icpp(1)%geometry": 1, "patch_icpp(1)%x_centroid": 0.25, @@ -69,7 +64,6 @@ "patch_icpp(1)%alpha(1)": 1.0, "patch_icpp(1)%alpha(2)": 0.0, "patch_icpp(1)%tau_e(1)": 0.0, - # ========================================================== # Patch 2 R ================================================ "patch_icpp(2)%geometry": 1, "patch_icpp(2)%x_centroid": 0.75, @@ -81,7 +75,6 @@ "patch_icpp(2)%alpha(1)": 0.0, "patch_icpp(2)%alpha(2)": 1.0, "patch_icpp(2)%tau_e(1)": 0.0, - # ========================================================== # Fluids Physical Parameters =============================== "fluid_pp(1)%gamma": 1.0e00 / (4.4e00 - 1.0e00), "fluid_pp(1)%pi_inf": 4.4e00 * 6.0e08 / (4.4e00 - 1.0e00), @@ -89,8 +82,6 @@ "fluid_pp(2)%gamma": 1.0e00 / (4.4e00 - 1.0e00), "fluid_pp(2)%pi_inf": 4.4e00 * 6.0e08 / (4.4e00 - 1.0e00), "fluid_pp(2)%G": 1e010, - # ========================================================== } ) ) -# ============================================================================== diff --git a/examples/3D_hyper_bubingel/case.py b/examples/3D_hyper_bubingel/case.py index fbdb7588ce..73f32ba474 100755 --- a/examples/3D_hyper_bubingel/case.py +++ b/examples/3D_hyper_bubingel/case.py @@ -258,7 +258,6 @@ { # Logistics ================================================ "run_time_info": "T", - # ========================================================== # Computational Domain Parameters ========================== "x_domain%beg": xb, "x_domain%end": xe, @@ -289,7 +288,6 @@ "t_step_start": tstart, "t_step_stop": Nt, "t_step_save": AS, - # ========================================================== # Simulation Algorithm Parameters ========================== "num_patches": 3, "model_eqns": 3, @@ -319,7 +317,6 @@ "bc_y%end": -6, "bc_z%beg": -2, "bc_z%end": -6, - # ========================================================== # Formatted Database Files Structure Parameters ============ "format": 1, "precision": 2, @@ -331,7 +328,6 @@ "probe(1)%x": 0.0, "probe(1)%y": 0.0, "probe(1)%z": 0.0, - # ========================================================== # Patch 1: High pressured water ============================ # Specify the cubic water background grid geometry "patch_icpp(1)%geometry": 9, @@ -353,7 +349,6 @@ "patch_icpp(1)%alpha(2)": liq_wv, "patch_icpp(1)%alpha(3)": liq_wa, "patch_icpp(1)%alpha(1)": liq_wg, - # ========================================================== # Patch 2: (Vapor) Bubble ================================== "patch_icpp(2)%geometry": 8, "patch_icpp(2)%x_centroid": xcenb, @@ -373,7 +368,6 @@ "patch_icpp(2)%alpha(3)": bub_wa, "patch_icpp(2)%alpha(1)": bub_wg, "patch_icpp(2)%alter_patch(1)": "T", - # ========================================================== # Patch 3: Gel Object ====================================== "patch_icpp(3)%geometry": 9, "patch_icpp(3)%x_centroid": 20 * xceng, @@ -395,7 +389,6 @@ "patch_icpp(3)%alpha(3)": gel_wa, "patch_icpp(3)%alpha(1)": gel_wg, "patch_icpp(3)%alter_patch(1)": "T", - # ========================================================== # Fluids Physical Parameters =============================== "fluid_pp(4)%gamma": 1.0e00 / (gamwl - 1), "fluid_pp(4)%pi_inf": gamwl * piwl / (gamwl - 1), @@ -421,7 +414,6 @@ "fluid_pp(1)%qv": qvwg, "fluid_pp(1)%qvp": qvpwg, "fluid_pp(1)%G": Gg, - # ========================================================== } ) ) diff --git a/examples/3D_hyper_bubinwater/case.py b/examples/3D_hyper_bubinwater/case.py index 1d04418fab..1053684377 100755 --- a/examples/3D_hyper_bubinwater/case.py +++ b/examples/3D_hyper_bubinwater/case.py @@ -253,7 +253,6 @@ { # Logistics ================================================ "run_time_info": "T", - # ========================================================== # Computational Domain Parameters ========================== "x_domain%beg": xb, "x_domain%end": xe, @@ -284,7 +283,6 @@ "t_step_start": tstart, "t_step_stop": Nt, "t_step_save": AS, - # ========================================================== # Simulation Algorithm Parameters ========================== "num_patches": 3, "model_eqns": 3, @@ -314,7 +312,6 @@ "bc_y%end": -6, "bc_z%beg": -2, "bc_z%end": -6, - # ========================================================== # Formatted Database Files Structure Parameters ============ "format": 1, "precision": 2, @@ -326,7 +323,6 @@ "probe(1)%x": 0.0, "probe(1)%y": 0.0, "probe(1)%z": 0.0, - # ========================================================== # Patch 1: High pressured water ============================ # Specify the cubic water background grid geometry "patch_icpp(1)%geometry": 9, @@ -348,7 +344,6 @@ "patch_icpp(1)%alpha(2)": liq_wv, "patch_icpp(1)%alpha(3)": liq_wa, "patch_icpp(1)%alpha(4)": liq_wg, - # ========================================================== # Patch 2: (Vapor) Bubble ================================== "patch_icpp(2)%geometry": 8, "patch_icpp(2)%x_centroid": xcenb, @@ -368,7 +363,6 @@ "patch_icpp(2)%alpha(3)": bub_wa, "patch_icpp(2)%alpha(4)": bub_wg, "patch_icpp(2)%alter_patch(1)": "T", - # ========================================================== # Patch 3: Gel Object ====================================== "patch_icpp(3)%geometry": 9, "patch_icpp(3)%x_centroid": 20 * xceng, @@ -390,7 +384,6 @@ "patch_icpp(3)%alpha(3)": gel_wa, "patch_icpp(3)%alpha(4)": gel_wg, "patch_icpp(3)%alter_patch(1)": "T", - # ========================================================== # Fluids Physical Parameters =============================== "fluid_pp(1)%gamma": 1.0e00 / (gamwl - 1), "fluid_pp(1)%pi_inf": gamwl * piwl / (gamwl - 1), @@ -416,7 +409,6 @@ "fluid_pp(4)%qv": qvwg, "fluid_pp(4)%qvp": qvpwg, "fluid_pp(4)%G": Gg, - # ========================================================== } ) ) From 8f4c7f5bcca591ac5c5e0356879bcab6285e84d9 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Fri, 27 Dec 2024 10:14:30 -0500 Subject: [PATCH 358/380] fix lint --- examples/3D_hyper_bubingel/case.py | 2 +- examples/3D_hyper_bubinwater/case.py | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/examples/3D_hyper_bubingel/case.py b/examples/3D_hyper_bubingel/case.py index 73f32ba474..99a2c053ac 100755 --- a/examples/3D_hyper_bubingel/case.py +++ b/examples/3D_hyper_bubingel/case.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python3 +#!/usr/bin/env python3 import math, json ## 1 FOR BACKGROUND, 2 FOR BUBBLE, 3 FOR GEL diff --git a/examples/3D_hyper_bubinwater/case.py b/examples/3D_hyper_bubinwater/case.py index 1053684377..bb925a95a2 100755 --- a/examples/3D_hyper_bubinwater/case.py +++ b/examples/3D_hyper_bubinwater/case.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python3 +#!/usr/bin/env python3 import math, json ## 1 FOR BACKGROUND, 2 FOR BUBBLE, 3 FOR GEL From 70fa27c26c86d37bfc53751ceeca1a968738295f Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Fri, 3 Jan 2025 08:42:11 -0500 Subject: [PATCH 359/380] clean examples --- examples/1D_hyper_impact_strong/case.py | 16 ++++++++-------- examples/1D_hyper_impact_weak/case.py | 16 ++++++++-------- examples/1D_hyper_impact_weak/original.py | 16 ++++++++-------- examples/1D_hypo_impact_strong/case.py | 16 ++++++++-------- examples/1D_hypo_impact_weak/case.py | 16 ++++++++-------- examples/3D_hyper_bubingel/case.py | 18 +++++++++--------- examples/3D_hyper_bubinwater/case.py | 18 +++++++++--------- 7 files changed, 58 insertions(+), 58 deletions(-) diff --git a/examples/1D_hyper_impact_strong/case.py b/examples/1D_hyper_impact_strong/case.py index 81ba0f648f..53a83f4a4f 100755 --- a/examples/1D_hyper_impact_strong/case.py +++ b/examples/1D_hyper_impact_strong/case.py @@ -14,9 +14,9 @@ print( json.dumps( { - # Logistics ================================================ + # Logistics "run_time_info": "T", - # Computational Domain Parameters ========================== + # Computational Domain Parameters "x_domain%beg": 0.0e00, "x_domain%end": 1.0e00, # 'y_domain%beg' : 0.E+00, @@ -28,7 +28,7 @@ "t_step_start": 0, "t_step_stop": int(Nt), "t_step_save": int(Nt / 200), - # Simulation Algorithm Parameters ========================== + # Simulation Algorithm Parameters "num_patches": 2, "model_eqns": 2, "alt_soundspeed": "F", @@ -50,14 +50,14 @@ "bc_x%end": -3, #'bc_y%beg' : -3, #'bc_y%end' : -3, - # Turning on Hypoelasticity ================================ + # Turning on Hypoelasticity "hyperelasticity": "T", - # Formatted Database Files Structure Parameters ============ + # Formatted Database Files Structure Parameters "format": 1, "precision": 2, "prim_vars_wrt": "T", "parallel_io": "F", - # Patch 1 L ================================================ + # Patch 1 L "patch_icpp(1)%geometry": 1, "patch_icpp(1)%x_centroid": 0.25, # 'patch_icpp(1)%y_centroid' : 0.001, @@ -69,7 +69,7 @@ "patch_icpp(1)%alpha_rho(1)": 1000, "patch_icpp(1)%alpha(1)": 1.0, "patch_icpp(1)%tau_e(1)": 0.0, - # Patch 2 R ================================================ + # Patch 2 R "patch_icpp(2)%geometry": 1, "patch_icpp(2)%x_centroid": 0.75, # 'patch_icpp(2)%y_centroid' : 0.001, @@ -81,7 +81,7 @@ "patch_icpp(2)%alpha_rho(1)": 1000, "patch_icpp(2)%alpha(1)": 1.0, "patch_icpp(2)%tau_e(1)": 0.0, - # Fluids Physical Parameters =============================== + # Fluids Physical Parameters "fluid_pp(1)%gamma": 1.0e00 / (4.4e00 - 1.0e00), "fluid_pp(1)%pi_inf": 4.4e00 * 6.0e08 / (4.4e00 - 1.0e00), "fluid_pp(1)%G": 1e010, diff --git a/examples/1D_hyper_impact_weak/case.py b/examples/1D_hyper_impact_weak/case.py index 614a61e828..efee055a8c 100755 --- a/examples/1D_hyper_impact_weak/case.py +++ b/examples/1D_hyper_impact_weak/case.py @@ -14,9 +14,9 @@ print( json.dumps( { - # Logistics ================================================ + # Logistics "run_time_info": "T", - # Computational Domain Parameters ========================== + # Computational Domain Parameters "x_domain%beg": 0.0e00, "x_domain%end": 1.0e00, "y_domain%beg": 0.0e00, @@ -28,7 +28,7 @@ "t_step_start": 0, "t_step_stop": int(Nt), "t_step_save": int(Nt / 200), - # Simulation Algorithm Parameters ========================== + # Simulation Algorithm Parameters "num_patches": 2, "model_eqns": 3, "alt_soundspeed": "F", @@ -50,14 +50,14 @@ "bc_x%end": -3, "bc_y%beg": -3, "bc_y%end": -3, - # Turning on Hyperelasticity ================================ + # Turning on Hyperelasticity "hyperelasticity": "T", - # Formatted Database Files Structure Parameters ============ + # Formatted Database Files Structure Parameters "format": 1, "precision": 2, "prim_vars_wrt": "T", "parallel_io": "F", - # Patch 1 L ================================================ + # Patch 1 L "patch_icpp(1)%geometry": 1, "patch_icpp(1)%x_centroid": 0.25, "patch_icpp(1)%y_centroid": 0.001, @@ -69,7 +69,7 @@ "patch_icpp(1)%alpha_rho(1)": 1000, "patch_icpp(1)%alpha(1)": 1.0, "patch_icpp(1)%tau_e(1)": 0.0, - # Patch 2 R ================================================ + # Patch 2 R "patch_icpp(2)%geometry": 1, "patch_icpp(2)%x_centroid": 0.75, "patch_icpp(2)%y_centroid": 0.001, @@ -81,7 +81,7 @@ "patch_icpp(2)%alpha_rho(1)": 1000, "patch_icpp(2)%alpha(1)": 1.0, "patch_icpp(2)%tau_e(1)": 0.0, - # Fluids Physical Parameters =============================== + # Fluids Physical Parameters "fluid_pp(1)%gamma": 1.0e00 / (4.4e00 - 1.0e00), "fluid_pp(1)%pi_inf": 4.4e00 * 6.0e08 / (4.4e00 - 1.0e00), "fluid_pp(1)%G": 1.0e00, # .E+010, diff --git a/examples/1D_hyper_impact_weak/original.py b/examples/1D_hyper_impact_weak/original.py index bda9447413..3ac4a61404 100755 --- a/examples/1D_hyper_impact_weak/original.py +++ b/examples/1D_hyper_impact_weak/original.py @@ -14,9 +14,9 @@ print( json.dumps( { - # Logistics ================================================ + # Logistics "run_time_info": "T", - # Computational Domain Parameters ========================== + # Computational Domain Parameters "x_domain%beg": 0.0e00, "x_domain%end": 1.0e00, # 'y_domain%beg' : 0.E+00, @@ -28,7 +28,7 @@ "t_step_start": 0, "t_step_stop": int(Nt), "t_step_save": int(Nt / 200), - # Simulation Algorithm Parameters ========================== + # Simulation Algorithm Parameters "num_patches": 2, "model_eqns": 3, "alt_soundspeed": "F", @@ -50,14 +50,14 @@ "bc_x%end": -3, #'bc_y%beg' : -3, #'bc_y%end' : -3, - # Turning on Hyperelasticity ================================ + # Turning on Hyperelasticity "hyperelasticity": "T", - # Formatted Database Files Structure Parameters ============ + # Formatted Database Files Structure Parameters "format": 1, "precision": 2, "prim_vars_wrt": "T", "parallel_io": "F", - # Patch 1 L ================================================ + # Patch 1 L "patch_icpp(1)%geometry": 1, "patch_icpp(1)%x_centroid": 0.25, # 'patch_icpp(1)%y_centroid' : 0.001, @@ -69,7 +69,7 @@ "patch_icpp(1)%alpha_rho(1)": 1000, "patch_icpp(1)%alpha(1)": 1.0, "patch_icpp(1)%tau_e(1)": 0.0, - # Patch 2 R ================================================ + # Patch 2 R "patch_icpp(2)%geometry": 1, "patch_icpp(2)%x_centroid": 0.75, # 'patch_icpp(2)%y_centroid' : 0.001, @@ -81,7 +81,7 @@ "patch_icpp(2)%alpha_rho(1)": 1000, "patch_icpp(2)%alpha(1)": 1.0, "patch_icpp(2)%tau_e(1)": 0.0, - # Fluids Physical Parameters =============================== + # Fluids Physical Parameters "fluid_pp(1)%gamma": 1.0e00 / (4.4e00 - 1.0e00), "fluid_pp(1)%pi_inf": 4.4e00 * 6.0e08 / (4.4e00 - 1.0e00), "fluid_pp(1)%G": 1.0e00, # .E+010, diff --git a/examples/1D_hypo_impact_strong/case.py b/examples/1D_hypo_impact_strong/case.py index 2b49f8f7bd..0530e8a551 100755 --- a/examples/1D_hypo_impact_strong/case.py +++ b/examples/1D_hypo_impact_strong/case.py @@ -14,9 +14,9 @@ print( json.dumps( { - # Logistics ================================================ + # Logistics "run_time_info": "T", - # Computational Domain Parameters ========================== + # Computational Domain Parameters "x_domain%beg": 0.0e00, "x_domain%end": 1.0e00, # 'y_domain%beg' : 0.E+00, @@ -28,7 +28,7 @@ "t_step_start": 0, "t_step_stop": int(Nt), "t_step_save": int(Nt / 200), - # Simulation Algorithm Parameters ========================== + # Simulation Algorithm Parameters "num_patches": 2, "model_eqns": 2, "alt_soundspeed": "F", @@ -50,14 +50,14 @@ "bc_x%end": -3, #'bc_y%beg' : -3, #'bc_y%end' : -3, - # Turning on Hypoelasticity ================================ + # Turning on Hypoelasticity "hypoelasticity": "T", - # Formatted Database Files Structure Parameters ============ + # Formatted Database Files Structure Parameters "format": 1, "precision": 2, "prim_vars_wrt": "T", "parallel_io": "F", - # Patch 1 L ================================================ + # Patch 1 L "patch_icpp(1)%geometry": 1, "patch_icpp(1)%x_centroid": 0.25, # 'patch_icpp(1)%y_centroid' : 0.001, @@ -69,7 +69,7 @@ "patch_icpp(1)%alpha_rho(1)": 1000, "patch_icpp(1)%alpha(1)": 1.0, "patch_icpp(1)%tau_e(1)": 0.0, - # Patch 2 R ================================================ + # Patch 2 R "patch_icpp(2)%geometry": 1, "patch_icpp(2)%x_centroid": 0.75, # 'patch_icpp(2)%y_centroid' : 0.001, @@ -81,7 +81,7 @@ "patch_icpp(2)%alpha_rho(1)": 1000, "patch_icpp(2)%alpha(1)": 1.0, "patch_icpp(2)%tau_e(1)": 0.0, - # Fluids Physical Parameters =============================== + # Fluids Physical Parameters "fluid_pp(1)%gamma": 1.0e00 / (4.4e00 - 1.0e00), "fluid_pp(1)%pi_inf": 4.4e00 * 6.0e08 / (4.4e00 - 1.0e00), "fluid_pp(1)%G": 1e010, diff --git a/examples/1D_hypo_impact_weak/case.py b/examples/1D_hypo_impact_weak/case.py index b8b93af3d1..f065372f3e 100755 --- a/examples/1D_hypo_impact_weak/case.py +++ b/examples/1D_hypo_impact_weak/case.py @@ -14,9 +14,9 @@ print( json.dumps( { - # Logistics ================================================ + # Logistics "run_time_info": "T", - # Computational Domain Parameters ========================== + # Computational Domain Parameters "x_domain%beg": 0.0e00, "x_domain%end": 1.0e00, "m": Nx, @@ -26,7 +26,7 @@ "t_step_start": 0, "t_step_stop": int(Nt), "t_step_save": int(Nt / 200), - # Simulation Algorithm Parameters ========================== + # Simulation Algorithm Parameters "num_patches": 2, "model_eqns": 2, "alt_soundspeed": "F", @@ -46,14 +46,14 @@ "avg_state": 2, "bc_x%beg": -3, "bc_x%end": -3, - # Turning on Hypoelasticity ================================ + # Turning on Hypoelasticity "hypoelasticity": "T", - # Formatted Database Files Structure Parameters ============ + # Formatted Database Files Structure Parameters "format": 1, "precision": 2, "prim_vars_wrt": "T", "parallel_io": "F", - # Patch 1 L ================================================ + # Patch 1 L "patch_icpp(1)%geometry": 1, "patch_icpp(1)%x_centroid": 0.25, "patch_icpp(1)%length_x": 0.5, @@ -64,7 +64,7 @@ "patch_icpp(1)%alpha(1)": 1.0, "patch_icpp(1)%alpha(2)": 0.0, "patch_icpp(1)%tau_e(1)": 0.0, - # Patch 2 R ================================================ + # Patch 2 R "patch_icpp(2)%geometry": 1, "patch_icpp(2)%x_centroid": 0.75, "patch_icpp(2)%length_x": 0.5, @@ -75,7 +75,7 @@ "patch_icpp(2)%alpha(1)": 0.0, "patch_icpp(2)%alpha(2)": 1.0, "patch_icpp(2)%tau_e(1)": 0.0, - # Fluids Physical Parameters =============================== + # Fluids Physical Parameters "fluid_pp(1)%gamma": 1.0e00 / (4.4e00 - 1.0e00), "fluid_pp(1)%pi_inf": 4.4e00 * 6.0e08 / (4.4e00 - 1.0e00), "fluid_pp(1)%G": 1e010, diff --git a/examples/3D_hyper_bubingel/case.py b/examples/3D_hyper_bubingel/case.py index 99a2c053ac..740abc3b93 100755 --- a/examples/3D_hyper_bubingel/case.py +++ b/examples/3D_hyper_bubingel/case.py @@ -252,13 +252,13 @@ # Total physical time # tend = Nt * dt -# Configuring case dictionary ================================================== +# Configuring case dictionary print( json.dumps( { - # Logistics ================================================ + # Logistics "run_time_info": "T", - # Computational Domain Parameters ========================== + # Computational Domain Parameters "x_domain%beg": xb, "x_domain%end": xe, "y_domain%beg": yb, @@ -288,7 +288,7 @@ "t_step_start": tstart, "t_step_stop": Nt, "t_step_save": AS, - # Simulation Algorithm Parameters ========================== + # Simulation Algorithm Parameters "num_patches": 3, "model_eqns": 3, "num_fluids": 4, @@ -317,7 +317,7 @@ "bc_y%end": -6, "bc_z%beg": -2, "bc_z%end": -6, - # Formatted Database Files Structure Parameters ============ + # Formatted Database Files Structure Parameters "format": 1, "precision": 2, "prim_vars_wrt": "T", @@ -328,7 +328,7 @@ "probe(1)%x": 0.0, "probe(1)%y": 0.0, "probe(1)%z": 0.0, - # Patch 1: High pressured water ============================ + # Patch 1: High pressured water # Specify the cubic water background grid geometry "patch_icpp(1)%geometry": 9, "patch_icpp(1)%x_centroid": 20 * xcenl, @@ -349,7 +349,7 @@ "patch_icpp(1)%alpha(2)": liq_wv, "patch_icpp(1)%alpha(3)": liq_wa, "patch_icpp(1)%alpha(1)": liq_wg, - # Patch 2: (Vapor) Bubble ================================== + # Patch 2: (Vapor) Bubble "patch_icpp(2)%geometry": 8, "patch_icpp(2)%x_centroid": xcenb, "patch_icpp(2)%y_centroid": ycenb, @@ -368,7 +368,7 @@ "patch_icpp(2)%alpha(3)": bub_wa, "patch_icpp(2)%alpha(1)": bub_wg, "patch_icpp(2)%alter_patch(1)": "T", - # Patch 3: Gel Object ====================================== + # Patch 3: Gel Object "patch_icpp(3)%geometry": 9, "patch_icpp(3)%x_centroid": 20 * xceng, "patch_icpp(3)%y_centroid": 20 * yceng, @@ -389,7 +389,7 @@ "patch_icpp(3)%alpha(3)": gel_wa, "patch_icpp(3)%alpha(1)": gel_wg, "patch_icpp(3)%alter_patch(1)": "T", - # Fluids Physical Parameters =============================== + # Fluids Physical Parameters "fluid_pp(4)%gamma": 1.0e00 / (gamwl - 1), "fluid_pp(4)%pi_inf": gamwl * piwl / (gamwl - 1), "fluid_pp(4)%cv": cvwl, diff --git a/examples/3D_hyper_bubinwater/case.py b/examples/3D_hyper_bubinwater/case.py index bb925a95a2..4e01000605 100755 --- a/examples/3D_hyper_bubinwater/case.py +++ b/examples/3D_hyper_bubinwater/case.py @@ -247,13 +247,13 @@ # Total physical time # tend = Nt * dt -# Configuring case dictionary ================================================== +# Configuring case dictionary print( json.dumps( { - # Logistics ================================================ + # Logistics "run_time_info": "T", - # Computational Domain Parameters ========================== + # Computational Domain Parameters "x_domain%beg": xb, "x_domain%end": xe, "y_domain%beg": yb, @@ -283,7 +283,7 @@ "t_step_start": tstart, "t_step_stop": Nt, "t_step_save": AS, - # Simulation Algorithm Parameters ========================== + # Simulation Algorithm Parameters "num_patches": 3, "model_eqns": 3, "num_fluids": 4, @@ -312,7 +312,7 @@ "bc_y%end": -6, "bc_z%beg": -2, "bc_z%end": -6, - # Formatted Database Files Structure Parameters ============ + # Formatted Database Files Structure Parameters "format": 1, "precision": 2, "prim_vars_wrt": "T", @@ -323,7 +323,7 @@ "probe(1)%x": 0.0, "probe(1)%y": 0.0, "probe(1)%z": 0.0, - # Patch 1: High pressured water ============================ + # Patch 1: High pressured water # Specify the cubic water background grid geometry "patch_icpp(1)%geometry": 9, "patch_icpp(1)%x_centroid": 20 * xcenl, @@ -344,7 +344,7 @@ "patch_icpp(1)%alpha(2)": liq_wv, "patch_icpp(1)%alpha(3)": liq_wa, "patch_icpp(1)%alpha(4)": liq_wg, - # Patch 2: (Vapor) Bubble ================================== + # Patch 2: (Vapor) Bubble "patch_icpp(2)%geometry": 8, "patch_icpp(2)%x_centroid": xcenb, "patch_icpp(2)%y_centroid": ycenb, @@ -363,7 +363,7 @@ "patch_icpp(2)%alpha(3)": bub_wa, "patch_icpp(2)%alpha(4)": bub_wg, "patch_icpp(2)%alter_patch(1)": "T", - # Patch 3: Gel Object ====================================== + # Patch 3: Gel Object "patch_icpp(3)%geometry": 9, "patch_icpp(3)%x_centroid": 20 * xceng, "patch_icpp(3)%y_centroid": 20 * yceng, @@ -384,7 +384,7 @@ "patch_icpp(3)%alpha(3)": gel_wa, "patch_icpp(3)%alpha(4)": gel_wg, "patch_icpp(3)%alter_patch(1)": "T", - # Fluids Physical Parameters =============================== + # Fluids Physical Parameters "fluid_pp(1)%gamma": 1.0e00 / (gamwl - 1), "fluid_pp(1)%pi_inf": gamwl * piwl / (gamwl - 1), "fluid_pp(1)%cv": cvwl, From c59fc0f293f9f4884b77ffc4347ca7ebb11daaed Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Sat, 11 Jan 2025 09:28:02 -0500 Subject: [PATCH 360/380] cleanup --- .github/workflows/lint-source.yml | 5 ++ src/post_process/m_data_output.fpp | 1 - src/post_process/m_derived_variables.fpp | 4 -- src/post_process/m_global_parameters.fpp | 6 -- src/pre_process/m_global_parameters.fpp | 5 -- src/simulation/m_cbc.fpp | 18 +++--- src/simulation/m_checker.fpp | 2 +- src/simulation/m_global_parameters.fpp | 7 +-- src/simulation/m_hyperelastic.fpp | 21 +++---- src/simulation/m_riemann_solvers.fpp | 70 +++++++++++++----------- src/simulation/m_sim_helpers.f90 | 2 +- src/simulation/m_time_steppers.fpp | 14 ++--- 12 files changed, 72 insertions(+), 83 deletions(-) diff --git a/.github/workflows/lint-source.yml b/.github/workflows/lint-source.yml index cc6757697a..7b78d15254 100644 --- a/.github/workflows/lint-source.yml +++ b/.github/workflows/lint-source.yml @@ -42,6 +42,10 @@ jobs: run: | ! grep -iR -e '\.\.\.' -e '\-\-\-' -e '===' ./src/* + - name: Looking for all caps comments in source + run: | + ! grep -RE '^\s+[!]\s+[A-Z]{5}' ./src/* + - name: Looking for junk comments in examples run: | ! grep -R '# ===' ./benchmarks **/*.py @@ -49,3 +53,4 @@ jobs: ! grep -R '===' ./benchmarks/**/*.py ! grep -R '===' ./examples/**/*.py + diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index d181973c93..bdacecf1c4 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -43,7 +43,6 @@ module m_data_output ! Including the Silo Fortran interface library that features the subroutines ! and parameters that are required to write in the Silo-HDF5 database format - ! INCLUDE 'silo.inc' include 'silo_f9x.inc' ! Generic storage for flow variable(s) that are to be written to formatted diff --git a/src/post_process/m_derived_variables.fpp b/src/post_process/m_derived_variables.fpp index 7fdb620763..eb2422be4c 100644 --- a/src/post_process/m_derived_variables.fpp +++ b/src/post_process/m_derived_variables.fpp @@ -288,10 +288,6 @@ contains if (top == bottom) then slope = 1._wp - ! ELSEIF((top == 0._wp .AND. bottom /= 0._wp) & - ! .OR. & - ! (bottom == 0._wp .AND. top /= 0._wp)) THEN - ! slope = 0._wp else slope = (top*bottom)/(bottom**2._wp + 1e-16_wp) end if diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 448ffb347f..4bdca155af 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -843,13 +843,7 @@ contains call MPI_INFO_CREATE(mpi_info_int, ierr) call MPI_INFO_SET(mpi_info_int, 'romio_ds_write', 'disable', ierr) - ! Option for UNIX file system (Hooke/Thomson) - ! WRITE(mpiiofs, '(A)') '/ufs_' - ! mpiiofs = TRIM(mpiiofs) - ! mpi_info_int = MPI_INFO_NULL - allocate (start_idx(1:num_dims)) - #endif end subroutine s_initialize_parallel_io diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index bfcc8340b0..d35bcce4cc 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -834,11 +834,6 @@ contains call MPI_INFO_CREATE(mpi_info_int, ierr) call MPI_INFO_SET(mpi_info_int, 'romio_ds_write', 'disable', ierr) - ! Option for UNIX file system (Hooke/Thomson) - ! WRITE(mpiiofs, '(A)') '/ufs_' - ! mpiiofs = TRIM(mpiiofs) - ! mpi_info_int = MPI_INFO_NULL - allocate (start_idx(1:num_dims)) #endif diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index 278e4c055e..6ec4ca746f 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -98,9 +98,9 @@ module m_cbc integer :: cbc_dir, cbc_loc !$acc declare create(dj, bcxb, bcxe, bcyb, bcye, bczb, bcze, cbc_dir, cbc_loc) - !! GRCBC inputs for subsonic inflow and outflow conditions consisting of - !! inflow velocities, pressure, density and void fraction as well as - !! outflow velocities and pressure + ! grCBC inputs for subsonic inflow and outflow conditions consisting of + ! inflow velocities, pressure, density and void fraction as well as + ! outflow velocities and pressure real(wp), allocatable, dimension(:) :: pres_in, pres_out, Del_in, Del_out real(wp), allocatable, dimension(:, :) :: vel_in, vel_out @@ -396,13 +396,13 @@ contains !$acc update device(bczb, bcze) end if - ! Allocate GRCBC inputs + ! Allocate grCBC inputs @:ALLOCATE(pres_in(1:num_dims), pres_out(1:num_dims)) @:ALLOCATE(Del_in(1:num_dims), Del_out(1:num_dims)) @:ALLOCATE(vel_in(1:num_dims, 1:num_dims), vel_out(1:num_dims, 1:num_dims)) @:ALLOCATE(alpha_rho_in(1:num_fluids, 1:num_dims), alpha_in(1:num_fluids, 1:num_dims)) - ! Assign and update GRCBC inputs + ! Assign and update grCBC inputs #:for CBC_DIR, XYZ in [(1, 'x'), (2, 'y'), (3, 'z')] if (${CBC_DIR}$ <= num_dims) then vel_in(${CBC_DIR}$, 1) = bc_${XYZ}$%vel_in(1) @@ -860,7 +860,7 @@ contains call s_compute_nonreflecting_subsonic_buffer_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) else if ((cbc_loc == -1 .and. bc${XYZ}$b == -7) .or. (cbc_loc == 1 .and. bc${XYZ}$e == -7)) then call s_compute_nonreflecting_subsonic_inflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) - ! Add GRCBC for Subsonic Inflow + ! Add grCBC for Subsonic Inflow if (bc_${XYZ}$%grcbc_in) then !$acc loop seq do i = 2, momxb @@ -880,11 +880,11 @@ contains end if else if ((cbc_loc == -1 .and. bc${XYZ}$b == -8) .or. (cbc_loc == 1 .and. bc${XYZ}$e == -8)) then call s_compute_nonreflecting_subsonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) - ! Add GRCBC for Subsonic Outflow (Pressure) + ! Add grCBC for Subsonic Outflow (Pressure) if (bc_${XYZ}$%grcbc_out) then L(advxe) = c*(1._wp - Ma)*(pres - pres_out(${CBC_DIR}$))/Del_out(${CBC_DIR}$) - ! Add GRCBC for Subsonic Outflow (Normal Velocity) + ! Add grCBC for Subsonic Outflow (Normal Velocity) if (bc_${XYZ}$%grcbc_vel_out) then L(advxe) = L(advxe) + rho*c**2._wp*(1._wp - Ma)*(vel(dir_idx(1)) + vel_out(${CBC_DIR}$, dir_idx(1))*sign(1, cbc_loc))/Del_out(${CBC_DIR}$) end if @@ -1536,7 +1536,7 @@ contains ! Deallocating the cell-width distribution in the s-direction @:DEALLOCATE(ds) - ! Deallocating GRCBC inputs + ! Deallocating grCBC inputs @:DEALLOCATE(vel_in, vel_out, pres_in, pres_out, Del_in, Del_out, alpha_rho_in, alpha_in) ! Deallocating CBC Coefficients in x-direction diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index fcdf08b1a8..a8be987681 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -120,7 +120,7 @@ contains @:PROHIBIT(model_eqns == 3 .and. wave_speeds /= 1, "6-equation model (model_eqns = 3) requires wave_speeds = 1") end subroutine s_check_inputs_model_eqns - !> Checks constraints for GRCBC + !> Checks constraints for grCBC subroutine s_check_inputs_grcbc #:for DIR in ['x', 'y', 'z'] @:PROHIBIT(bc_${DIR}$%grcbc_in .and. (bc_${DIR}$%beg /= -7 .and. bc_${DIR}$%end /= -7), "Subsonic Inflow requires bc = -7") diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 76e4bc114f..3eeb6c0b9b 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -690,7 +690,7 @@ contains integral(i)%ymax = dflt_real end do - ! GRCBC flags + ! grCBC flags #:for dir in {'x', 'y', 'z'} bc_${dir}$%grcbc_in = .false. bc_${dir}$%grcbc_out = .false. @@ -1216,11 +1216,6 @@ contains call MPI_INFO_CREATE(mpi_info_int, ierr) call MPI_INFO_SET(mpi_info_int, 'romio_ds_write', 'disable', ierr) - ! Option for UNIX file system (Hooke/Thomson) - ! WRITE(mpiiofs, '(A)') '/ufs_' - ! mpiiofs = TRIM(mpiiofs) - ! mpi_info_int = MPI_INFO_NULL - allocate (start_idx(1:num_dims)) #endif diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index d014402574..a28a0191e3 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -128,7 +128,8 @@ contains do i = 1, tensor_size tensora(i) = 0_wp end do - ! STEP 1: computing the grad_xi tensor using finite differences + + ! Step 1: computing the grad_xi tensor using finite differences ! grad_xi definition / organization ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy @@ -148,7 +149,7 @@ contains tensora(8) = tensora(8) + q_prim_vf(xibeg + 1)%sf(j, k, l + r)*fd_coeff_z(r, l) tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_z(r, l) end do - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + ! Step 2a: computing the adjoint of the grad_xi tensor for the inverse tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) @@ -159,45 +160,45 @@ contains tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) - ! STEP 2b: computing the determinant of the grad_xi tensor + ! Step 2b: computing the determinant of the grad_xi tensor tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) if (tensorb(tensor_size) > verysmall) then - ! STEP 2c: computing the inverse of grad_xi tensor = F + ! Step 2c: computing the inverse of grad_xi tensor = F ! tensorb is the adjoint, tensora becomes F !$acc loop seq do i = 1, tensor_size - 1 tensora(i) = tensorb(i)/tensorb(tensor_size) end do - ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) + ! Step 2d: computing the J = det(F) = 1/det(\grad{\xi}) tensorb(tensor_size) = 1_wp/tensorb(tensor_size) - ! STEP 3: computing F transpose F + ! Step 3: computing F transpose F tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) - ! STEP 4: update the btensor, this is consistent with Riemann solvers + ! Step 4: update the btensor, this is consistent with Riemann solvers #:for BIJ, TXY in [(1,1),(2,2),(3,5),(4,3),(5,6),(6,9)] btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) #:endfor ! store the determinant at the last entry of the btensor btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) - ! STEP 5a: updating the Cauchy stress primitive scalar field + ! Step 5a: updating the Cauchy stress primitive scalar field if (hyper_model == 1) then call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) elseif (hyper_model == 2) then call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) end if - ! STEP 5b: updating the pressure field + ! Step 5b: updating the pressure field q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma - ! STEP 5c: updating the Cauchy stress conservative scalar field + ! Step 5c: updating the Cauchy stress conservative scalar field !$acc loop seq do i = 1, b_size - 1 q_cons_vf(strxb + i - 1)%sf(j, k, l) = & diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 6702133181..0a5eed1c4e 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -561,7 +561,7 @@ contains end do end if - ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY + ! energy adjustments for hyperelastic energy if (hyperelasticity) then !$acc loop seq do i = 1, num_dims @@ -780,7 +780,7 @@ contains /(s_M - s_P) end if - ! ELASTIC STRESSES FLUX. + ! elastic stresses flux. if (hypoelasticity) then do i = 1, strxe - strxb + 1 flux_rs${XYZ}$_vf(j, k, l, strxb - 1 + i) = & @@ -794,7 +794,7 @@ contains end do end if - ! REFERENCE MAP FLUX. + ! reference map flux. if (hyperelasticity) then do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, xibeg - 1 + i) = & @@ -806,7 +806,7 @@ contains end do end if - ! ADVECTION FLUX. + ! advection flux. !$acc loop seq do i = advxb, advxe flux_rs${XYZ}$_vf(j, k, l, i) = & @@ -1161,7 +1161,7 @@ contains E_L = gamma_L*pres_L + pi_inf_L + 5e-1_wp*rho_L*vel_L_rms + qv_L E_R = gamma_R*pres_R + pi_inf_R + 5e-1_wp*rho_R*vel_R_rms + qv_R - ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY + ! energy adjustments for hypoelastic energy if (hypoelasticity) then !$acc loop seq do i = 1, strxe - strxb + 1 @@ -1189,7 +1189,7 @@ contains end do end if - ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY + ! energy adjustments for hyperelastic energy if (hyperelasticity) then !$acc loop seq do i = 1, num_dims @@ -1238,7 +1238,7 @@ contains end do end if - ! COMPUTING THE DIRECT WAVE SPEEDS + ! computing the direct wave speeds if (wave_speeds == 1) then if (elasticity) then s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & @@ -1313,8 +1313,9 @@ contains vel_K_Star = vel_L(idx1)*(1_wp - xi_MP) + xi_MP*vel_R(idx1) + & xi_MP*xi_PP*(s_S - vel_R(idx1)) - ! COMPUTING FLUXES - ! MASS FLUX. + ! computing fluxes + + ! mass flux. !$acc loop seq do i = 1, contxe flux_rs${XYZ}$_vf(j, k, l, i) = & @@ -1322,7 +1323,7 @@ contains xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*(vel_R(idx1) + s_P*(xi_R - 1._wp)) end do - ! MOMENTUM FLUX. + ! momentum flux. ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) !$acc loop seq do i = 1, num_dims @@ -1331,21 +1332,21 @@ contains (dir_flg(idxi)*vel_K_Star + (1_wp - dir_flg(idxi))*(xi_M*vel_L(idxi) + xi_P*vel_R(idxi))) + dir_flg(idxi)*p_Star end do - ! ENERGY FLUX. + ! energy flux. ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) flux_rs${XYZ}$_vf(j, k, l, E_idx) = (E_star + p_Star)*vel_K_Star - ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux + ! elasticity. elastic shear stress additions for the momentum and energy flux if (elasticity) then flux_ene_e = 0_wp; !$acc loop seq do i = 1, num_dims idxi = dir_idx(i) - ! MOMENTUM ELASTIC FLUX. + ! momentum elastic flux. flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) - ! ENERGY ELASTIC FLUX. + ! energy elastic flux. flux_ene_e = flux_ene_e - & xi_M*(vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & @@ -1355,7 +1356,7 @@ contains flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e end if - ! VOLUME FRACTION FLUX. + ! volume fraction flux. !$acc loop seq do i = advxb, advxe flux_rs${XYZ}$_vf(j, k, l, i) = & @@ -1363,7 +1364,7 @@ contains xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)*s_S end do - ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX. + ! source term for volume fraction advection flux. !$acc loop seq do i = 1, num_dims idxi = dir_idx(i) @@ -1372,7 +1373,7 @@ contains xi_P*(vel_R(idxi) + dir_flg(idxi)*(s_S*(xi_PP*(xi_R - 1) + 1) - vel_R(idxi))) end do - ! INTERNAL ENERGIES ADVECTION FLUX. + ! internal energies advection flux. ! K-th pressure and velocity in preparation for the internal energy flux !$acc loop seq do i = 1, num_fluids @@ -1390,7 +1391,7 @@ contains flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) - ! HYPOELASTIC STRESS EVOLUTION FLUX. + ! hypoelastic stress evolution flux. if (hypoelasticity) then !$acc loop seq do i = 1, strxe - strxb + 1 @@ -1400,7 +1401,7 @@ contains end do end if - ! REFERENCE MAP FLUX. + ! reference map flux. if (hyperelasticity) then !$acc loop seq do i = 1, num_dims @@ -1412,7 +1413,7 @@ contains end do end if - ! SURFACE TENSION FLUX. need to check + ! surface tension flux. need to check if (surface_tension) then flux_rs${XYZ}$_vf(j, k, l, c_idx) = & (xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, c_idx) + & @@ -2346,7 +2347,7 @@ contains H_R = (E_R + pres_R)/rho_R end if - ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY + ! energy adjustments for hypoelastic energy if (hypoelasticity) then !$acc loop seq do i = 1, strxe - strxb + 1 @@ -2375,7 +2376,7 @@ contains end do end if - ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY + ! energy adjustments for hyperelastic energy if (hyperelasticity) then !$acc loop seq do i = 1, num_dims @@ -2485,8 +2486,9 @@ contains xi_M = (5e-1_wp + sign(5e-1_wp, s_S)) xi_P = (5e-1_wp - sign(5e-1_wp, s_S)) - ! COMPUTING THE HLLC FLUXES - ! MASS FLUX. + ! COMPUTING the hllc fluxes + + ! mass flux. if (low_Mach == 1) then @:compute_low_Mach_correction() else @@ -2502,7 +2504,7 @@ contains *(vel_R(idx1) + s_P*(xi_R - 1._wp)) end do - ! MOMENTUM FLUX. + ! momentum flux. ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) !$acc loop seq do i = 1, num_dims @@ -2523,7 +2525,7 @@ contains + (s_M/s_L)*(s_P/s_R)*dir_flg(idxi)*pcorr end do - ! ENERGY FLUX. + ! energy flux. ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u)) flux_rs${XYZ}$_vf(j, k, l, E_idx) = & xi_M*(vel_L(idx1)*(E_L + pres_L) + & @@ -2536,17 +2538,19 @@ contains (s_R - vel_R(idx1)))) - E_R)) & + (s_M/s_L)*(s_P/s_R)*pcorr*s_S - ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux + ! elasticity. elastic shear stress additions for the momentum and energy flux if (elasticity) then flux_ene_e = 0_wp !$acc loop seq do i = 1, num_dims idxi = dir_idx(i) - ! MOMENTUM ELASTIC FLUX. + + ! momentum elastic flux flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) = & flux_rs${XYZ}$_vf(j, k, l, contxe + idxi) & - xi_M*tau_e_L(dir_idx_tau(i)) - xi_P*tau_e_R(dir_idx_tau(i)) - ! ENERGY ELASTIC FLUX. + + ! energy elastic flux flux_ene_e = flux_ene_e - & xi_M*(vel_L(idxi)*tau_e_L(dir_idx_tau(i)) + & s_M*(xi_L*((s_S - vel_L(i))*(tau_e_L(dir_idx_tau(i))/(s_L - vel_L(i)))))) - & @@ -2556,7 +2560,7 @@ contains flux_rs${XYZ}$_vf(j, k, l, E_idx) = flux_rs${XYZ}$_vf(j, k, l, E_idx) + flux_ene_e end if - ! HYPOELASTIC STRESS EVOLUTION FLUX. + ! hypoelastic stress evolution flux if (hypoelasticity) then !$acc loop seq do i = 1, strxe - strxb + 1 @@ -2566,7 +2570,7 @@ contains end do end if - ! VOLUME FRACTION FLUX. + ! volume fraction flux !$acc loop seq do i = advxb, advxe flux_rs${XYZ}$_vf(j, k, l, i) = & @@ -2576,7 +2580,7 @@ contains *(vel_R(idx1) + s_P*(xi_R - 1._wp)) end do - ! VOLUME FRACTION SOURCE FLUX. + ! volume fraction source flux !$acc loop seq do i = 1, num_dims idxi = dir_idx(i) @@ -2589,7 +2593,7 @@ contains s_P*(xi_R - 1._wp)) end do - ! REFERENCE MAP FLUX. + ! reference map flux if (hyperelasticity) then !$acc loop seq do i = 1, num_dims diff --git a/src/simulation/m_sim_helpers.f90 b/src/simulation/m_sim_helpers.f90 index 0c6f95a672..2fc787cf5b 100644 --- a/src/simulation/m_sim_helpers.f90 +++ b/src/simulation/m_sim_helpers.f90 @@ -77,7 +77,7 @@ subroutine s_compute_enthalpy(q_prim_vf, pres, rho, gamma, pi_inf, Re, H, alpha, E = gamma*pres + pi_inf + 5e-1_wp*rho*vel_sum + qv - ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY + ! energy adjustments for hyperelastic energy if (hyperelasticity) then E = E + G*q_prim_vf(xiend + 1)%sf(j, k, l) end if diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 7206d8f503..40d907e955 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -1067,7 +1067,7 @@ contains start_rkck_step = .false. restart_rkck_step = .false. - ! FIRST TIME-STAGE + ! first time-stage RKstep = 1 rkck_time_tmp = mytime + rkck_c1*dt !$acc update device (rkck_time_tmp) @@ -1081,7 +1081,7 @@ contains if (lag_largestep > 0._wp) call s_compute_rkck_dt(lag_largestep, restart_rkck_step) if (restart_rkck_step) cycle - ! SECOND TIME-STAGE + ! second time-stage RKstep = 2 rkck_time_tmp = mytime + rkck_c2*dt !$acc update device (rkck_time_tmp) @@ -1095,7 +1095,7 @@ contains if (lag_largestep > 0._wp) call s_compute_rkck_dt(lag_largestep, restart_rkck_step) if (restart_rkck_step) cycle - ! THIRD TIME-STAGE + ! third time-stage RKstep = 3 rkck_time_tmp = mytime + rkck_c3*dt !$acc update device (rkck_time_tmp) @@ -1109,7 +1109,7 @@ contains if (lag_largestep > 0._wp) call s_compute_rkck_dt(lag_largestep, restart_rkck_step) if (restart_rkck_step) cycle - ! FOURTH TIME-STAGE + ! fourth time-stage RKstep = 4 rkck_time_tmp = mytime + rkck_c4*dt !$acc update device (rkck_time_tmp) @@ -1123,7 +1123,7 @@ contains if (lag_largestep > 0._wp) call s_compute_rkck_dt(lag_largestep, restart_rkck_step) if (restart_rkck_step) cycle - ! FIFTH TIME-STAGE + ! fifth time-stage RKstep = 5 rkck_time_tmp = mytime + rkck_c5*dt !$acc update device (rkck_time_tmp) @@ -1137,7 +1137,7 @@ contains if (lag_largestep > 0._wp) call s_compute_rkck_dt(lag_largestep, restart_rkck_step) if (restart_rkck_step) cycle - ! SIXTH TIME-STAGE + ! sixth time-stage RKstep = 6 rkck_time_tmp = mytime + rkck_c6*dt !$acc update device (rkck_time_tmp) @@ -1154,7 +1154,7 @@ contains dt_did = dt if (rkck_adap_dt) then - ! TRUNCATION ERROR + ! truncation error #ifdef DEBUG if (proc_rank == 0) print *, 'Computing truncation error (4th/5th RKCK)' #endif From 9afde7d0f8ee7c4743342e6272b189383fe7daa2 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Sat, 11 Jan 2025 09:29:24 -0500 Subject: [PATCH 361/380] clean --- src/simulation/m_riemann_solvers.fpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 0a5eed1c4e..afdb443e05 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -2486,7 +2486,7 @@ contains xi_M = (5e-1_wp + sign(5e-1_wp, s_S)) xi_P = (5e-1_wp - sign(5e-1_wp, s_S)) - ! COMPUTING the hllc fluxes + ! Computing the hllc fluxes ! mass flux. if (low_Mach == 1) then From 619e9f1d920c55f6afbb7d4d87288781f6f944c7 Mon Sep 17 00:00:00 2001 From: Yanjun Zhang <120074479+ChrisZYJ@users.noreply.github.com> Date: Mon, 20 Jan 2025 00:28:40 -0800 Subject: [PATCH 362/380] Hyper edits (#2) * fix checker * tau_wrt * misc changes * lint --- docs/documentation/case.md | 1 + src/common/m_checker_common.fpp | 15 ++------- src/post_process/m_checker.fpp | 11 +++++- src/post_process/m_data_output.fpp | 2 +- src/post_process/m_global_parameters.fpp | 23 +++++++------ src/post_process/m_mpi_proxy.fpp | 2 +- src/post_process/m_start_up.f90 | 43 +++++++++++------------- src/pre_process/m_global_parameters.fpp | 22 ++++++------ src/simulation/m_checker.fpp | 7 ++++ src/simulation/m_global_parameters.fpp | 23 +++++++------ toolchain/mfc/run/case_dicts.py | 1 + toolchain/mfc/test/case.py | 3 +- 12 files changed, 81 insertions(+), 72 deletions(-) diff --git a/docs/documentation/case.md b/docs/documentation/case.md index 5b3f54b202..c74f421a96 100644 --- a/docs/documentation/case.md +++ b/docs/documentation/case.md @@ -508,6 +508,7 @@ To restart the simulation from $k$-th time step, see [Restarting Cases](running. | `vel_wrt(i)` | Logical | Add the $i$-direction velocity to the database | | `E_wrt` | Logical | Add the total energy to the database | | `pres_wrt` | Logical | Add the pressure to the database | +| `tau_wrt` | Logical | Add the elastic stresses to the database | | `alpha_wrt(i)` | Logical | Add the volume fraction of fluid $i$ to the database | | `gamma_wrt` | Logical | Add the specific heat ratio function to the database | | `heat_ratio_wrt` | Logical | Add the specific heat ratio to the database | diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index 59e12cd216..8e07c857a3 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -161,23 +161,12 @@ contains !> Checks constraints on the elasticity parameters. !! Called by s_check_inputs_common for all three stages subroutine s_check_inputs_elasticity - @:PROHIBIT((hypoelasticity .or. hyperelasticity) .and. model_eqns == 1, & - "Elasticity does not work for model_eqns = 1") - @:PROHIBIT((hypoelasticity .or. hyperelasticity) .and. model_eqns > 3, & - "Elasticity works only for model_eqns 2 and 3") + @:PROHIBIT(elasticity .and. .not. (model_eqns == 2 .or. model_eqns == 3)) #:for X in ['x', 'y', 'z'] #:for BOUND in ['beg', 'end'] - @:PROHIBIT(hyperelasticity .and. ((bc_${X}$%${BOUND}$ .lt. -3)), & - "bc_${X}$%${BOUND}$ is not supported") + @:PROHIBIT(hyperelasticity .and. bc_${X}$%${BOUND}$ /= dflt_int .and. (bc_${X}$%${BOUND}$ < -3)) #:endfor #:endfor - -#ifdef MFC_SIMULATION - @:PROHIBIT(elasticity .and. fd_order /= 4) - @:PROHIBIT(hyperelasticity .and. hyper_model .le. 0, & - "Set the hyper_model in the input file") -#endif - end subroutine s_check_inputs_elasticity !> Checks constraints on dimensionality and the number of cells for the grid. diff --git a/src/post_process/m_checker.fpp b/src/post_process/m_checker.fpp index cfe8d8ad27..8d2f23b664 100644 --- a/src/post_process/m_checker.fpp +++ b/src/post_process/m_checker.fpp @@ -33,6 +33,7 @@ contains call s_check_inputs_volume_fraction call s_check_inputs_vorticity call s_check_inputs_schlieren + call s_check_inputs_elasticity call s_check_inputs_surface_tension call s_check_inputs_no_flow_variables @@ -129,6 +130,14 @@ contains end do end subroutine s_check_inputs_schlieren + !> Checks constraints on elasticity parameters + subroutine s_check_inputs_elasticity + @:PROHIBIT(.not. (hypoelasticity .or. hyperelasticity) .and. tau_wrt) + ! Note: 'elasticity' variable isn't initialized yet; use (hypoelasticity .or. hyperelasticity) instead + @:PROHIBIT(.not. hyperelasticity .and. kymograph) + @:PROHIBIT(format == 2 .and. kymograph, 'Binary output format does not support kymograph') + end subroutine + !> Checks constraints on surface tension parameters (cf_wrt and sigma) subroutine s_check_inputs_surface_tension @:PROHIBIT(cf_wrt .and. .not. surface_tension, & @@ -138,7 +147,7 @@ contains !> Checks constraints on the absence of flow variables subroutine s_check_inputs_no_flow_variables @:PROHIBIT(.not. any([ & - (/rho_wrt, E_wrt, pres_wrt, gamma_wrt, heat_ratio_wrt, pi_inf_wrt, & + (/rho_wrt, E_wrt, pres_wrt, tau_wrt, gamma_wrt, heat_ratio_wrt, pi_inf_wrt, & pres_inf_wrt, cons_vars_wrt, prim_vars_wrt, c_wrt, schlieren_wrt/), & alpha_rho_wrt, mom_wrt, vel_wrt, flux_wrt, alpha_wrt, omega_wrt]), & "None of the flow variables have been selected for post-process. Exiting.") diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index bdacecf1c4..33f226d0b1 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -345,7 +345,7 @@ contains if (pres_wrt .or. prim_vars_wrt) dbvars = dbvars + 1 ! Elastic stresses - if (hypoelasticity) dbvars = dbvars + (num_dims*(num_dims + 1))/2 + if (tau_wrt .or. prim_vars_wrt) dbvars = dbvars + (num_dims*(num_dims + 1))/2 ! Volume fraction(s) if ((model_eqns == 2) .or. (model_eqns == 3)) then diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 4bdca155af..a20950e208 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -219,6 +219,7 @@ module m_global_parameters logical, dimension(3) :: flux_wrt logical :: E_wrt logical :: pres_wrt + logical :: tau_wrt logical, dimension(num_fluids_max) :: alpha_wrt logical :: gamma_wrt logical :: heat_ratio_wrt @@ -385,6 +386,7 @@ contains file_per_process = .false. E_wrt = .false. pres_wrt = .false. + tau_wrt = .false. alpha_wrt = .false. gamma_wrt = .false. heat_ratio_wrt = .false. @@ -649,22 +651,23 @@ contains end if end if - if (hypoelasticity .or. hyperelasticity) elasticity = .true. + elasticity = hypoelasticity .or. hyperelasticity if (elasticity) then stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D sys_size = stress_idx%end - if (hyperelasticity) then - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims - ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 - ! number of entries in the symmetric btensor plus the jacobian - b_size = (num_dims*(num_dims + 1))/2 + 1 - tensor_size = num_dims**2 + 1 - end if + end if + + if (hyperelasticity) then + xi_idx%beg = sys_size + 1 + xi_idx%end = sys_size + num_dims + ! adding three more equations for the \xi field and the elastic energy + sys_size = xi_idx%end + 1 + ! number of entries in the symmetric btensor plus the jacobian + b_size = (num_dims*(num_dims + 1))/2 + 1 + tensor_size = num_dims**2 + 1 end if if (chemistry) then diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp index 796d0026f4..d53352ca93 100644 --- a/src/post_process/m_mpi_proxy.fpp +++ b/src/post_process/m_mpi_proxy.fpp @@ -163,7 +163,7 @@ contains #:for VAR in [ 'cyl_coord', 'mpp_lim', 'mixture_err', & & 'alt_soundspeed', 'hypoelasticity', 'parallel_io', 'rho_wrt', & - & 'E_wrt', 'pres_wrt', 'gamma_wrt', 'sim_data', 'kymograph', & + & 'E_wrt', 'pres_wrt', 'tau_wrt', 'gamma_wrt', 'sim_data', 'kymograph', & & 'heat_ratio_wrt', 'pi_inf_wrt', 'pres_inf_wrt', 'cons_vars_wrt', & & 'prim_vars_wrt', 'c_wrt', 'qm_wrt','schlieren_wrt', 'bubbles_euler', 'qbmm', & & 'polytropic', 'polydisperse', 'file_per_process', 'relax', 'cf_wrt', & diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 9de428eb64..de7691c220 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -72,7 +72,7 @@ subroutine s_read_input_file hypoelasticity, G, & chem_wrt_Y, chem_wrt_T, avg_state, & alpha_rho_wrt, rho_wrt, mom_wrt, vel_wrt, & - E_wrt, pres_wrt, alpha_wrt, gamma_wrt, & + E_wrt, pres_wrt, tau_wrt, alpha_wrt, gamma_wrt, & heat_ratio_wrt, pi_inf_wrt, pres_inf_wrt, & cons_vars_wrt, prim_vars_wrt, c_wrt, & omega_wrt, qm_wrt, schlieren_wrt, schlieren_alpha, & @@ -361,35 +361,30 @@ subroutine s_save_data(t_step, varname, pres, c, H) end if ! Adding the elastic shear stresses to the formatted database file - if (elasticity) then - if (prim_vars_wrt) then - do i = 1, stress_idx%end - stress_idx%beg + 1 - q_sf = q_prim_vf(i - 1 + stress_idx%beg)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) - write (varname, '(A,I0)') 'tau', i - call s_write_variable_to_formatted_database_file(varname, t_step) + if (elasticity .and. (tau_wrt .or. prim_vars_wrt)) then + do i = 1, stress_idx%end - stress_idx%beg + 1 + q_sf = q_prim_vf(i - 1 + stress_idx%beg)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) + write (varname, '(A,I0)') 'tau', i + call s_write_variable_to_formatted_database_file(varname, t_step) - varname(:) = ' ' - end do - end if + varname(:) = ' ' + end do end if - if (hyperelasticity) then - if (prim_vars_wrt) then - do i = 1, xiend - xibeg + 1 - q_sf = q_prim_vf(i - 1 + xibeg)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) - write (varname, '(A,I0)') 'xi', i - call s_write_variable_to_formatted_database_file(varname, t_step) - - varname(:) = ' ' - end do - - q_sf = q_prim_vf(xiend + 1)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) - - write (varname, '(A,I0)') 'vonMises' + if (hyperelasticity .and. (tau_wrt .or. prim_vars_wrt)) then + do i = 1, xiend - xibeg + 1 + q_sf = q_prim_vf(i - 1 + xibeg)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) + write (varname, '(A,I0)') 'xi', i call s_write_variable_to_formatted_database_file(varname, t_step) + varname(:) = ' ' + end do - end if + q_sf = q_prim_vf(xiend + 1)%sf(x_beg:x_end, y_beg:y_end, z_beg:z_end) + + write (varname, '(A,I0)') 'vonMises' + call s_write_variable_to_formatted_database_file(varname, t_step) + varname(:) = ' ' end if ! Adding the pressure to the formatted database file diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index d35bcce4cc..a3b9a6ebd6 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -720,22 +720,24 @@ contains end if end if - if (hypoelasticity .or. hyperelasticity) elasticity = .true. + elasticity = hypoelasticity .or. hyperelasticity + if (elasticity) then ! creates stress indices for both hypo and hyperelasticity stress_idx%beg = sys_size + 1 stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of stresses is 1 in 1D, 3 in 2D, 6 in 3D sys_size = stress_idx%end - if (hyperelasticity) then - ! number of entries in the symmetric btensor plus the jacobian - b_size = (num_dims*(num_dims + 1))/2 + 1 - tensor_size = num_dims**2 + 1 - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims - ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 - end if + end if + + if (hyperelasticity) then + ! number of entries in the symmetric btensor plus the jacobian + b_size = (num_dims*(num_dims + 1))/2 + 1 + tensor_size = num_dims**2 + 1 + xi_idx%beg = sys_size + 1 + xi_idx%end = sys_size + num_dims + ! adding three more equations for the \xi field and the elastic energy + sys_size = xi_idx%end + 1 end if if (chemistry) then diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index a8be987681..ec2aa0e3a7 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -30,6 +30,7 @@ contains call s_check_inputs_time_stepping call s_check_inputs_model_eqns call s_check_inputs_acoustic_src + call s_check_inputs_elasticity call s_check_inputs_bubbles_euler call s_check_inputs_bubbles_lagrange call s_check_inputs_adapt_dt @@ -256,6 +257,12 @@ contains end subroutine s_check_inputs_acoustic_src + !> Checks constraints on elasticity parameters + subroutine s_check_inputs_elasticity + @:PROHIBIT(hyperelasticity .and. hyper_model == dflt_int) + @:PROHIBIT(elasticity .and. fd_order /= 4) + end subroutine + !> Checks constraints on bubble parameters subroutine s_check_inputs_bubbles_euler @:PROHIBIT(bubbles_euler .and. bubbles_lagrange, "Activate only one of the bubble subgrid models") diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 3eeb6c0b9b..3a86ee4efd 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -1006,7 +1006,7 @@ contains end if ! END: Volume Fraction Model - if (hypoelasticity .or. hyperelasticity) elasticity = .true. + elasticity = hypoelasticity .or. hyperelasticity if (elasticity) then ! creates stress indices for both hypo and hyperelasticity @@ -1014,16 +1014,17 @@ contains stress_idx%end = sys_size + (num_dims*(num_dims + 1))/2 ! number of distinct stresses is 1 in 1D, 3 in 2D, 6 in 3D sys_size = stress_idx%end - if (hyperelasticity) then - ! number of entries in the symmetric btensor plus the jacobian - b_size = (num_dims*(num_dims + 1))/2 + 1 - ! storing the jacobian in the last entry - tensor_size = num_dims**2 + 1 - xi_idx%beg = sys_size + 1 - xi_idx%end = sys_size + num_dims - ! adding three more equations for the \xi field and the elastic energy - sys_size = xi_idx%end + 1 - end if + end if + + if (hyperelasticity) then + ! number of entries in the symmetric btensor plus the jacobian + b_size = (num_dims*(num_dims + 1))/2 + 1 + ! storing the jacobian in the last entry + tensor_size = num_dims**2 + 1 + xi_idx%beg = sys_size + 1 + xi_idx%end = sys_size + num_dims + ! adding three more equations for the \xi field and the elastic energy + sys_size = xi_idx%end + 1 end if if (chemistry) then diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index 86c4fc5529..d223cbcbda 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -363,6 +363,7 @@ def analytic(self): 'flux_wrt': ParamType.LOG, 'E_wrt': ParamType.LOG, 'pres_wrt': ParamType.LOG, + 'tau_wrt': ParamType.LOG, 'alpha_wrt': ParamType.LOG, 'kappa_wrt': ParamType.LOG, 'gamma_wrt': ParamType.LOG, diff --git a/toolchain/mfc/test/case.py b/toolchain/mfc/test/case.py index a8f21f0e07..252732457a 100644 --- a/toolchain/mfc/test/case.py +++ b/toolchain/mfc/test/case.py @@ -220,7 +220,8 @@ def create_directory(self): 'prim_vars_wrt': 'T', 'alpha_rho_wrt(1)': 'T', 'rho_wrt' : 'T', 'mom_wrt(1)' : 'T', 'vel_wrt(1)' : 'T', 'E_wrt' : 'T', - 'pres_wrt' : 'T', 'alpha_wrt(1)' : 'T', + 'pres_wrt' : 'T', + 'tau_wrt' : 'T', 'alpha_wrt(1)' : 'T', 'gamma_wrt' : 'T', 'heat_ratio_wrt' : 'T', 'pi_inf_wrt' : 'T', 'pres_inf_wrt' : 'T', 'c_wrt' : 'T', From 4a63dc23a401409e1c4f1cdf956396f7723f04e2 Mon Sep 17 00:00:00 2001 From: Yanjun Zhang <120074479+ChrisZYJ@users.noreply.github.com> Date: Mon, 20 Jan 2025 13:02:58 -0800 Subject: [PATCH 363/380] Fix tau_wrt test bug (#3) fix tau_wrt test bug --- toolchain/mfc/test/case.py | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/toolchain/mfc/test/case.py b/toolchain/mfc/test/case.py index 252732457a..a8f21f0e07 100644 --- a/toolchain/mfc/test/case.py +++ b/toolchain/mfc/test/case.py @@ -220,8 +220,7 @@ def create_directory(self): 'prim_vars_wrt': 'T', 'alpha_rho_wrt(1)': 'T', 'rho_wrt' : 'T', 'mom_wrt(1)' : 'T', 'vel_wrt(1)' : 'T', 'E_wrt' : 'T', - 'pres_wrt' : 'T', - 'tau_wrt' : 'T', 'alpha_wrt(1)' : 'T', + 'pres_wrt' : 'T', 'alpha_wrt(1)' : 'T', 'gamma_wrt' : 'T', 'heat_ratio_wrt' : 'T', 'pi_inf_wrt' : 'T', 'pres_inf_wrt' : 'T', 'c_wrt' : 'T', From 517ecb504f14689b1a552ad512265b06a0302b11 Mon Sep 17 00:00:00 2001 From: Chris Zhang Date: Mon, 20 Jan 2025 14:36:10 -0800 Subject: [PATCH 364/380] fix hyper_model & examples --- examples/1D_hyper_impact_strong/case.py | 2 ++ examples/1D_hyper_impact_weak/case.py | 12 ++---------- examples/1D_hypo_impact_strong/case.py | 1 + examples/1D_hypo_impact_weak/case.py | 1 + src/common/m_variables_conversion.fpp | 2 +- src/simulation/m_checker.fpp | 2 +- src/simulation/m_mpi_proxy.fpp | 4 ++-- src/simulation/m_start_up.fpp | 2 +- toolchain/mfc/run/case_dicts.py | 2 +- 9 files changed, 12 insertions(+), 16 deletions(-) diff --git a/examples/1D_hyper_impact_strong/case.py b/examples/1D_hyper_impact_strong/case.py index 53a83f4a4f..de9b1effff 100755 --- a/examples/1D_hyper_impact_strong/case.py +++ b/examples/1D_hyper_impact_strong/case.py @@ -52,6 +52,8 @@ #'bc_y%end' : -3, # Turning on Hypoelasticity "hyperelasticity": "T", + "hyper_model": 1, + "fd_order": 4, # Formatted Database Files Structure Parameters "format": 1, "precision": 2, diff --git a/examples/1D_hyper_impact_weak/case.py b/examples/1D_hyper_impact_weak/case.py index efee055a8c..87a24c330b 100755 --- a/examples/1D_hyper_impact_weak/case.py +++ b/examples/1D_hyper_impact_weak/case.py @@ -19,8 +19,6 @@ # Computational Domain Parameters "x_domain%beg": 0.0e00, "x_domain%end": 1.0e00, - "y_domain%beg": 0.0e00, - "y_domain%end": 0.002, "m": Nx, "n": 0, "p": 0, @@ -48,10 +46,10 @@ "avg_state": 2, "bc_x%beg": -3, "bc_x%end": -3, - "bc_y%beg": -3, - "bc_y%end": -3, # Turning on Hyperelasticity "hyperelasticity": "T", + "hyper_model": 1, + "fd_order": 4, # Formatted Database Files Structure Parameters "format": 1, "precision": 2, @@ -60,11 +58,8 @@ # Patch 1 L "patch_icpp(1)%geometry": 1, "patch_icpp(1)%x_centroid": 0.25, - "patch_icpp(1)%y_centroid": 0.001, "patch_icpp(1)%length_x": 0.5, - "patch_icpp(1)%length_y": 0.002, "patch_icpp(1)%vel(1)": 10, - "patch_icpp(1)%vel(2)": 0, "patch_icpp(1)%pres": 1.0e5, "patch_icpp(1)%alpha_rho(1)": 1000, "patch_icpp(1)%alpha(1)": 1.0, @@ -72,11 +67,8 @@ # Patch 2 R "patch_icpp(2)%geometry": 1, "patch_icpp(2)%x_centroid": 0.75, - "patch_icpp(2)%y_centroid": 0.001, "patch_icpp(2)%length_x": 0.5, - "patch_icpp(2)%length_y": 0.002, "patch_icpp(2)%vel(1)": -10, # 10, - "patch_icpp(2)%vel(2)": 0, "patch_icpp(2)%pres": 1.0e05, "patch_icpp(2)%alpha_rho(1)": 1000, "patch_icpp(2)%alpha(1)": 1.0, diff --git a/examples/1D_hypo_impact_strong/case.py b/examples/1D_hypo_impact_strong/case.py index 0530e8a551..6044fc5cf5 100755 --- a/examples/1D_hypo_impact_strong/case.py +++ b/examples/1D_hypo_impact_strong/case.py @@ -52,6 +52,7 @@ #'bc_y%end' : -3, # Turning on Hypoelasticity "hypoelasticity": "T", + "fd_order": 4, # Formatted Database Files Structure Parameters "format": 1, "precision": 2, diff --git a/examples/1D_hypo_impact_weak/case.py b/examples/1D_hypo_impact_weak/case.py index f065372f3e..05d1f5ca94 100755 --- a/examples/1D_hypo_impact_weak/case.py +++ b/examples/1D_hypo_impact_weak/case.py @@ -48,6 +48,7 @@ "bc_x%end": -3, # Turning on Hypoelasticity "hypoelasticity": "T", + "fd_order": 4, # Formatted Database Files Structure Parameters "format": 1, "precision": 2, diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 1b87d53383..1379081baa 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1040,7 +1040,7 @@ contains end if #ifdef MFC_POST_PROCESS - if (hyperelasticity) then + if (hyperelasticity .and. p /= 0) then ! to save von Mises stress instead of elastic internal energy qK_prim_vf(xiend + 1)%sf(j, k, l) = sqrt((3_wp/2_wp)*(qK_prim_vf(strxb)%sf(j, k, l)**2_wp + & 2_wp*qK_prim_vf(strxb + 1)%sf(j, k, l)**2_wp + qK_prim_vf(strxb + 2)%sf(j, k, l)**2_wp + & diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index ec2aa0e3a7..e3061efb5c 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -260,7 +260,7 @@ contains !> Checks constraints on elasticity parameters subroutine s_check_inputs_elasticity @:PROHIBIT(hyperelasticity .and. hyper_model == dflt_int) - @:PROHIBIT(elasticity .and. fd_order /= 4) + @:PROHIBIT((hypoelasticity .or. hyperelasticity) .and. fd_order /= 4) end subroutine !> Checks constraints on bubble parameters diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index 3ea01ef2d0..f0450f13b6 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -179,7 +179,7 @@ contains & 'wave_speeds', 'avg_state', 'precision', 'bc_x%beg', 'bc_x%end', & & 'bc_y%beg', 'bc_y%end', 'bc_z%beg', 'bc_z%end', 'fd_order', & & 'num_probes', 'num_integrals', 'bubble_model', 'thermal', & - & 'R0_type', 'num_source', 'relax_model', 'num_ibs', 'n_start' ] + & 'R0_type', 'num_source', 'relax_model', 'hyper_model', 'num_ibs', 'n_start' ] call MPI_BCAST(${VAR}$, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) #:endfor @@ -195,7 +195,7 @@ contains & 'bc_z%grcbc_in', 'bc_z%grcbc_out', 'bc_z%grcbc_vel_out', & & 'cfl_adap_dt', 'cfl_const_dt', 'cfl_dt', 'surface_tension', & & 'viscous', 'shear_stress', 'bulk_stress', 'bubbles_lagrange', & - & 'hyperelasticity', 'hyper_model', 'rkck_adap_dt' ] + & 'hyperelasticity', 'rkck_adap_dt' ] call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) #:endfor diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index bbdc378a2c..f3c78215a7 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -169,7 +169,7 @@ contains g_x, g_y, g_z, n_start, t_save, t_stop, & cfl_adap_dt, cfl_const_dt, cfl_target, & viscous, surface_tension, & - hyperelasticity, R0ref, & + hyperelasticity, hyper_model, R0ref, & bubbles_lagrange, lag_params, & rkck_adap_dt, rkck_tolerance diff --git a/toolchain/mfc/run/case_dicts.py b/toolchain/mfc/run/case_dicts.py index d223cbcbda..c695e08385 100644 --- a/toolchain/mfc/run/case_dicts.py +++ b/toolchain/mfc/run/case_dicts.py @@ -244,7 +244,7 @@ def analytic(self): 'low_Mach': ParamType.INT, 'surface_tension': ParamType.LOG, 'viscous': ParamType.LOG, - 'hypermodel': ParamType.INT, + 'hyper_model': ParamType.INT, 'bubbles_lagrange': ParamType.LOG, 'rkck_tolerance': ParamType.REAL, }) From b5f53017a1dc910966574dd85cc2ac993ab0527c Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Mon, 20 Jan 2025 20:26:40 -0500 Subject: [PATCH 365/380] corrected the Oscar mako file --- toolchain/templates/oscar.mako | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/toolchain/templates/oscar.mako b/toolchain/templates/oscar.mako index 158a217cc1..f837553859 100644 --- a/toolchain/templates/oscar.mako +++ b/toolchain/templates/oscar.mako @@ -15,9 +15,8 @@ #SBATCH --account="${account}" % endif % if gpu: -#SBATCH --gpus-per-node=${tasks_per_node} -#SBATCH --mem=64G -#SBATCH --gpu-bind=closest +#SBATCH --gpu-bind=verbose,closest +#SBATCH --gres=gpu:v100-16:${tasks_per_node} % endif #SBATCH --output="${name}.out" #SBATCH --error="${name}.err" @@ -31,7 +30,7 @@ ${helpers.template_prologue()} ok ":) Loading modules:\n" -cd "${MFC_ROOTDIR}" +cd "${MFC_ROOT_DIR}" . ./mfc.sh load -c o -m ${'g' if gpu else 'c'} cd - > /dev/null echo @@ -42,9 +41,8 @@ echo % if not mpi: (set -x; ${profiler} "${target.get_install_binpath(case)}") % else: - (set -x; ${profiler} \ - mpirun -np ${nodes*tasks_per_node} \ - ${' '.join([f"'{x}'" for x in ARG('--') ])} \ + (set -x; ${profiler} \ + mpirun -np ${nodes*tasks_per_node} \ "${target.get_install_binpath(case)}") % endif From db78f42471c35e89f5d36ed8dbfeff05b93dfa4b Mon Sep 17 00:00:00 2001 From: Yanjun Zhang <120074479+ChrisZYJ@users.noreply.github.com> Date: Mon, 20 Jan 2025 21:36:42 -0800 Subject: [PATCH 366/380] change fd_order checker (#5) Co-authored-by: Mauro Rodriguez Jr --- src/simulation/m_checker.fpp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index e3061efb5c..d49bb7fd98 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -260,7 +260,8 @@ contains !> Checks constraints on elasticity parameters subroutine s_check_inputs_elasticity @:PROHIBIT(hyperelasticity .and. hyper_model == dflt_int) - @:PROHIBIT((hypoelasticity .or. hyperelasticity) .and. fd_order /= 4) + @:PROHIBIT((hypoelasticity .or. hyperelasticity) .and. fd_order == dflt_int, & + "fd_order must be set for hypoelasticity or hyperelasticity") end subroutine !> Checks constraints on bubble parameters From 7922dcc1b9f5ed2fb212e8f1d9851170e0dc7024 Mon Sep 17 00:00:00 2001 From: mcarcana Date: Thu, 23 Jan 2025 14:20:07 -0500 Subject: [PATCH 367/380] basic 1D/2D hyperelasticity scheme added --- src/simulation/m_hyperelastic.fpp | 254 +++++++++++++++++++++++++++-- src/simulation/m_rhs.fpp | 2 +- src/simulation/m_time_steppers.fpp | 2 +- 3 files changed, 244 insertions(+), 14 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index d014402574..e926d5b1be 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -94,8 +94,9 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_hyperelastic_rmt_stress_update(q_cons_vf, q_prim_vf) - + subroutine s_hyperelastic_rmt_stress_update(num_dims, q_cons_vf, q_prim_vf) + + integer, intent(in) :: num_dims type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf @@ -106,6 +107,170 @@ contains real(wp) :: G integer :: j, k, l, i, r + if (num_dims == 1) then + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, & + !$acc rho, gamma, pi_inf, qv, G, Re, tensora, tensorb) + do l = 0, p + do k = 0, n + do j = 0, m + !$acc loop seq + do i = 1, num_fluids + alpha_rho_k(i) = q_cons_vf(i)%sf(j, k, l) + alpha_k(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) + end do + ! If in simulation, use acc mixture subroutines + call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv, alpha_k, & + alpha_rho_k, Re, j, k, l, G, Gs) + rho = max(rho, sgm_eps) + G = max(G, sgm_eps) + !if ( G <= verysmall ) G_K = 0d0 + + if ( G > verysmall ) then + !$acc loop seq + do i = 1, tensor_size + tensora(i) = 0d0 + end do + ! STEP 1: computing the grad_xi tensor using finite differences + ! grad_xi definition / organization + ! number for the tensor 1-2: dxix_dxy + !$acc loop seq + do r = -fd_number, fd_number + ! derivatives in the x-direction + tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) + end do + ! STEP 2a: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1) + ! STEP 2b: computing the inverse of the grad_xi tensor + tensorb(1) = 1d0/(tensora(1)**2) + + if (tensorb(tensor_size) > verysmall) then + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes F + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do + ! STEP 3: update the btensor, this is consistent with Riemann solvers + ! \b_xx + btensor%vf(1)%sf(j, k, l) = tensorb(1) + ! store the determinant at the last entry of the btensor + btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) + ! STEP 5a: updating the Cauchy stress primitive scalar field + !if (hyper_model == 1) then + call s_neoHookean_cauchy_solver_1D(btensor%vf, q_prim_vf, G, j, k, l) + !elseif (hyper_model == 2) then + ! call s_Mooney_Rivlin_cauchy_solver_1D(btensor%vf, q_prim_vf, G, j, k, l) + !end if + ! STEP 5b: updating the pressure field + q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & + G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma + ! STEP 5c: updating the Cauchy stress conservative scalar field + !$acc loop seq + do i = 1, b_size - 1 + q_cons_vf(strxb + i - 1)%sf(j, k, l) = rho*q_prim_vf(strxb + i - 1)%sf(j, k, l) + end do + end if + end if + end do + end do + end do + !$acc end parallel loop + + elseif (num_dims == 2) then + + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, & + !$acc rho, gamma, pi_inf, qv, G, Re, tensora, tensorb) + do l = 0, p + do k = 0, n + do j = 0, m + !$acc loop seq + do i = 1, num_fluids + alpha_rho_k(i) = q_cons_vf(i)%sf(j, k, l) + alpha_k(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) + end do + ! If in simulation, use acc mixture subroutines + call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv, alpha_k, & + alpha_rho_k, Re, j, k, l, G, Gs) + rho = max(rho, sgm_eps) + G = max(G, sgm_eps) + !if ( G <= verysmall ) G_K = 0d0 + + if ( G > verysmall ) then + !$acc loop seq + do i = 1, tensor_size + tensora(i) = 0d0 + end do + ! STEP 1: computing the grad_xi tensor using finite differences + ! grad_xi definition / organization + ! number for the tensor 1-2: dxix_dx, dxiy_dx + ! 3-4: dxix_dy, dxiy_dy + !$acc loop seq + do r = -fd_number, fd_number + ! derivatives in the x-direction + tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) + tensora(2) = tensora(2) + q_prim_vf(xibeg + 1)%sf(j + r, k, l)*fd_coeff_x(r, j) + ! derivatives in the y-direction + tensora(3) = tensora(3) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) + tensora(4) = tensora(4) + q_prim_vf(xibeg + 1)%sf(j, k + r, l)*fd_coeff_y(r, k) + end do + !print *, 'j :: ',j,', tensor1 :: ',tensora(1),', tensor2 :: ',tensora(2),', tensora(3) :: ',tensora(3),', tensora(4) :: ',tensora(4) + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = tensora(4) + tensorb(2) = -tensora(3) + tensorb(3) = -tensora(2) + tensorb(4) = tensora(1) + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1)*tensora(4) - tensora(2)*tensora(3) + + if (tensorb(tensor_size) > verysmall) then + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes F + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do + ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) + tensorb(tensor_size) = 1d0/tensorb(tensor_size) + ! STEP 3: override adjoint (tensorb) to be F transpose F + tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensorb(4) = tensora(3)**2 + tensora(4)**2 + tensorb(2) = tensora(1)*tensora(3) + tensora(2)*tensora(4) + tensorb(3) = tensorb(2) !tensora(3)*tensora(1) + tensora(4)*tensora(2) + + ! STEP 4: update the btensor, this is consistent with Riemann solvers + #:for BIJ, TXY in [(1,1),(2,2),(3,4)] + btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) + #:endfor + ! store the determinant at the last entry of the btensor + btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) + ! STEP 5a: updating the Cauchy stress primitive scalar field + !print *,'hyper model :: ',hyper_model + !if (hyper_model == 1) then + call s_neoHookean_cauchy_solver_2D(btensor%vf, q_prim_vf, G, j, k, l) + !elseif (hyper_model == 2) then + ! call s_Mooney_Rivlin_cauchy_solver_2D(btensor%vf, q_prim_vf, G, j, k, l) + !end if + ! print *, 'before j :: ',j,', k :: ',k,', p :: ',q_prim_vf(E_idx)%sf(j,k,l),', val :: ',q_prim_vf(xiend + 1)%sf(j, k, l) + + ! STEP 5b: updating the pressure field + q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & + G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma + + ! print *, 'after j :: ',j,', k :: ',k,', p :: ',q_prim_vf(E_idx)%sf(j,k,l),' val :: ',q_prim_vf(xiend + 1)%sf(j, k, l) + + ! STEP 5c: updating the Cauchy stress conservative scalar field + !$acc loop seq + do i = 1, b_size - 1 + q_cons_vf(strxb + i - 1)%sf(j, k, l) = rho*q_prim_vf(strxb + i - 1)%sf(j, k, l) + end do + end if + end if + end do + end do + end do + !$acc end parallel loop + elseif (num_dims == 3) then + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, & !$acc rho, gamma, pi_inf, qv, G, Re, tensora, tensorb) do l = 0, p - 2 @@ -189,11 +354,11 @@ contains ! store the determinant at the last entry of the btensor btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) ! STEP 5a: updating the Cauchy stress primitive scalar field - if (hyper_model == 1) then - call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) - elseif (hyper_model == 2) then - call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) - end if + !if (hyper_model == 1) then + call s_neoHookean_cauchy_solver_3D(btensor%vf, q_prim_vf, G, j, k, l) + !elseif (hyper_model == 2) then + ! call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) + !end if ! STEP 5b: updating the pressure field q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma @@ -209,17 +374,81 @@ contains end do end do !$acc end parallel loop + end if end subroutine s_hyperelastic_rmt_stress_update - !> The following subroutine handles the calculation of the btensor. - !! The calculation of the btensor takes qprimvf. + !> The following subroutine handles the calculation of the btensor + !! with a neo-Hookean material model. + !! The calculation of the btensor takes qprimvf. !! @param q_prim_vf Primitive variables !! @param btensor is the output !! calculate the grad_xi, grad_xi is a nxn tensor !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) + subroutine s_neoHookean_cauchy_solver_1D(btensor, q_prim_vf, G, j, k, l) + !$acc routine seq + type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(inout) :: btensor + real(wp), intent(in) :: G + integer, intent(in) :: j, k, l + + real(wp) :: trace + real(wp), parameter :: f13 = 1._wp/3._wp + integer :: i + + ! tensor is the symmetric tensor & calculate the trace of the tensor + trace = btensor(1)%sf(j, k, l) + + ! calculate the deviatoric of the tensor + btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace + + ! dividing by the jacobian for neo-Hookean model + ! setting the tensor to the stresses for riemann solver + !$acc loop seq + do i = 1, b_size - 1 + q_prim_vf(strxb + i - 1)%sf(j, k, l) = & + G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + end do + ! compute the invariant without the elastic modulus + q_prim_vf(xiend + 1)%sf(j, k, l) = & + 0.5_wp*(trace - 3.0_wp)/btensor(b_size)%sf(j, k, l) + + end subroutine s_neoHookean_cauchy_solver_1D + + subroutine s_neoHookean_cauchy_solver_2D(btensor, q_prim_vf, G, j, k, l) + !$acc routine seq + type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf + type(scalar_field), dimension(b_size), intent(inout) :: btensor + real(wp), intent(in) :: G + integer, intent(in) :: j, k, l + + real(wp) :: trace + real(wp), parameter :: f13 = 1._wp/3._wp + integer :: i + + ! tensor is the symmetric tensor & calculate the trace of the tensor + trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + + ! calculate the deviatoric of the tensor + btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace + btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace + + ! dividing by the jacobian for neo-Hookean model + ! setting the tensor to the stresses for riemann solver + !$acc loop seq + do i = 1, b_size - 1 + q_prim_vf(strxb + i - 1)%sf(j, k, l) = & + G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + ! print *,'j :: ',j,', val :: ', G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + end do + ! compute the invariant without the elastic modulus + q_prim_vf(xiend + 1)%sf(j, k, l) = & + 0.5_wp*(trace - 3.0_wp)/btensor(b_size)%sf(j, k, l) + + end subroutine s_neoHookean_cauchy_solver_2D + + subroutine s_neoHookean_cauchy_solver_3D(btensor, q_prim_vf, G, j, k, l) !$acc routine seq type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor @@ -249,9 +478,10 @@ contains q_prim_vf(xiend + 1)%sf(j, k, l) = & 0.5_wp*(trace - 3.0_wp)/btensor(b_size)%sf(j, k, l) - end subroutine s_neoHookean_cauchy_solver + end subroutine s_neoHookean_cauchy_solver_3D - !> The following subroutine handles the calculation of the btensor. + !> The following subroutine handles the calculation of the btensor + !! with a Mooney-Rivlin material model. !! The calculation of the btensor takes qprimvf. !! @param q_prim_vf Primitive variables !! @param btensor is the output diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index b00f4a0b06..bce7956e3a 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -667,7 +667,7 @@ contains call nvtxStartRange("RHS-ELASTIC") if (hyperelasticity) then - call s_hyperelastic_rmt_stress_update(q_cons_qp%vf, q_prim_qp%vf) + call s_hyperelastic_rmt_stress_update(num_dims, q_cons_qp%vf, q_prim_qp%vf) call s_populate_variables_buffers(q_prim_qp%vf, pb, mv) end if call nvtxEndRange diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 7206d8f503..19e4ad653f 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -846,7 +846,7 @@ contains if (adv_n) call s_comp_alpha_from_n(q_cons_ts(1)%vf) call nvtxStartRange("RHS-ELASTIC") - if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_ts(1)%vf, q_prim_vf) + if (hyperelasticity) call s_hyperelastic_rmt_stress_update(num_dims, q_cons_ts(1)%vf, q_prim_vf) call nvtxEndRange if (ib) then From 08347163ca94c1a90f4f04bd0123da6ca577252e Mon Sep 17 00:00:00 2001 From: mcarcana Date: Thu, 23 Jan 2025 16:57:43 -0500 Subject: [PATCH 368/380] removed print statements in 2d hyper --- src/simulation/m_hyperelastic.fpp | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index e926d5b1be..5b6ece37cb 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -213,7 +213,6 @@ contains tensora(3) = tensora(3) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) tensora(4) = tensora(4) + q_prim_vf(xibeg + 1)%sf(j, k + r, l)*fd_coeff_y(r, k) end do - !print *, 'j :: ',j,', tensor1 :: ',tensora(1),', tensor2 :: ',tensora(2),', tensora(3) :: ',tensora(3),', tensora(4) :: ',tensora(4) ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse tensorb(1) = tensora(4) tensorb(2) = -tensora(3) @@ -250,14 +249,11 @@ contains !elseif (hyper_model == 2) then ! call s_Mooney_Rivlin_cauchy_solver_2D(btensor%vf, q_prim_vf, G, j, k, l) !end if - ! print *, 'before j :: ',j,', k :: ',k,', p :: ',q_prim_vf(E_idx)%sf(j,k,l),', val :: ',q_prim_vf(xiend + 1)%sf(j, k, l) ! STEP 5b: updating the pressure field q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma - ! print *, 'after j :: ',j,', k :: ',k,', p :: ',q_prim_vf(E_idx)%sf(j,k,l),' val :: ',q_prim_vf(xiend + 1)%sf(j, k, l) - ! STEP 5c: updating the Cauchy stress conservative scalar field !$acc loop seq do i = 1, b_size - 1 From 32141de16b799e19cb270bd57350a557da94707e Mon Sep 17 00:00:00 2001 From: mcarcana Date: Thu, 23 Jan 2025 17:17:07 -0500 Subject: [PATCH 369/380] removed print statements from m_hyperelastic part 2 --- src/simulation/m_hyperelastic.fpp | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 5b6ece37cb..9527e1caec 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -243,7 +243,6 @@ contains ! store the determinant at the last entry of the btensor btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) ! STEP 5a: updating the Cauchy stress primitive scalar field - !print *,'hyper model :: ',hyper_model !if (hyper_model == 1) then call s_neoHookean_cauchy_solver_2D(btensor%vf, q_prim_vf, G, j, k, l) !elseif (hyper_model == 2) then @@ -436,7 +435,6 @@ contains do i = 1, b_size - 1 q_prim_vf(strxb + i - 1)%sf(j, k, l) = & G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) - ! print *,'j :: ',j,', val :: ', G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) end do ! compute the invariant without the elastic modulus q_prim_vf(xiend + 1)%sf(j, k, l) = & From 52ba7d5caab860e45f329f681031cab7db8c8a3c Mon Sep 17 00:00:00 2001 From: mcarcana Date: Thu, 23 Jan 2025 17:20:34 -0500 Subject: [PATCH 370/380] corrected double precision intrinsics in m_hyper --- src/simulation/m_hyperelastic.fpp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 9527e1caec..9bd22f9f5d 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -123,12 +123,12 @@ contains alpha_rho_k, Re, j, k, l, G, Gs) rho = max(rho, sgm_eps) G = max(G, sgm_eps) - !if ( G <= verysmall ) G_K = 0d0 + !if ( G <= verysmall ) G_K = 0_wp if ( G > verysmall ) then !$acc loop seq do i = 1, tensor_size - tensora(i) = 0d0 + tensora(i) = 0_wp end do ! STEP 1: computing the grad_xi tensor using finite differences ! grad_xi definition / organization @@ -193,12 +193,12 @@ contains alpha_rho_k, Re, j, k, l, G, Gs) rho = max(rho, sgm_eps) G = max(G, sgm_eps) - !if ( G <= verysmall ) G_K = 0d0 + !if ( G <= verysmall ) G_K = 0_wp if ( G > verysmall ) then !$acc loop seq do i = 1, tensor_size - tensora(i) = 0d0 + tensora(i) = 0_wp end do ! STEP 1: computing the grad_xi tensor using finite differences ! grad_xi definition / organization From aa9a0072c69ce5be8af2c7469c34e7369d92ad3b Mon Sep 17 00:00:00 2001 From: mcarcana Date: Thu, 23 Jan 2025 17:26:23 -0500 Subject: [PATCH 371/380] corrected double precision intrinsics in m_hyper part 2 --- src/simulation/m_hyperelastic.fpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 9bd22f9f5d..8f6c2de064 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -141,7 +141,7 @@ contains ! STEP 2a: computing the determinant of the grad_xi tensor tensorb(tensor_size) = tensora(1) ! STEP 2b: computing the inverse of the grad_xi tensor - tensorb(1) = 1d0/(tensora(1)**2) + tensorb(1) = 1_wp/(tensora(1)**2) if (tensorb(tensor_size) > verysmall) then ! STEP 2c: computing the inverse of grad_xi tensor = F @@ -229,7 +229,7 @@ contains tensora(i) = tensorb(i)/tensorb(tensor_size) end do ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) - tensorb(tensor_size) = 1d0/tensorb(tensor_size) + tensorb(tensor_size) = 1_wp/tensorb(tensor_size) ! STEP 3: override adjoint (tensorb) to be F transpose F tensorb(1) = tensora(1)**2 + tensora(2)**2 tensorb(4) = tensora(3)**2 + tensora(4)**2 From 20d84ece6405d5986a8e655450d2172bb43661e1 Mon Sep 17 00:00:00 2001 From: mcarcana Date: Thu, 23 Jan 2025 17:34:33 -0500 Subject: [PATCH 372/380] actually corrected double precision intrinsics in m_hyper part 3 --- src/simulation/m_hyperelastic.fpp | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 8f6c2de064..36e651a030 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -123,12 +123,12 @@ contains alpha_rho_k, Re, j, k, l, G, Gs) rho = max(rho, sgm_eps) G = max(G, sgm_eps) - !if ( G <= verysmall ) G_K = 0_wp + !if ( G <= verysmall ) G_K = 0._wp if ( G > verysmall ) then !$acc loop seq do i = 1, tensor_size - tensora(i) = 0_wp + tensora(i) = 0._wp end do ! STEP 1: computing the grad_xi tensor using finite differences ! grad_xi definition / organization @@ -141,7 +141,7 @@ contains ! STEP 2a: computing the determinant of the grad_xi tensor tensorb(tensor_size) = tensora(1) ! STEP 2b: computing the inverse of the grad_xi tensor - tensorb(1) = 1_wp/(tensora(1)**2) + tensorb(1) = 1._wp/(tensora(1)**2) if (tensorb(tensor_size) > verysmall) then ! STEP 2c: computing the inverse of grad_xi tensor = F @@ -193,12 +193,12 @@ contains alpha_rho_k, Re, j, k, l, G, Gs) rho = max(rho, sgm_eps) G = max(G, sgm_eps) - !if ( G <= verysmall ) G_K = 0_wp + !if ( G <= verysmall ) G_K = 0._wp if ( G > verysmall ) then !$acc loop seq do i = 1, tensor_size - tensora(i) = 0_wp + tensora(i) = 0._wp end do ! STEP 1: computing the grad_xi tensor using finite differences ! grad_xi definition / organization @@ -229,7 +229,7 @@ contains tensora(i) = tensorb(i)/tensorb(tensor_size) end do ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) - tensorb(tensor_size) = 1_wp/tensorb(tensor_size) + tensorb(tensor_size) = 1._wp/tensorb(tensor_size) ! STEP 3: override adjoint (tensorb) to be F transpose F tensorb(1) = tensora(1)**2 + tensora(2)**2 tensorb(4) = tensora(3)**2 + tensora(4)**2 @@ -281,12 +281,12 @@ contains alpha_rho_k, Re, j, k, l, G, Gs) rho = max(rho, sgm_eps) G = max(G, sgm_eps) - !if ( G <= verysmall ) G_K = 0_wp + !if ( G <= verysmall ) G_K = 0._wp if (G > verysmall) then !$acc loop seq do i = 1, tensor_size - tensora(i) = 0_wp + tensora(i) = 0._wp end do ! STEP 1: computing the grad_xi tensor using finite differences ! grad_xi definition / organization @@ -333,7 +333,7 @@ contains end do ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) - tensorb(tensor_size) = 1_wp/tensorb(tensor_size) + tensorb(tensor_size) = 1._wp/tensorb(tensor_size) ! STEP 3: computing F transpose F tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 From 9bcf5e25493c420986ceb55b215891eb4536f4aa Mon Sep 17 00:00:00 2001 From: mcarcana Date: Wed, 29 Jan 2025 11:41:25 -0500 Subject: [PATCH 373/380] resolving conflicts in m_hyperelastic --- src/simulation/m_hyperelastic.fpp | 478 ++++++++++------------------- src/simulation/m_rhs.fpp | 2 +- src/simulation/m_time_steppers.fpp | 2 +- 3 files changed, 158 insertions(+), 324 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 2611f7fa9d..ba304004fd 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -94,9 +94,8 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_hyperelastic_rmt_stress_update(num_dims, q_cons_vf, q_prim_vf) - - integer, intent(in) :: num_dims + subroutine s_hyperelastic_rmt_stress_update(q_cons_vf, q_prim_vf) + type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf @@ -107,271 +106,155 @@ contains real(wp) :: G integer :: j, k, l, i, r - if (num_dims == 1) then - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, & - !$acc rho, gamma, pi_inf, qv, G, Re, tensora, tensorb) - do l = 0, p - do k = 0, n - do j = 0, m - !$acc loop seq - do i = 1, num_fluids - alpha_rho_k(i) = q_cons_vf(i)%sf(j, k, l) - alpha_k(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) - end do - ! If in simulation, use acc mixture subroutines - call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv, alpha_k, & - alpha_rho_k, Re, j, k, l, G, Gs) - rho = max(rho, sgm_eps) - G = max(G, sgm_eps) - !if ( G <= verysmall ) G_K = 0._wp - - if ( G > verysmall ) then - !$acc loop seq - do i = 1, tensor_size - tensora(i) = 0._wp - end do - ! STEP 1: computing the grad_xi tensor using finite differences - ! grad_xi definition / organization - ! number for the tensor 1-2: dxix_dxy - !$acc loop seq - do r = -fd_number, fd_number - ! derivatives in the x-direction - tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) - end do - ! STEP 2a: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1) - ! STEP 2b: computing the inverse of the grad_xi tensor - tensorb(1) = 1._wp/(tensora(1)**2) - - if (tensorb(tensor_size) > verysmall) then - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes F - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - ! STEP 3: update the btensor, this is consistent with Riemann solvers - ! \b_xx - btensor%vf(1)%sf(j, k, l) = tensorb(1) - ! store the determinant at the last entry of the btensor - btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) - ! STEP 5a: updating the Cauchy stress primitive scalar field - !if (hyper_model == 1) then - call s_neoHookean_cauchy_solver_1D(btensor%vf, q_prim_vf, G, j, k, l) - !elseif (hyper_model == 2) then - ! call s_Mooney_Rivlin_cauchy_solver_1D(btensor%vf, q_prim_vf, G, j, k, l) - !end if - ! STEP 5b: updating the pressure field - q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & - G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma - ! STEP 5c: updating the Cauchy stress conservative scalar field - !$acc loop seq - do i = 1, b_size - 1 - q_cons_vf(strxb + i - 1)%sf(j, k, l) = rho*q_prim_vf(strxb + i - 1)%sf(j, k, l) - end do - end if - end if - end do - end do - end do - !$acc end parallel loop - - elseif (num_dims == 2) then - - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, & - !$acc rho, gamma, pi_inf, qv, G, Re, tensora, tensorb) - do l = 0, p - do k = 0, n - do j = 0, m - !$acc loop seq - do i = 1, num_fluids - alpha_rho_k(i) = q_cons_vf(i)%sf(j, k, l) - alpha_k(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) - end do - ! If in simulation, use acc mixture subroutines - call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv, alpha_k, & - alpha_rho_k, Re, j, k, l, G, Gs) + !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, & + !$acc rho, gamma, pi_inf, qv, G, Re, tensora, tensorb) + do l = 0, p + do k = 0, n + do j = 0, m + !$acc loop seq + do i = 1, num_fluids + alpha_rho_k(i) = q_cons_vf(i)%sf(j, k, l) + alpha_k(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) + end do + + ! If in simulation, use acc mixture subroutines + call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv, alpha_k, & + alpha_rho_k, Re, j, k, l, G, Gs) rho = max(rho, sgm_eps) G = max(G, sgm_eps) !if ( G <= verysmall ) G_K = 0._wp - if ( G > verysmall ) then - !$acc loop seq - do i = 1, tensor_size - tensora(i) = 0._wp - end do - ! STEP 1: computing the grad_xi tensor using finite differences - ! grad_xi definition / organization - ! number for the tensor 1-2: dxix_dx, dxiy_dx - ! 3-4: dxix_dy, dxiy_dy - !$acc loop seq - do r = -fd_number, fd_number - ! derivatives in the x-direction - tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) - tensora(2) = tensora(2) + q_prim_vf(xibeg + 1)%sf(j + r, k, l)*fd_coeff_x(r, j) - ! derivatives in the y-direction - tensora(3) = tensora(3) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) - tensora(4) = tensora(4) + q_prim_vf(xibeg + 1)%sf(j, k + r, l)*fd_coeff_y(r, k) - end do - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = tensora(4) - tensorb(2) = -tensora(3) - tensorb(3) = -tensora(2) - tensorb(4) = tensora(1) - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*tensora(4) - tensora(2)*tensora(3) - - if (tensorb(tensor_size) > verysmall) then - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes F - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) - tensorb(tensor_size) = 1._wp/tensorb(tensor_size) - ! STEP 3: override adjoint (tensorb) to be F transpose F - tensorb(1) = tensora(1)**2 + tensora(2)**2 - tensorb(4) = tensora(3)**2 + tensora(4)**2 - tensorb(2) = tensora(1)*tensora(3) + tensora(2)*tensora(4) - tensorb(3) = tensorb(2) !tensora(3)*tensora(1) + tensora(4)*tensora(2) - - ! STEP 4: update the btensor, this is consistent with Riemann solvers - #:for BIJ, TXY in [(1,1),(2,2),(3,4)] - btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) - #:endfor - ! store the determinant at the last entry of the btensor - btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) - ! STEP 5a: updating the Cauchy stress primitive scalar field - !if (hyper_model == 1) then - call s_neoHookean_cauchy_solver_2D(btensor%vf, q_prim_vf, G, j, k, l) - !elseif (hyper_model == 2) then - ! call s_Mooney_Rivlin_cauchy_solver_2D(btensor%vf, q_prim_vf, G, j, k, l) - !end if - - ! STEP 5b: updating the pressure field - q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & - G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma - - ! STEP 5c: updating the Cauchy stress conservative scalar field - !$acc loop seq - do i = 1, b_size - 1 - q_cons_vf(strxb + i - 1)%sf(j, k, l) = rho*q_prim_vf(strxb + i - 1)%sf(j, k, l) - end do - end if - end if - end do - end do - end do - !$acc end parallel loop - elseif (num_dims == 3) then - - !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, & - !$acc rho, gamma, pi_inf, qv, G, Re, tensora, tensorb) - do l = 0, p - 2 - do k = 0, n - 2 - do j = 2, m - 2 - !$acc loop seq - do i = 1, num_fluids - alpha_rho_k(i) = q_cons_vf(i)%sf(j, k, l) - alpha_k(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) - end do - ! If in simulation, use acc mixture subroutines - call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv, alpha_k, & - alpha_rho_k, Re, j, k, l, G, Gs) - rho = max(rho, sgm_eps) - G = max(G, sgm_eps) - !if ( G <= verysmall ) G_K = 0._wp - - if (G > verysmall) then - !$acc loop seq - do i = 1, tensor_size - tensora(i) = 0._wp - end do - - ! Step 1: computing the grad_xi tensor using finite differences - ! grad_xi definition / organization - ! number for the tensor 1-3: dxix_dx, dxiy_dx, dxiz_dx - ! 4-6 : dxix_dy, dxiy_dy, dxiz_dy - ! 7-9 : dxix_dz, dxiy_dz, dxiz_dz - !$acc loop seq - do r = -fd_number, fd_number - ! derivatives in the x-direction - tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) - tensora(2) = tensora(2) + q_prim_vf(xibeg + 1)%sf(j + r, k, l)*fd_coeff_x(r, j) - tensora(3) = tensora(3) + q_prim_vf(xiend)%sf(j + r, k, l)*fd_coeff_x(r, j) - ! derivatives in the y-direction - tensora(4) = tensora(4) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) - tensora(5) = tensora(5) + q_prim_vf(xibeg + 1)%sf(j, k + r, l)*fd_coeff_y(r, k) - tensora(6) = tensora(6) + q_prim_vf(xiend)%sf(j, k + r, l)*fd_coeff_y(r, k) - ! derivatives in the z-direction - tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_z(r, l) - tensora(8) = tensora(8) + q_prim_vf(xibeg + 1)%sf(j, k, l + r)*fd_coeff_z(r, l) - tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_z(r, l) - end do - ! Step 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) - tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) - tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) - tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) - tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) - tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) - tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) - tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) - tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) - - ! Step 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & - + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - - if (tensorb(tensor_size) > verysmall) then - ! Step 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes F + if (G > verysmall) then !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) + do i = 1, tensor_size + tensora(i) = 0._wp end do - ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) - tensorb(tensor_size) = 1._wp/tensorb(tensor_size) - - ! Step 3: computing F transpose F - tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 - tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 - tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) - tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) - tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) - ! Step 4: update the btensor, this is consistent with Riemann solvers - #:for BIJ, TXY in [(1,1),(2,2),(3,5),(4,3),(5,6),(6,9)] - btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) - #:endfor - ! store the determinant at the last entry of the btensor - btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) - - ! Step 5a: updating the Cauchy stress primitive scalar field - if (hyper_model == 1) then - call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) - elseif (hyper_model == 2) then - call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) - end if - ! Step 5b: updating the pressure field - q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & - G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma - ! Step 5c: updating the Cauchy stress conservative scalar field + ! STEP 1: computing the grad_xi tensor using finite differences + ! grad_xi definition / organization + ! tensora(1,2,3): dxix_dx, dxiy_dx, dxiz_dx + ! tensora(4,5,6): dxix_dy, dxiy_dy, dxiz_dy + ! tensora(7,8,9): dxix_dz, dxiy_dz, dxiz_dz !$acc loop seq - do i = 1, b_size - 1 - q_cons_vf(strxb + i - 1)%sf(j, k, l) = & - rho*q_prim_vf(strxb + i - 1)%sf(j, k, l) + do r = -fd_number, fd_number + ! derivatives in the x-direction + tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) + if (n > 0) then + ! derivatives in the x-direction + tensora(2) = tensora(2) + q_prim_vf(xibeg + 1)%sf(j + r, k, l)*fd_coeff_x(r, j) + ! derivatives in the y-direction + tensora(3) = tensora(3) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) + tensora(4) = tensora(4) + q_prim_vf(xibeg + 1)%sf(j, k + r, l)*fd_coeff_y(r, k) + end if + if (p > 0) then + ! derivatives in the x-direction + tensora(2) = tensora(2) + q_prim_vf(xibeg + 1)%sf(j + r, k, l)*fd_coeff_x(r, j) + tensora(3) = tensora(3) + q_prim_vf(xiend)%sf(j + r, k, l)*fd_coeff_x(r, j) + ! derivatives in the y-direction + tensora(4) = tensora(4) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) + tensora(5) = tensora(5) + q_prim_vf(xibeg + 1)%sf(j, k + r, l)*fd_coeff_y(r, k) + tensora(6) = tensora(6) + q_prim_vf(xiend)%sf(j, k + r, l)*fd_coeff_y(r, k) + ! derivatives in the z-direction + tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_z(r, l) + tensora(8) = tensora(8) + q_prim_vf(xibeg + 1)%sf(j, k, l + r)*fd_coeff_z(r, l) + tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_z(r, l) + end if end do + + ! STEP 2a: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1) + ! STEP 2b: computing the inverse of the grad_xi tensor + tensorb(1) = 1._wp/(tensora(1)**2) + if (n > 0) then + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = tensora(4) + tensorb(2) = -tensora(3) + tensorb(3) = -tensora(2) + tensorb(4) = tensora(1) + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1)*tensora(4) - tensora(2)*tensora(3) + end if + if (p > 0) then + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) + tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) + tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) + tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) + tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) + tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) + tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) + tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) + tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + end if + + if (tensorb(tensor_size) > verysmall) then + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes F + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do + + ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) + tensorb(tensor_size) = 1._wp/tensorb(tensor_size) + ! STEP 3: update the btensor, this is consistent with Riemann solvers + ! \b_xx + btensor%vf(1)%sf(j, k, l) = tensorb(1) + if (n > 0) then + ! STEP 2e: override adjoint (tensorb) to be F transpose F + tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensorb(4) = tensora(3)**2 + tensora(4)**2 + tensorb(2) = tensora(1)*tensora(3) + tensora(2)*tensora(4) + tensorb(3) = tensorb(2) !tensora(3)*tensora(1) + tensora(4)*tensora(2) + ! STEP 3: update the btensor, this is consistent with Riemann solvers + #:for BIJ, TXY in [(1,1),(2,2),(3,4)] + btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) + #:endfor + end if + if (p > 0) then + ! STEP 2e: computing F transpose F + tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 + tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 + tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) + tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) + tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) + ! STEP 3a: update the btensor, this is consistent with Riemann solvers + #:for BIJ, TXY in [(1,1),(2,2),(3,5),(4,3),(5,6),(6,9)] + btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) + #:endfor + end if + + !STEP 3b: store the determinant at the last entry of the btensor + btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) + + ! STEP 4a: updating the Cauchy stress primitive scalar field + if (hyper_model == 1) then + call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) + elseif (hyper_model == 2) then + call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) + end if + + ! STEP 4b: updating the pressure field + q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & + G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma + + ! STEP 4c: updating the Cauchy stress conservative scalar field + !$acc loop seq + do i = 1, b_size - 1 + q_cons_vf(strxb + i - 1)%sf(j, k, l) = rho*q_prim_vf(strxb + i - 1)%sf(j, k, l) + end do + end if end if - end if + end do end do end do - end do - !$acc end parallel loop - end if + !$acc end parallel loop + end subroutine s_hyperelastic_rmt_stress_update !> The following subroutine handles the calculation of the btensor @@ -383,7 +266,7 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_neoHookean_cauchy_solver_1D(btensor, q_prim_vf, G, j, k, l) + subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) !$acc routine seq type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor @@ -396,75 +279,26 @@ contains ! tensor is the symmetric tensor & calculate the trace of the tensor trace = btensor(1)%sf(j, k, l) - - ! calculate the deviatoric of the tensor - btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace - - ! dividing by the jacobian for neo-Hookean model - ! setting the tensor to the stresses for riemann solver - !$acc loop seq - do i = 1, b_size - 1 - q_prim_vf(strxb + i - 1)%sf(j, k, l) = & - G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) - end do - ! compute the invariant without the elastic modulus - q_prim_vf(xiend + 1)%sf(j, k, l) = & - 0.5_wp*(trace - 3.0_wp)/btensor(b_size)%sf(j, k, l) - - end subroutine s_neoHookean_cauchy_solver_1D - - subroutine s_neoHookean_cauchy_solver_2D(btensor, q_prim_vf, G, j, k, l) - !$acc routine seq - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(inout) :: btensor - real(wp), intent(in) :: G - integer, intent(in) :: j, k, l - - real(wp) :: trace - real(wp), parameter :: f13 = 1._wp/3._wp - integer :: i - - ! tensor is the symmetric tensor & calculate the trace of the tensor - trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) - ! calculate the deviatoric of the tensor btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace - btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace - - ! dividing by the jacobian for neo-Hookean model - ! setting the tensor to the stresses for riemann solver - !$acc loop seq - do i = 1, b_size - 1 - q_prim_vf(strxb + i - 1)%sf(j, k, l) = & - G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) - end do - ! compute the invariant without the elastic modulus - q_prim_vf(xiend + 1)%sf(j, k, l) = & - 0.5_wp*(trace - 3.0_wp)/btensor(b_size)%sf(j, k, l) - - end subroutine s_neoHookean_cauchy_solver_2D - - subroutine s_neoHookean_cauchy_solver_3D(btensor, q_prim_vf, G, j, k, l) - !$acc routine seq - type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf - type(scalar_field), dimension(b_size), intent(inout) :: btensor - real(wp), intent(in) :: G - integer, intent(in) :: j, k, l - - real(wp) :: trace - real(wp), parameter :: f13 = 1._wp/3._wp - integer :: i - - ! tensor is the symmetric tensor & calculate the trace of the tensor - trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) + if (n > 0) then + ! tensor is the symmetric tensor & calculate the trace of the tensor + trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + ! calculate the deviatoric of the tensor + btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace + btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace + end if + if (p > 0) then + ! tensor is the symmetric tensor & calculate the trace of the tensor + trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) + ! calculate the deviatoric of the tensor + #:for IJ in [1,3,6] + btensor(${IJ}$)%sf(j, k, l) = btensor(${IJ}$)%sf(j, k, l) - f13*trace + #:endfor + end if - ! calculate the deviatoric of the tensor - #:for IJ in [1,3,6] - btensor(${IJ}$)%sf(j, k, l) = btensor(${IJ}$)%sf(j, k, l) - f13*trace - #:endfor ! dividing by the jacobian for neo-Hookean model ! setting the tensor to the stresses for riemann solver - !$acc loop seq do i = 1, b_size - 1 q_prim_vf(strxb + i - 1)%sf(j, k, l) = & @@ -474,7 +308,7 @@ contains q_prim_vf(xiend + 1)%sf(j, k, l) = & 0.5_wp*(trace - 3.0_wp)/btensor(b_size)%sf(j, k, l) - end subroutine s_neoHookean_cauchy_solver_3D + end subroutine s_neoHookean_cauchy_solver !> The following subroutine handles the calculation of the btensor !! with a Mooney-Rivlin material model. diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index bce7956e3a..b00f4a0b06 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -667,7 +667,7 @@ contains call nvtxStartRange("RHS-ELASTIC") if (hyperelasticity) then - call s_hyperelastic_rmt_stress_update(num_dims, q_cons_qp%vf, q_prim_qp%vf) + call s_hyperelastic_rmt_stress_update(q_cons_qp%vf, q_prim_qp%vf) call s_populate_variables_buffers(q_prim_qp%vf, pb, mv) end if call nvtxEndRange diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 8c71f2474a..40d907e955 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -846,7 +846,7 @@ contains if (adv_n) call s_comp_alpha_from_n(q_cons_ts(1)%vf) call nvtxStartRange("RHS-ELASTIC") - if (hyperelasticity) call s_hyperelastic_rmt_stress_update(num_dims, q_cons_ts(1)%vf, q_prim_vf) + if (hyperelasticity) call s_hyperelastic_rmt_stress_update(q_cons_ts(1)%vf, q_prim_vf) call nvtxEndRange if (ib) then From be859c5f4f87f8e9cae07f399e49412d1d68feda Mon Sep 17 00:00:00 2001 From: mcarcana Date: Wed, 29 Jan 2025 11:49:04 -0500 Subject: [PATCH 374/380] returning an accidental deletion from conflict resolution --- src/simulation/m_hyperelastic.fpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index ba304004fd..d0f5630eb6 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -126,8 +126,8 @@ contains if (G > verysmall) then !$acc loop seq - do i = 1, tensor_size - tensora(i) = 0._wp + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) end do ! STEP 1: computing the grad_xi tensor using finite differences From 0dca297b488d760c6f699b472c6f9400258aa513 Mon Sep 17 00:00:00 2001 From: Mauro Rodriguez Date: Wed, 29 Jan 2025 17:10:57 -0500 Subject: [PATCH 375/380] further cleaning to the code --- src/simulation/m_hyperelastic.fpp | 294 +++++++++++++++--------------- 1 file changed, 147 insertions(+), 147 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index d0f5630eb6..c005feeb78 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -108,152 +108,152 @@ contains !$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, & !$acc rho, gamma, pi_inf, qv, G, Re, tensora, tensorb) - do l = 0, p + do l = 0, p do k = 0, n - do j = 0, m - !$acc loop seq - do i = 1, num_fluids - alpha_rho_k(i) = q_cons_vf(i)%sf(j, k, l) - alpha_k(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) - end do - - ! If in simulation, use acc mixture subroutines - call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv, alpha_k, & - alpha_rho_k, Re, j, k, l, G, Gs) - rho = max(rho, sgm_eps) - G = max(G, sgm_eps) - !if ( G <= verysmall ) G_K = 0._wp - - if (G > verysmall) then + do j = 0, m + !$acc loop seq + do i = 1, num_fluids + alpha_rho_k(i) = q_cons_vf(i)%sf(j, k, l) + alpha_k(i) = q_cons_vf(advxb + i - 1)%sf(j, k, l) + end do + + ! If in simulation, use acc mixture subroutines + call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv, alpha_k, & + alpha_rho_k, Re, j, k, l, G, Gs) + rho = max(rho, sgm_eps) + G = max(G, sgm_eps) + !if ( G <= verysmall ) G_K = 0._wp + + if (G > verysmall) then + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensorb(tensor_size) + end do + + ! STEP 1: computing the grad_xi tensor using finite differences + ! grad_xi definition / organization + ! tensora(1,2,3): dxix_dx, dxiy_dx, dxiz_dx + ! tensora(4,5,6): dxix_dy, dxiy_dy, dxiz_dy + ! tensora(7,8,9): dxix_dz, dxiy_dz, dxiz_dz + !$acc loop seq + do r = -fd_number, fd_number + ! derivatives in the x-direction + tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) + if (n > 0) then + ! derivatives in the x-direction + tensora(2) = tensora(2) + q_prim_vf(xibeg + 1)%sf(j + r, k, l)*fd_coeff_x(r, j) + ! derivatives in the y-direction + tensora(3) = tensora(3) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) + tensora(4) = tensora(4) + q_prim_vf(xibeg + 1)%sf(j, k + r, l)*fd_coeff_y(r, k) + end if + if (p > 0) then + ! derivatives in the x-direction + tensora(2) = tensora(2) + q_prim_vf(xibeg + 1)%sf(j + r, k, l)*fd_coeff_x(r, j) + tensora(3) = tensora(3) + q_prim_vf(xiend)%sf(j + r, k, l)*fd_coeff_x(r, j) + ! derivatives in the y-direction + tensora(4) = tensora(4) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) + tensora(5) = tensora(5) + q_prim_vf(xibeg + 1)%sf(j, k + r, l)*fd_coeff_y(r, k) + tensora(6) = tensora(6) + q_prim_vf(xiend)%sf(j, k + r, l)*fd_coeff_y(r, k) + ! derivatives in the z-direction + tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_z(r, l) + tensora(8) = tensora(8) + q_prim_vf(xibeg + 1)%sf(j, k, l + r)*fd_coeff_z(r, l) + tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_z(r, l) + end if + end do + + ! STEP 2a: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1) + ! STEP 2b: computing the inverse of the grad_xi tensor + tensorb(1) = 1._wp/(tensora(1)**2) + if (n > 0) then + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = tensora(4) + tensorb(2) = -tensora(3) + tensorb(3) = -tensora(2) + tensorb(4) = tensora(1) + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1)*tensora(4) - tensora(2)*tensora(3) + end if + if (p > 0) then + ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) + tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) + tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) + tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) + tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) + tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) + tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) + tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) + tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) + ! STEP 2b: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + end if + + if (tensorb(tensor_size) > verysmall) then + ! STEP 2c: computing the inverse of grad_xi tensor = F + ! tensorb is the adjoint, tensora becomes F !$acc loop seq do i = 1, tensor_size - 1 tensora(i) = tensorb(i)/tensorb(tensor_size) end do - ! STEP 1: computing the grad_xi tensor using finite differences - ! grad_xi definition / organization - ! tensora(1,2,3): dxix_dx, dxiy_dx, dxiz_dx - ! tensora(4,5,6): dxix_dy, dxiy_dy, dxiz_dy - ! tensora(7,8,9): dxix_dz, dxiy_dz, dxiz_dz - !$acc loop seq - do r = -fd_number, fd_number - ! derivatives in the x-direction - tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) - if (n > 0) then - ! derivatives in the x-direction - tensora(2) = tensora(2) + q_prim_vf(xibeg + 1)%sf(j + r, k, l)*fd_coeff_x(r, j) - ! derivatives in the y-direction - tensora(3) = tensora(3) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) - tensora(4) = tensora(4) + q_prim_vf(xibeg + 1)%sf(j, k + r, l)*fd_coeff_y(r, k) - end if - if (p > 0) then - ! derivatives in the x-direction - tensora(2) = tensora(2) + q_prim_vf(xibeg + 1)%sf(j + r, k, l)*fd_coeff_x(r, j) - tensora(3) = tensora(3) + q_prim_vf(xiend)%sf(j + r, k, l)*fd_coeff_x(r, j) - ! derivatives in the y-direction - tensora(4) = tensora(4) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) - tensora(5) = tensora(5) + q_prim_vf(xibeg + 1)%sf(j, k + r, l)*fd_coeff_y(r, k) - tensora(6) = tensora(6) + q_prim_vf(xiend)%sf(j, k + r, l)*fd_coeff_y(r, k) - ! derivatives in the z-direction - tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_z(r, l) - tensora(8) = tensora(8) + q_prim_vf(xibeg + 1)%sf(j, k, l + r)*fd_coeff_z(r, l) - tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_z(r, l) - end if - end do - - ! STEP 2a: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1) - ! STEP 2b: computing the inverse of the grad_xi tensor - tensorb(1) = 1._wp/(tensora(1)**2) + ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) + tensorb(tensor_size) = 1._wp/tensorb(tensor_size) + ! STEP 3: update the btensor, this is consistent with Riemann solvers + ! \b_xx + btensor%vf(1)%sf(j, k, l) = tensorb(1) if (n > 0) then - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = tensora(4) - tensorb(2) = -tensora(3) - tensorb(3) = -tensora(2) - tensorb(4) = tensora(1) - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*tensora(4) - tensora(2)*tensora(3) + ! STEP 2e: override adjoint (tensorb) to be F transpose F + tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensorb(4) = tensora(3)**2 + tensora(4)**2 + tensorb(2) = tensora(1)*tensora(3) + tensora(2)*tensora(4) + tensorb(3) = tensorb(2) !tensora(3)*tensora(1) + tensora(4)*tensora(2) + ! STEP 3: update the btensor, this is consistent with Riemann solvers + #:for BIJ, TXY in [(1,1),(2,2),(3,4)] + btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) + #:endfor end if if (p > 0) then - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse - tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) - tensorb(2) = -(tensora(2)*tensora(9) - tensora(3)*tensora(8)) - tensorb(3) = tensora(2)*tensora(6) - tensora(3)*tensora(5) - tensorb(4) = -(tensora(4)*tensora(9) - tensora(6)*tensora(7)) - tensorb(5) = tensora(1)*tensora(9) - tensora(3)*tensora(7) - tensorb(6) = -(tensora(1)*tensora(6) - tensora(4)*tensora(3)) - tensorb(7) = tensora(4)*tensora(8) - tensora(5)*tensora(7) - tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) - tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) - ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & - + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) - end if - - if (tensorb(tensor_size) > verysmall) then - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes F - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - - ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) - tensorb(tensor_size) = 1._wp/tensorb(tensor_size) - ! STEP 3: update the btensor, this is consistent with Riemann solvers - ! \b_xx - btensor%vf(1)%sf(j, k, l) = tensorb(1) - if (n > 0) then - ! STEP 2e: override adjoint (tensorb) to be F transpose F - tensorb(1) = tensora(1)**2 + tensora(2)**2 - tensorb(4) = tensora(3)**2 + tensora(4)**2 - tensorb(2) = tensora(1)*tensora(3) + tensora(2)*tensora(4) - tensorb(3) = tensorb(2) !tensora(3)*tensora(1) + tensora(4)*tensora(2) - ! STEP 3: update the btensor, this is consistent with Riemann solvers - #:for BIJ, TXY in [(1,1),(2,2),(3,4)] - btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) - #:endfor - end if - if (p > 0) then - ! STEP 2e: computing F transpose F - tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 - tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 - tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) - tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) - tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) - ! STEP 3a: update the btensor, this is consistent with Riemann solvers - #:for BIJ, TXY in [(1,1),(2,2),(3,5),(4,3),(5,6),(6,9)] - btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) - #:endfor - end if - - !STEP 3b: store the determinant at the last entry of the btensor - btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) - - ! STEP 4a: updating the Cauchy stress primitive scalar field - if (hyper_model == 1) then - call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) - elseif (hyper_model == 2) then - call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) - end if - - ! STEP 4b: updating the pressure field - q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & - G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma - - ! STEP 4c: updating the Cauchy stress conservative scalar field - !$acc loop seq - do i = 1, b_size - 1 - q_cons_vf(strxb + i - 1)%sf(j, k, l) = rho*q_prim_vf(strxb + i - 1)%sf(j, k, l) - end do + ! STEP 2e: computing F transpose F + tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 + tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 + tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) + tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) + tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) + ! STEP 3a: update the btensor, this is consistent with Riemann solvers + #:for BIJ, TXY in [(1,1),(2,2),(3,5),(4,3),(5,6),(6,9)] + btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) + #:endfor end if + + !STEP 3b: store the determinant at the last entry of the btensor + btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) + + ! STEP 4a: updating the Cauchy stress primitive scalar field + if (hyper_model == 1) then + call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) + elseif (hyper_model == 2) then + call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) + end if + + ! STEP 4b: updating the pressure field + q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & + G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma + + ! STEP 4c: updating the Cauchy stress conservative scalar field + !$acc loop seq + do i = 1, b_size - 1 + q_cons_vf(strxb + i - 1)%sf(j, k, l) = rho*q_prim_vf(strxb + i - 1)%sf(j, k, l) + end do end if - end do + end if end do end do - !$acc end parallel loop + end do + !$acc end parallel loop end subroutine s_hyperelastic_rmt_stress_update @@ -282,20 +282,20 @@ contains ! calculate the deviatoric of the tensor btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace if (n > 0) then - ! tensor is the symmetric tensor & calculate the trace of the tensor - trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) - ! calculate the deviatoric of the tensor - btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace - btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace - end if - if (p > 0) then - ! tensor is the symmetric tensor & calculate the trace of the tensor - trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) - ! calculate the deviatoric of the tensor - #:for IJ in [1,3,6] - btensor(${IJ}$)%sf(j, k, l) = btensor(${IJ}$)%sf(j, k, l) - f13*trace - #:endfor - end if + ! tensor is the symmetric tensor & calculate the trace of the tensor + trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + ! calculate the deviatoric of the tensor + btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace + btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace + end if + if (p > 0) then + ! tensor is the symmetric tensor & calculate the trace of the tensor + trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) + ! calculate the deviatoric of the tensor + #:for IJ in [1,3,6] + btensor(${IJ}$)%sf(j, k, l) = btensor(${IJ}$)%sf(j, k, l) - f13*trace + #:endfor + end if ! dividing by the jacobian for neo-Hookean model ! setting the tensor to the stresses for riemann solver From d9d6f8a6d8bd5759da9267146851ad308d57c2de Mon Sep 17 00:00:00 2001 From: mcarcana Date: Fri, 31 Jan 2025 15:52:21 -0500 Subject: [PATCH 376/380] 1D btensor algorithm corrected --- src/simulation/m_hyperelastic.fpp | 13 ++----------- 1 file changed, 2 insertions(+), 11 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index c005feeb78..190b7cf420 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -164,7 +164,7 @@ contains ! STEP 2a: computing the determinant of the grad_xi tensor tensorb(tensor_size) = tensora(1) ! STEP 2b: computing the inverse of the grad_xi tensor - tensorb(1) = 1._wp/(tensora(1)**2) + tensorb(1) = 1._wp/tensora(1) if (n > 0) then ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse tensorb(1) = tensora(4) @@ -192,18 +192,9 @@ contains end if if (tensorb(tensor_size) > verysmall) then - ! STEP 2c: computing the inverse of grad_xi tensor = F - ! tensorb is the adjoint, tensora becomes F - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - - ! STEP 2d: computing the J = det(F) = 1/det(\grad{\xi}) - tensorb(tensor_size) = 1._wp/tensorb(tensor_size) ! STEP 3: update the btensor, this is consistent with Riemann solvers ! \b_xx - btensor%vf(1)%sf(j, k, l) = tensorb(1) + btensor%vf(1)%sf(j, k, l) = tensorb(1)**2 if (n > 0) then ! STEP 2e: override adjoint (tensorb) to be F transpose F tensorb(1) = tensora(1)**2 + tensora(2)**2 From b6cf35d0fc27279682ea96b8ec2f184115002fa9 Mon Sep 17 00:00:00 2001 From: mcarcana Date: Fri, 31 Jan 2025 17:09:10 -0500 Subject: [PATCH 377/380] cleaning 2d hyper --- src/simulation/m_hyperelastic.fpp | 57 +++++++++++++++++++------------ 1 file changed, 35 insertions(+), 22 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 190b7cf420..895bbfb29b 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -130,8 +130,9 @@ contains tensora(i) = tensorb(i)/tensorb(tensor_size) end do - ! STEP 1: computing the grad_xi tensor using finite differences - ! grad_xi definition / organization + ! STEP 1: computing grad_xi (tensora) using finite differences + ! tensora(1,2): dxix_x, dxiy_x + ! tensora(3,4): dxix_dy, dxiy_dy ! tensora(1,2,3): dxix_dx, dxiy_dx, dxiz_dx ! tensora(4,5,6): dxix_dy, dxiy_dy, dxiz_dy ! tensora(7,8,9): dxix_dz, dxiy_dz, dxiz_dz @@ -166,13 +167,13 @@ contains ! STEP 2b: computing the inverse of the grad_xi tensor tensorb(1) = 1._wp/tensora(1) if (n > 0) then - ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse + ! STEP 2a: computing the cofactor (tensorb) of the grad_xi tensor for the inverse tensorb(1) = tensora(4) - tensorb(2) = -tensora(3) - tensorb(3) = -tensora(2) + tensorb(2) = -tensora(2) + tensorb(3) = -tensora(3) tensorb(4) = tensora(1) ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*tensora(4) - tensora(2)*tensora(3) + tensora(tensor_size) = tensora(1)*tensora(4) - tensora(3)*tensora(2) end if if (p > 0) then ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse @@ -186,27 +187,41 @@ contains tensorb(8) = -(tensora(1)*tensora(8) - tensora(2)*tensora(7)) tensorb(9) = tensora(1)*tensora(5) - tensora(2)*tensora(4) ! STEP 2b: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & + tensora(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) end if - if (tensorb(tensor_size) > verysmall) then + if (tensora(tensor_size) > verysmall) then ! STEP 3: update the btensor, this is consistent with Riemann solvers ! \b_xx btensor%vf(1)%sf(j, k, l) = tensorb(1)**2 - if (n > 0) then - ! STEP 2e: override adjoint (tensorb) to be F transpose F - tensorb(1) = tensora(1)**2 + tensora(2)**2 - tensorb(4) = tensora(3)**2 + tensora(4)**2 - tensorb(2) = tensora(1)*tensora(3) + tensora(2)*tensora(4) - tensorb(3) = tensorb(2) !tensora(3)*tensora(1) + tensora(4)*tensora(2) - ! STEP 3: update the btensor, this is consistent with Riemann solvers - #:for BIJ, TXY in [(1,1),(2,2),(3,4)] - btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) - #:endfor + if (n > 0) then + ! STEP 2c: computing the inverse of grad_xi tensor = F (tensora) + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensora(tensor_size) + end do + ! STEP 2d: computing J = det(F) + tensorb(tensor_size) = 1._wp/tensora(tensor_size) + ! STEP 2e: override adjoint (tensorb) to be F transpose F + tensorb(1) = tensora(4)**2 + tensora(3)**2 + tensorb(4) = tensora(2)**2 + tensora(1)**2 + tensorb(2) = -tensora(2)*tensora(4) + tensora(1)*-tensora(3) + tensorb(3) = tensorb(2) + ! STEP 3: update the btensor, this is consistent with Riemann solvers + #:for BIJ, TXY in [(1,1),(2,2),(3,4)] + btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) + #:endfor end if if (p > 0) then + ! STEP 2c: computing the inverse of grad_xi tensor = F (tensora) + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensora(tensor_size) + end do + ! STEP 2d: computing J = det(F) + tensorb(tensor_size) = 1._wp/tensora(tensor_size) ! STEP 2e: computing F transpose F tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 @@ -268,10 +283,8 @@ contains real(wp), parameter :: f13 = 1._wp/3._wp integer :: i - ! tensor is the symmetric tensor & calculate the trace of the tensor - trace = btensor(1)%sf(j, k, l) ! calculate the deviatoric of the tensor - btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace + btensor(1)%sf(j, k, l) = 2._wp*btensor(1)%sf(j, k, l)/3._wp if (n > 0) then ! tensor is the symmetric tensor & calculate the trace of the tensor trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) @@ -293,7 +306,7 @@ contains !$acc loop seq do i = 1, b_size - 1 q_prim_vf(strxb + i - 1)%sf(j, k, l) = & - G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) end do ! compute the invariant without the elastic modulus q_prim_vf(xiend + 1)%sf(j, k, l) = & From 4ee8d32c503ee0156f41ea9074864a148c2d19dd Mon Sep 17 00:00:00 2001 From: mcarcana Date: Fri, 31 Jan 2025 17:23:49 -0500 Subject: [PATCH 378/380] addressing warning when building m_hyperelastic --- src/simulation/m_hyperelastic.fpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 895bbfb29b..089569feb6 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -207,7 +207,7 @@ contains ! STEP 2e: override adjoint (tensorb) to be F transpose F tensorb(1) = tensora(4)**2 + tensora(3)**2 tensorb(4) = tensora(2)**2 + tensora(1)**2 - tensorb(2) = -tensora(2)*tensora(4) + tensora(1)*-tensora(3) + tensorb(2) = -tensora(2)*tensora(4) + tensora(1)*(-tensora(3)) tensorb(3) = tensorb(2) ! STEP 3: update the btensor, this is consistent with Riemann solvers #:for BIJ, TXY in [(1,1),(2,2),(3,4)] From 2d0d572b1f02f9713276af678b4b5317079e665a Mon Sep 17 00:00:00 2001 From: mcarcana Date: Sun, 2 Feb 2025 17:29:45 -0500 Subject: [PATCH 379/380] reorganizing num_dim ifs to be 3,2,1 --- src/simulation/m_hyperelastic.fpp | 148 ++++++++++++++++-------------- 1 file changed, 77 insertions(+), 71 deletions(-) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 089569feb6..78e774b984 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -125,11 +125,6 @@ contains !if ( G <= verysmall ) G_K = 0._wp if (G > verysmall) then - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensorb(tensor_size) - end do - ! STEP 1: computing grad_xi (tensora) using finite differences ! tensora(1,2): dxix_x, dxiy_x ! tensora(3,4): dxix_dy, dxiy_dy @@ -138,17 +133,9 @@ contains ! tensora(7,8,9): dxix_dz, dxiy_dz, dxiz_dz !$acc loop seq do r = -fd_number, fd_number - ! derivatives in the x-direction - tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) - if (n > 0) then - ! derivatives in the x-direction - tensora(2) = tensora(2) + q_prim_vf(xibeg + 1)%sf(j + r, k, l)*fd_coeff_x(r, j) - ! derivatives in the y-direction - tensora(3) = tensora(3) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) - tensora(4) = tensora(4) + q_prim_vf(xibeg + 1)%sf(j, k + r, l)*fd_coeff_y(r, k) - end if if (p > 0) then ! derivatives in the x-direction + tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) tensora(2) = tensora(2) + q_prim_vf(xibeg + 1)%sf(j + r, k, l)*fd_coeff_x(r, j) tensora(3) = tensora(3) + q_prim_vf(xiend)%sf(j + r, k, l)*fd_coeff_x(r, j) ! derivatives in the y-direction @@ -159,22 +146,19 @@ contains tensora(7) = tensora(7) + q_prim_vf(xibeg)%sf(j, k, l + r)*fd_coeff_z(r, l) tensora(8) = tensora(8) + q_prim_vf(xibeg + 1)%sf(j, k, l + r)*fd_coeff_z(r, l) tensora(9) = tensora(9) + q_prim_vf(xiend)%sf(j, k, l + r)*fd_coeff_z(r, l) + elseif (n > 0) then + ! derivatives in the x-direction + tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) + tensora(2) = tensora(2) + q_prim_vf(xibeg + 1)%sf(j + r, k, l)*fd_coeff_x(r, j) + ! derivatives in the y-direction + tensora(3) = tensora(3) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) + tensora(4) = tensora(4) + q_prim_vf(xibeg + 1)%sf(j, k + r, l)*fd_coeff_y(r, k) + else + ! derivatives in the x-direction + tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) end if end do - ! STEP 2a: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1) - ! STEP 2b: computing the inverse of the grad_xi tensor - tensorb(1) = 1._wp/tensora(1) - if (n > 0) then - ! STEP 2a: computing the cofactor (tensorb) of the grad_xi tensor for the inverse - tensorb(1) = tensora(4) - tensorb(2) = -tensora(2) - tensorb(3) = -tensora(3) - tensorb(4) = tensora(1) - ! STEP 2b: computing the determinant of the grad_xi tensor - tensora(tensor_size) = tensora(1)*tensora(4) - tensora(3)*tensora(2) - end if if (p > 0) then ! STEP 2a: computing the adjoint of the grad_xi tensor for the inverse tensorb(1) = tensora(5)*tensora(9) - tensora(6)*tensora(8) @@ -190,31 +174,23 @@ contains tensora(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + elseif (n > 0) then + ! STEP 2a: computing the cofactor (tensorb) of the grad_xi tensor for the inverse + tensorb(1) = tensora(4) + tensorb(2) = -tensora(2) + tensorb(3) = -tensora(3) + tensorb(4) = tensora(1) + ! STEP 2b: computing the determinant of the grad_xi tensor + tensora(tensor_size) = tensora(1)*tensora(4) - tensora(3)*tensora(2) + else + ! STEP 2a: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1) + ! STEP 2b: computing the inverse of the grad_xi tensor + tensorb(1) = 1._wp/tensora(1) end if if (tensora(tensor_size) > verysmall) then - ! STEP 3: update the btensor, this is consistent with Riemann solvers - ! \b_xx - btensor%vf(1)%sf(j, k, l) = tensorb(1)**2 - if (n > 0) then - ! STEP 2c: computing the inverse of grad_xi tensor = F (tensora) - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensora(tensor_size) - end do - ! STEP 2d: computing J = det(F) - tensorb(tensor_size) = 1._wp/tensora(tensor_size) - ! STEP 2e: override adjoint (tensorb) to be F transpose F - tensorb(1) = tensora(4)**2 + tensora(3)**2 - tensorb(4) = tensora(2)**2 + tensora(1)**2 - tensorb(2) = -tensora(2)*tensora(4) + tensora(1)*(-tensora(3)) - tensorb(3) = tensorb(2) - ! STEP 3: update the btensor, this is consistent with Riemann solvers - #:for BIJ, TXY in [(1,1),(2,2),(3,4)] - btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) - #:endfor - end if - if (p > 0) then + if (p > 0) then ! STEP 2c: computing the inverse of grad_xi tensor = F (tensora) !$acc loop seq do i = 1, tensor_size - 1 @@ -233,7 +209,28 @@ contains #:for BIJ, TXY in [(1,1),(2,2),(3,5),(4,3),(5,6),(6,9)] btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) #:endfor - end if + elseif (n > 0) then + ! STEP 2c: computing the inverse of grad_xi tensor = F (tensora) + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensora(tensor_size) + end do + ! STEP 2d: computing J = det(F) + tensorb(tensor_size) = 1._wp/tensora(tensor_size) + ! STEP 2e: override adjoint (tensorb) to be F transpose F + tensorb(1) = tensora(4)**2 + tensora(3)**2 + tensorb(4) = tensora(2)**2 + tensora(1)**2 + tensorb(2) = (-tensora(2))*tensora(4) + tensora(1)*(-tensora(3)) + tensorb(3) = tensorb(2) + ! STEP 3: update the btensor, this is consistent with Riemann solvers + #:for BIJ, TXY in [(1,1),(2,2),(3,4)] + btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) + #:endfor + else + ! STEP 3: update the btensor, this is consistent with Riemann solvers + ! \b_xx + btensor%vf(1)%sf(j, k, l) = tensorb(1)**2 + end if !STEP 3b: store the determinant at the last entry of the btensor btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) @@ -281,25 +278,25 @@ contains real(wp) :: trace real(wp), parameter :: f13 = 1._wp/3._wp - integer :: i + integer :: i - ! calculate the deviatoric of the tensor - btensor(1)%sf(j, k, l) = 2._wp*btensor(1)%sf(j, k, l)/3._wp - if (n > 0) then - ! tensor is the symmetric tensor & calculate the trace of the tensor - trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) - ! calculate the deviatoric of the tensor - btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace - btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace - end if - if (p > 0) then + if (p > 0) then ! tensor is the symmetric tensor & calculate the trace of the tensor trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) ! calculate the deviatoric of the tensor #:for IJ in [1,3,6] btensor(${IJ}$)%sf(j, k, l) = btensor(${IJ}$)%sf(j, k, l) - f13*trace #:endfor - end if + elseif (n > 0) then + ! tensor is the symmetric tensor & calculate the trace of the tensor + trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + ! calculate the deviatoric of the tensor + btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace + btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace + else + ! calculate the deviatoric of the tensor + btensor(1)%sf(j, k, l) = 2._wp*btensor(1)%sf(j, k, l)/3._wp + end if ! dividing by the jacobian for neo-Hookean model ! setting the tensor to the stresses for riemann solver @@ -334,21 +331,30 @@ contains real(wp), parameter :: f13 = 1._wp/3._wp integer :: i - !TODO Make this 1D and 2D capable - ! tensor is the symmetric tensor & calculate the trace of the tensor - trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) - - ! calculate the deviatoric of the tensor - btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace - btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace - btensor(6)%sf(j, k, l) = btensor(6)%sf(j, k, l) - f13*trace + if (p > 0) then + ! tensor is the symmetric tensor & calculate the trace of the tensor + trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + btensor(6)%sf(j, k, l) + ! calculate the deviatoric of the tensor + #:for IJ in [1,3,6] + btensor(${IJ}$)%sf(j, k, l) = btensor(${IJ}$)%sf(j, k, l) - f13*trace + #:endfor + elseif (n > 0) then + ! tensor is the symmetric tensor & calculate the trace of the tensor + trace = btensor(1)%sf(j, k, l) + btensor(3)%sf(j, k, l) + ! calculate the deviatoric of the tensor + btensor(1)%sf(j, k, l) = btensor(1)%sf(j, k, l) - f13*trace + btensor(3)%sf(j, k, l) = btensor(3)%sf(j, k, l) - f13*trace + else + ! calculate the deviatoric of the tensor + btensor(1)%sf(j, k, l) = 2._wp*btensor(1)%sf(j, k, l)/3._wp + end if ! dividing by the jacobian for neo-Hookean model ! setting the tensor to the stresses for riemann solver !$acc loop seq do i = 1, b_size - 1 q_prim_vf(strxb + i - 1)%sf(j, k, l) = & - G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) + G*btensor(i)%sf(j, k, l)/btensor(b_size)%sf(j, k, l) end do ! compute the invariant without the elastic modulus q_prim_vf(xiend + 1)%sf(j, k, l) = & From 929a820e78330788a76e9584951b2920990f6c57 Mon Sep 17 00:00:00 2001 From: mcarcana Date: Mon, 3 Feb 2025 14:44:20 -0500 Subject: [PATCH 380/380] debugging hyperelasticity --- examples/1D_hyper_1material/case.py | 107 +++++++++++++++++++ examples/1D_hyper_2materials/case.py | 110 ++++++++++++++++++++ examples/2D_hyper_1material/case.py | 125 ++++++++++++++++++++++ examples/2D_hyper_2materials/case.py | 129 +++++++++++++++++++++++ examples/3D_hyper_1material/case.py | 146 ++++++++++++++++++++++++++ examples/3D_hyper_2materials/case.py | 150 +++++++++++++++++++++++++++ src/simulation/m_hyperelastic.fpp | 111 ++++++++++---------- 7 files changed, 825 insertions(+), 53 deletions(-) create mode 100644 examples/1D_hyper_1material/case.py create mode 100644 examples/1D_hyper_2materials/case.py create mode 100644 examples/2D_hyper_1material/case.py create mode 100644 examples/2D_hyper_2materials/case.py create mode 100644 examples/3D_hyper_1material/case.py create mode 100644 examples/3D_hyper_2materials/case.py diff --git a/examples/1D_hyper_1material/case.py b/examples/1D_hyper_1material/case.py new file mode 100644 index 0000000000..823021071f --- /dev/null +++ b/examples/1D_hyper_1material/case.py @@ -0,0 +1,107 @@ +#!/usr/bin/env python3 + +# 1D -> Hyperelasticity -> 1 Fluid(s) + +import math, json + +print(json.dumps({ + 'run_time_info': 'T', + 'm': 299, + 'n': 0, + 'p': 0, + 'dt': 1e-07, + 't_step_start': 0, + 't_step_stop': 50, + 't_step_save': 25, + 'num_patches': 3, + 'model_eqns': 3, + 'alt_soundspeed': 'F', + 'num_fluids': 1, + 'mpp_lim': 'F', + 'mixture_err': 'F', + 'time_stepper': 3, + 'weno_order': 5, + 'weno_eps': 1e-16, + 'mapped_weno': 'F', + 'null_weights': 'F', + 'mp_weno': 'F', + 'riemann_solver': 2, + 'wave_speeds': 1, + 'avg_state': 2, + 'format': 1, + 'precision': 2, + 'prim_vars_wrt': 'F', + 'parallel_io': 'F', + 'patch_icpp(1)%pres': 1000000.0, + 'patch_icpp(1)%alpha_rho(1)': 1000.0, + 'patch_icpp(1)%alpha(1)': 1.0, + 'patch_icpp(2)%pres': 100000.0, + 'patch_icpp(2)%alpha_rho(1)': 1000.0, + 'patch_icpp(2)%alpha(1)': 1.0, + 'patch_icpp(3)%pres': 500000.0, + 'patch_icpp(3)%alpha_rho(1)': 1000.0, + 'patch_icpp(3)%alpha(1)': 1.0, + 'fluid_pp(1)%gamma': 0.3, + 'fluid_pp(1)%pi_inf': 780000.0, + 'Ca': 0.9769178386380458, + 'Web': 13.927835051546392, + 'Re_inv': 0.009954269975623245, + 'pref': 101325.0, + 'rhoref': 1000.0, + 'bubble_model': 3, + 'polytropic': 'T', + 'polydisperse': 'F', + 'thermal': 3, + 'R0ref': 1e-05, + 'patch_icpp(1)%r0': 1, + 'patch_icpp(1)%v0': 0, + 'patch_icpp(2)%r0': 1, + 'patch_icpp(2)%v0': 0, + 'patch_icpp(3)%r0': 1, + 'patch_icpp(3)%v0': 0, + 'qbmm': 'F', + 'dist_type': 2, + 'poly_sigma': 0.3, + 'R0_type': 1, + 'sigR': 0.1, + 'sigV': 0.1, + 'rhoRV': 0.0, + 'x_domain%beg': 0.0, + 'x_domain%end': 1.0, + 'bc_x%beg': -3, + 'bc_x%end': -3, + 'patch_icpp(1)%geometry': 1, + 'patch_icpp(1)%x_centroid': 0.05, + 'patch_icpp(1)%length_x': 0.1, + 'patch_icpp(2)%x_centroid': 0.45, + 'patch_icpp(2)%length_x': 0.7, + 'patch_icpp(3)%x_centroid': 0.9, + 'patch_icpp(3)%length_x': 0.2, + 'patch_icpp(1)%vel(1)': 0.0, + 'patch_icpp(2)%geometry': 1, + 'patch_icpp(2)%vel(1)': 0.0, + 'patch_icpp(3)%geometry': 1, + 'patch_icpp(3)%vel(1)': 0.0, + 'hyperelasticity': 'T', + 'hyper_model': 1, + 'fd_order': 4, + 'patch_icpp(1)%tau_e(1)': 0.0, + 'patch_icpp(2)%tau_e(1)': 0.0, + 'patch_icpp(3)%tau_e(1)': 0.0, + 'fluid_pp(1)%G': 1000000000.0, + 'parallel_io' : 'T', + 'cons_vars_wrt' : 'T', + 'prim_vars_wrt': 'T', + 'alpha_rho_wrt(1)': 'T', + 'rho_wrt' : 'T', + 'mom_wrt(1)' : 'T', + 'vel_wrt(1)' : 'T', + 'E_wrt' : 'T', + 'pres_wrt' : 'T', + 'alpha_wrt(1)' : 'T', + 'gamma_wrt' : 'T', + 'heat_ratio_wrt' : 'T', + 'pi_inf_wrt' : 'T', + 'pres_inf_wrt' : 'T', + 'c_wrt' : 'T', +})) diff --git a/examples/1D_hyper_2materials/case.py b/examples/1D_hyper_2materials/case.py new file mode 100644 index 0000000000..4621386498 --- /dev/null +++ b/examples/1D_hyper_2materials/case.py @@ -0,0 +1,110 @@ +#!/usr/bin/env python3 + +# 1D -> Hyperelasticity -> 2 Fluid(s) + +import math, json +import argparse + +print(json.dumps({ + 'run_time_info': 'T', + 'm': 299, + 'n': 0, + 'p': 0, + 'dt': 1e-07, + 't_step_start': 0, + 't_step_stop': 50, + 't_step_save': 25, + 'num_patches': 3, + 'model_eqns': 3, + 'alt_soundspeed': 'F', + 'num_fluids': 2, + 'mpp_lim': 'F', + 'mixture_err': 'F', + 'time_stepper': 3, + 'weno_order': 5, + 'weno_eps': 1e-16, + 'mapped_weno': 'F', + 'null_weights': 'F', + 'mp_weno': 'F', + 'riemann_solver': 2, + 'wave_speeds': 1, + 'avg_state': 2, + 'format': 1, + 'precision': 2, + 'prim_vars_wrt': 'F', + 'parallel_io': 'F', + 'patch_icpp(1)%pres': 1000000.0, + 'patch_icpp(1)%alpha_rho(1)': 900.0, + 'patch_icpp(1)%alpha(1)': 0.9, + 'patch_icpp(2)%pres': 100000.0, + 'patch_icpp(2)%alpha_rho(1)': 100, + 'patch_icpp(2)%alpha(1)': 0.1, + 'patch_icpp(3)%pres': 500000.0, + 'patch_icpp(3)%alpha_rho(1)': 900, + 'patch_icpp(3)%alpha(1)': 0.9, + 'fluid_pp(1)%gamma': 0.3, + 'fluid_pp(1)%pi_inf': 780000.0, +# 'Ca': 0.9769178386380458, +# 'Web': 13.927835051546392, +# 'Re_inv': 0.009954269975623245, + 'pref': 101325.0, + 'rhoref': 1000.0, +# 'bubble_model': 3, +# 'polytropic': 'T', +# 'polydisperse': 'F', +# 'thermal': 3, + 'R0ref': 1e-05, + 'patch_icpp(1)%r0': 1, + 'patch_icpp(1)%v0': 0, + 'patch_icpp(2)%r0': 1, + 'patch_icpp(2)%v0': 0, + 'patch_icpp(3)%r0': 1, + 'patch_icpp(3)%v0': 0, +# 'qbmm': 'F', +# 'dist_type': 2, +# 'poly_sigma': 0.3, +# 'R0_type': 1, +# 'sigR': 0.1, +# 'sigV': 0.1, +# 'rhoRV': 0.0, + 'x_domain%beg': 0.0, + 'x_domain%end': 1.0, + 'bc_x%beg': -3, + 'bc_x%end': -3, + 'patch_icpp(1)%geometry': 1, + 'patch_icpp(1)%x_centroid': 0.05, + 'patch_icpp(1)%length_x': 0.1, + 'patch_icpp(2)%x_centroid': 0.45, + 'patch_icpp(2)%length_x': 0.7, + 'patch_icpp(3)%x_centroid': 0.9, + 'patch_icpp(3)%length_x': 0.2, + 'patch_icpp(1)%vel(1)': 0.0, + 'patch_icpp(2)%geometry': 1, + 'patch_icpp(2)%vel(1)': 0.0, + 'patch_icpp(3)%geometry': 1, + 'patch_icpp(3)%vel(1)': 0.0, + 'hyperelasticity': 'T', + 'hyper_model': 1, + 'fd_order': 4, + 'patch_icpp(1)%tau_e(1)': 0.0, + 'patch_icpp(2)%tau_e(1)': 0.0, + 'patch_icpp(3)%tau_e(1)': 0.0, + 'fluid_pp(1)%G': 1000000000.0, + 'fluid_pp(2)%gamma': 0.3, + 'fluid_pp(2)%pi_inf': 780000.0, + 'patch_icpp(1)%alpha_rho(2)': 100, + 'patch_icpp(1)%alpha(2)': 0.1, + 'patch_icpp(2)%alpha_rho(2)': 900, + 'patch_icpp(2)%alpha(2)': 0.9, + 'patch_icpp(3)%alpha_rho(2)': 100, + 'patch_icpp(3)%alpha(2)': 0.1, + 'fluid_pp(2)%G': 0.0, #50000.0 + 'parallel_io' : 'T', 'cons_vars_wrt' : 'T', + 'prim_vars_wrt': 'T', 'alpha_rho_wrt(1)': 'T', + 'rho_wrt' : 'T', 'mom_wrt(1)' : 'T', + 'vel_wrt(1)' : 'T', 'E_wrt' : 'T', + 'pres_wrt' : 'T', 'alpha_wrt(1)' : 'T', + 'gamma_wrt' : 'T', 'heat_ratio_wrt' : 'T', + 'pi_inf_wrt' : 'T', 'pres_inf_wrt' : 'T', + 'c_wrt' : 'T', + })) diff --git a/examples/2D_hyper_1material/case.py b/examples/2D_hyper_1material/case.py new file mode 100644 index 0000000000..94890e1335 --- /dev/null +++ b/examples/2D_hyper_1material/case.py @@ -0,0 +1,125 @@ +#!/usr/bin/env python3 + +# 2D -> Hyperelasticity -> 1 Fluid(s) + +import math, json + +print(json.dumps({ + 'run_time_info': 'T', + 'm': 49, + 'n': 39, + 'p': 0, + 'dt': 1e-08, #1e-06, +# 'cfl_adap_dt': 'T', +# 'cfl_target': 0.1, +# 'n_start': 0, +# 't_stop': 1e-06, +# 't_save': 1e-07, + 't_step_start': 0, + 't_step_stop': 50, + 't_step_save': 1, + 'num_patches': 3, + 'model_eqns': 3, + 'alt_soundspeed': 'F', + 'num_fluids': 1, + 'mpp_lim': 'F', + 'mixture_err': 'F', + 'time_stepper': 3, + 'weno_order': 5, + 'weno_eps': 1e-16, + 'mapped_weno': 'F', + 'null_weights': 'F', + 'mp_weno': 'F', + 'riemann_solver': 2, + 'wave_speeds': 1, + 'avg_state': 2, + 'format': 1, + 'precision': 2, + 'prim_vars_wrt': 'F', + 'parallel_io': 'F', + 'patch_icpp(1)%pres': 1000000.0, + 'patch_icpp(1)%alpha_rho(1)': 1000.0, + 'patch_icpp(1)%alpha(1)': 1.0, + 'patch_icpp(2)%pres': 100000.0, + 'patch_icpp(2)%alpha_rho(1)': 1000.0, + 'patch_icpp(2)%alpha(1)': 1.0, + 'patch_icpp(3)%pres': 500000.0, + 'patch_icpp(3)%alpha_rho(1)': 1000.0, + 'patch_icpp(3)%alpha(1)': 1.0, + 'fluid_pp(1)%gamma': 0.3, + 'fluid_pp(1)%pi_inf': 780000.0, +# 'Ca': 0.9769178386380458, +# 'Web': 13.927835051546392, +# 'Re_inv': 0.009954269975623245, + 'pref': 101325.0, + 'rhoref': 1000.0, +# 'bubble_model': 3, +# 'polytropic': 'T', +# 'polydisperse': 'F', +# 'thermal': 3, + 'R0ref': 1e-05, + 'patch_icpp(1)%r0': 1, + 'patch_icpp(1)%v0': 0, + 'patch_icpp(2)%r0': 1, + 'patch_icpp(2)%v0': 0, + 'patch_icpp(3)%r0': 1, + 'patch_icpp(3)%v0': 0, +# 'qbmm': 'F', +# 'dist_type': 2, +# 'poly_sigma': 0.3, +# 'R0_type': 1, +# 'sigR': 0.1, +# 'sigV': 0.1, +# 'rhoRV': 0.0, + 'x_domain%beg': 0.0, + 'x_domain%end': 1.0, + 'y_domain%beg': 0.0, + 'y_domain%end': 1.0, + 'bc_x%beg': -3, + 'bc_x%end': -3, + 'bc_y%beg': -3, + 'bc_y%end': -3, + 'patch_icpp(1)%geometry': 3, + 'patch_icpp(1)%y_centroid': 0.05, + 'patch_icpp(1)%length_y': 0.1, + 'patch_icpp(2)%y_centroid': 0.45, + 'patch_icpp(2)%length_y': 0.7, + 'patch_icpp(3)%y_centroid': 0.9, + 'patch_icpp(3)%length_y': 0.2, + 'patch_icpp(1)%x_centroid': 0.5, + 'patch_icpp(1)%length_x': 1, + 'patch_icpp(1)%vel(1)': 0.0, + 'patch_icpp(1)%vel(2)': 0.0, + 'patch_icpp(2)%geometry': 3, + 'patch_icpp(2)%x_centroid': 0.5, + 'patch_icpp(2)%length_x': 1, + 'patch_icpp(2)%vel(1)': 0.0, + 'patch_icpp(2)%vel(2)': 0.0, + 'patch_icpp(3)%geometry': 3, + 'patch_icpp(3)%x_centroid': 0.5, + 'patch_icpp(3)%length_x': 1, + 'patch_icpp(3)%vel(1)': 0.0, + 'patch_icpp(3)%vel(2)': 0.0, + 'hyperelasticity': 'T', + 'hyper_model': 1, + 'fd_order': 4, + 'patch_icpp(1)%tau_e(1)': 0.0, + 'patch_icpp(2)%tau_e(1)': 0.0, + 'patch_icpp(3)%tau_e(1)': 0.0, + 'fluid_pp(1)%G': 1000000000.0, + 'patch_icpp(1)%tau_e(2)': 0.0, + 'patch_icpp(1)%tau_e(3)': 0.0, + 'patch_icpp(2)%tau_e(2)': 0.0, + 'patch_icpp(2)%tau_e(3)': 0.0, + 'patch_icpp(3)%tau_e(2)': 0.0, + 'patch_icpp(3)%tau_e(3)': 0.0, + 'parallel_io' : 'T', 'cons_vars_wrt' : 'T', + 'prim_vars_wrt': 'T', 'alpha_rho_wrt(1)': 'T', + 'rho_wrt' : 'T', 'mom_wrt(1)' : 'T', + 'vel_wrt(1)' : 'T', 'E_wrt' : 'T', + 'pres_wrt' : 'T', 'alpha_wrt(1)' : 'T', + 'gamma_wrt' : 'T', 'heat_ratio_wrt' : 'T', + 'pi_inf_wrt' : 'T', 'pres_inf_wrt' : 'T', + 'c_wrt' : 'T', + })) + diff --git a/examples/2D_hyper_2materials/case.py b/examples/2D_hyper_2materials/case.py new file mode 100644 index 0000000000..0bc60ac510 --- /dev/null +++ b/examples/2D_hyper_2materials/case.py @@ -0,0 +1,129 @@ +#!/usr/bin/env python3 + +# 2D -> Hyperelasticity -> 2 Fluid(s) + +import math, json + +print(json.dumps({ + 'run_time_info': 'T', + 'm': 49, + 'n': 39, + 'p': 0, + 'dt': 1e-06, + 't_step_start': 0, + 't_step_stop': 50, + 't_step_save': 25, + 'num_patches': 3, + 'model_eqns': 3, + 'alt_soundspeed': 'F', + 'num_fluids': 2, + 'mpp_lim': 'F', + 'mixture_err': 'F', + 'time_stepper': 3, + 'weno_order': 5, + 'weno_eps': 1e-16, + 'mapped_weno': 'F', + 'null_weights': 'F', + 'mp_weno': 'F', + 'riemann_solver': 2, + 'wave_speeds': 1, + 'avg_state': 2, + 'format': 1, + 'precision': 2, + 'prim_vars_wrt': 'F', + 'parallel_io': 'F', + 'patch_icpp(1)%pres': 1000000.0, + 'patch_icpp(1)%alpha_rho(1)': 900.0, + 'patch_icpp(1)%alpha(1)': 0.9, + 'patch_icpp(2)%pres': 100000.0, + 'patch_icpp(2)%alpha_rho(1)': 100, + 'patch_icpp(2)%alpha(1)': 0.1, + 'patch_icpp(3)%pres': 500000.0, + 'patch_icpp(3)%alpha_rho(1)': 900, + 'patch_icpp(3)%alpha(1)': 0.9, + 'fluid_pp(1)%gamma': 0.3, + 'fluid_pp(1)%pi_inf': 780000.0, +# 'Ca': 0.9769178386380458, +# 'Web': 13.927835051546392, +# 'Re_inv': 0.009954269975623245, + 'pref': 101325.0, + 'rhoref': 1000.0, +# 'bubble_model': 3, +# 'polytropic': 'T', +# 'polydisperse': 'F', +# 'thermal': 3, + 'R0ref': 1e-05, + 'patch_icpp(1)%r0': 1, + 'patch_icpp(1)%v0': 0, + 'patch_icpp(2)%r0': 1, + 'patch_icpp(2)%v0': 0, + 'patch_icpp(3)%r0': 1, + 'patch_icpp(3)%v0': 0, +# 'qbmm': 'F', +# 'dist_type': 2, +# 'poly_sigma': 0.3, +# 'R0_type': 1, +# 'sigR': 0.1, +# 'sigV': 0.1, +# 'rhoRV': 0.0, + 'x_domain%beg': 0.0, + 'x_domain%end': 1.0, + 'y_domain%beg': 0.0, + 'y_domain%end': 1.0, + 'bc_x%beg': -3, + 'bc_x%end': -3, + 'bc_y%beg': -3, + 'bc_y%end': -3, + 'patch_icpp(1)%geometry': 3, + 'patch_icpp(1)%y_centroid': 0.05, + 'patch_icpp(1)%length_y': 0.1, + 'patch_icpp(2)%y_centroid': 0.45, + 'patch_icpp(2)%length_y': 0.7, + 'patch_icpp(3)%y_centroid': 0.9, + 'patch_icpp(3)%length_y': 0.2, + 'patch_icpp(1)%x_centroid': 0.5, + 'patch_icpp(1)%length_x': 1, + 'patch_icpp(1)%vel(1)': 0.0, + 'patch_icpp(1)%vel(2)': 0.0, + 'patch_icpp(2)%geometry': 3, + 'patch_icpp(2)%x_centroid': 0.5, + 'patch_icpp(2)%length_x': 1, + 'patch_icpp(2)%vel(1)': 0.0, + 'patch_icpp(2)%vel(2)': 0.0, + 'patch_icpp(3)%geometry': 3, + 'patch_icpp(3)%x_centroid': 0.5, + 'patch_icpp(3)%length_x': 1, + 'patch_icpp(3)%vel(1)': 0.0, + 'patch_icpp(3)%vel(2)': 0.0, + 'hyperelasticity': 'T', + 'hyper_model': 1, + 'fd_order': 4, + 'patch_icpp(1)%tau_e(1)': 0.0, + 'patch_icpp(2)%tau_e(1)': 0.0, + 'patch_icpp(3)%tau_e(1)': 0.0, + 'fluid_pp(1)%G': 1000000000.0, + 'fluid_pp(2)%gamma': 0.3, + 'fluid_pp(2)%pi_inf': 780000.0, + 'patch_icpp(1)%alpha_rho(2)': 100, + 'patch_icpp(1)%alpha(2)': 0.1, + 'patch_icpp(2)%alpha_rho(2)': 900, + 'patch_icpp(2)%alpha(2)': 0.9, + 'patch_icpp(3)%alpha_rho(2)': 100, + 'patch_icpp(3)%alpha(2)': 0.1, + 'fluid_pp(2)%G': 0.0, #50000.0, + 'patch_icpp(1)%tau_e(2)': 0.0, + 'patch_icpp(1)%tau_e(3)': 0.0, + 'patch_icpp(2)%tau_e(2)': 0.0, + 'patch_icpp(2)%tau_e(3)': 0.0, + 'patch_icpp(3)%tau_e(2)': 0.0, + 'patch_icpp(3)%tau_e(3)': 0.0, + 'parallel_io' : 'T', 'cons_vars_wrt' : 'T', + 'prim_vars_wrt': 'T', 'alpha_rho_wrt(1)': 'T', + 'rho_wrt' : 'T', 'mom_wrt(1)' : 'T', + 'vel_wrt(1)' : 'T', 'E_wrt' : 'T', + 'pres_wrt' : 'T', 'alpha_wrt(1)' : 'T', + 'gamma_wrt' : 'T', 'heat_ratio_wrt' : 'T', + 'pi_inf_wrt' : 'T', 'pres_inf_wrt' : 'T', + 'c_wrt' : 'T', + })) + diff --git a/examples/3D_hyper_1material/case.py b/examples/3D_hyper_1material/case.py new file mode 100644 index 0000000000..ee365445bc --- /dev/null +++ b/examples/3D_hyper_1material/case.py @@ -0,0 +1,146 @@ +#!/usr/bin/env python3 + +# 3D -> Hyperelasticity -> 1 Fluid(s) + +import math, json + +print(json.dumps({ + 'run_time_info': 'T', + 'm': 24, + 'n': 24, + 'p': 24, + 'dt': 1e-07, + 't_step_start': 0, + 't_step_stop': 50, + 't_step_save': 25, +# 'cfl_adap_dt': 'T', +# 'cfl_target': 0.25, +# 'n_start': 0, +# 't_stop': 1e-06, +# 't_save': 1e-07, + 'num_patches': 3, + 'model_eqns': 3, + 'alt_soundspeed': 'F', + 'num_fluids': 1, + 'mpp_lim': 'F', + 'mixture_err': 'F', + 'time_stepper': 3, + 'weno_order': 5, + 'weno_eps': 1e-16, + 'mapped_weno': 'F', + 'null_weights': 'F', + 'mp_weno': 'F', + 'riemann_solver': 2, + 'wave_speeds': 1, + 'avg_state': 2, + 'format': 1, + 'precision': 2, + 'prim_vars_wrt': 'F', + 'parallel_io': 'F', + 'patch_icpp(1)%pres': 1000000.0, + 'patch_icpp(1)%alpha_rho(1)': 1000.0, + 'patch_icpp(1)%alpha(1)': 1.0, + 'patch_icpp(2)%pres': 100000.0, + 'patch_icpp(2)%alpha_rho(1)': 1000.0, + 'patch_icpp(2)%alpha(1)': 1.0, + 'patch_icpp(3)%pres': 500000.0, + 'patch_icpp(3)%alpha_rho(1)': 1000.0, + 'patch_icpp(3)%alpha(1)': 1.0, + 'fluid_pp(1)%gamma': 0.3, + 'fluid_pp(1)%pi_inf': 780000.0, +# 'Ca': 0.9769178386380458, +# 'Web': 13.927835051546392, +# 'Re_inv': 0.009954269975623245, + 'pref': 101325.0, + 'rhoref': 1000.0, +# 'bubble_model': 3, +# 'polytropic': 'T', +# 'polydisperse': 'F', +# 'thermal': 3, + 'R0ref': 1e-05, + 'patch_icpp(1)%r0': 1, + 'patch_icpp(1)%v0': 0, + 'patch_icpp(2)%r0': 1, + 'patch_icpp(2)%v0': 0, + 'patch_icpp(3)%r0': 1, + 'patch_icpp(3)%v0': 0, +# 'qbmm': 'F', +# 'dist_type': 2, +# 'poly_sigma': 0.3, +# 'R0_type': 1, +# 'sigR': 0.1, +# 'sigV': 0.1, +# 'rhoRV': 0.0, + 'x_domain%beg': 0.0, + 'x_domain%end': 1.0, + 'y_domain%beg': 0.0, + 'y_domain%end': 1.0, + 'z_domain%beg': 0.0, + 'z_domain%end': 1.0, + 'bc_x%beg': -3, + 'bc_x%end': -3, + 'bc_y%beg': -3, + 'bc_y%end': -3, + 'bc_z%beg': -3, + 'bc_z%end': -3, + 'patch_icpp(1)%geometry': 9, + 'patch_icpp(1)%z_centroid': 0.05, + 'patch_icpp(1)%length_z': 0.1, + 'patch_icpp(2)%z_centroid': 0.45, + 'patch_icpp(2)%length_z': 0.7, + 'patch_icpp(3)%z_centroid': 0.9, + 'patch_icpp(3)%length_z': 0.2, + 'patch_icpp(1)%y_centroid': 0.5, + 'patch_icpp(1)%length_y': 1, + 'patch_icpp(1)%x_centroid': 0.5, + 'patch_icpp(1)%length_x': 1, + 'patch_icpp(1)%vel(1)': 0.0, + 'patch_icpp(1)%vel(2)': 0.0, + 'patch_icpp(1)%vel(3)': 0.0, + 'patch_icpp(2)%geometry': 9, + 'patch_icpp(2)%y_centroid': 0.5, + 'patch_icpp(2)%length_y': 1, + 'patch_icpp(2)%x_centroid': 0.5, + 'patch_icpp(2)%length_x': 1, + 'patch_icpp(2)%vel(1)': 0.0, + 'patch_icpp(2)%vel(2)': 0.0, + 'patch_icpp(2)%vel(3)': 0.0, + 'patch_icpp(3)%geometry': 9, + 'patch_icpp(3)%y_centroid': 0.5, + 'patch_icpp(3)%length_y': 1, + 'patch_icpp(3)%x_centroid': 0.5, + 'patch_icpp(3)%length_x': 1, + 'patch_icpp(3)%vel(1)': 0.0, + 'patch_icpp(3)%vel(2)': 0.0, + 'patch_icpp(3)%vel(3)': 0.0, + 'hyperelasticity': 'T', + 'hyper_model': 1, + 'fd_order': 4, + 'patch_icpp(1)%tau_e(1)': 0.0, + 'patch_icpp(2)%tau_e(1)': 0.0, + 'patch_icpp(3)%tau_e(1)': 0.0, + 'fluid_pp(1)%G': 1000000000.0, + 'patch_icpp(1)%tau_e(2)': 0.0, + 'patch_icpp(1)%tau_e(3)': 0.0, + 'patch_icpp(2)%tau_e(2)': 0.0, + 'patch_icpp(2)%tau_e(3)': 0.0, + 'patch_icpp(3)%tau_e(2)': 0.0, + 'patch_icpp(3)%tau_e(3)': 0.0, + 'patch_icpp(1)%tau_e(4)': 0.0, + 'patch_icpp(1)%tau_e(5)': 0.0, + 'patch_icpp(1)%tau_e(6)': 0.0, + 'patch_icpp(2)%tau_e(4)': 0.0, + 'patch_icpp(2)%tau_e(5)': 0.0, + 'patch_icpp(2)%tau_e(6)': 0.0, + 'patch_icpp(3)%tau_e(4)': 0.0, + 'patch_icpp(3)%tau_e(5)': 0.0, + 'patch_icpp(3)%tau_e(6)': 0.0, + 'parallel_io' : 'T', 'cons_vars_wrt' : 'T', + 'prim_vars_wrt': 'T', 'alpha_rho_wrt(1)': 'T', + 'rho_wrt' : 'T', 'mom_wrt(1)' : 'T', + 'vel_wrt(1)' : 'T', 'E_wrt' : 'T', + 'pres_wrt' : 'T', 'alpha_wrt(1)' : 'T', + 'gamma_wrt' : 'T', 'heat_ratio_wrt' : 'T', + 'pi_inf_wrt' : 'T', 'pres_inf_wrt' : 'T', + 'c_wrt' : 'T', +})) diff --git a/examples/3D_hyper_2materials/case.py b/examples/3D_hyper_2materials/case.py new file mode 100644 index 0000000000..33857671aa --- /dev/null +++ b/examples/3D_hyper_2materials/case.py @@ -0,0 +1,150 @@ +#!/usr/bin/env python3 + +# 3D -> Hyperelasticity -> 2 Fluid(s) + +import math, json + +print(json.dumps({ + 'run_time_info': 'T', + 'm': 24, + 'n': 24, + 'p': 24, + 'dt': 1e-06, + 't_step_start': 0, + 't_step_stop': 50, + 't_step_save': 25, + 'num_patches': 3, + 'model_eqns': 3, + 'alt_soundspeed': 'F', + 'num_fluids': 2, + 'mpp_lim': 'F', + 'mixture_err': 'F', + 'time_stepper': 3, + 'weno_order': 5, + 'weno_eps': 1e-16, + 'mapped_weno': 'F', + 'null_weights': 'F', + 'mp_weno': 'F', + 'riemann_solver': 2, + 'wave_speeds': 1, + 'avg_state': 2, + 'format': 1, + 'precision': 2, + 'prim_vars_wrt': 'F', + 'parallel_io': 'F', + 'patch_icpp(1)%pres': 1000000.0, + 'patch_icpp(1)%alpha_rho(1)': 900.0, + 'patch_icpp(1)%alpha(1)': 0.9, + 'patch_icpp(2)%pres': 100000.0, + 'patch_icpp(2)%alpha_rho(1)': 100, + 'patch_icpp(2)%alpha(1)': 0.1, + 'patch_icpp(3)%pres': 500000.0, + 'patch_icpp(3)%alpha_rho(1)': 900, + 'patch_icpp(3)%alpha(1)': 0.9, + 'fluid_pp(1)%gamma': 0.3, + 'fluid_pp(1)%pi_inf': 780000.0, +# 'Ca': 0.9769178386380458, +# 'Web': 13.927835051546392, +# 'Re_inv': 0.009954269975623245, + 'pref': 101325.0, + 'rhoref': 1000.0, +# 'bubble_model': 3, +# 'polytropic': 'T', +# 'polydisperse': 'F', +# 'thermal': 3, + 'R0ref': 1e-05, + 'patch_icpp(1)%r0': 1, + 'patch_icpp(1)%v0': 0, + 'patch_icpp(2)%r0': 1, + 'patch_icpp(2)%v0': 0, + 'patch_icpp(3)%r0': 1, + 'patch_icpp(3)%v0': 0, +# 'qbmm': 'F', +# 'dist_type': 2, +# 'poly_sigma': 0.3, +# 'R0_type': 1, +# 'sigR': 0.1, +# 'sigV': 0.1, +# 'rhoRV': 0.0, + 'x_domain%beg': 0.0, + 'x_domain%end': 1.0, + 'y_domain%beg': 0.0, + 'y_domain%end': 1.0, + 'z_domain%beg': 0.0, + 'z_domain%end': 1.0, + 'bc_x%beg': -3, + 'bc_x%end': -3, + 'bc_y%beg': -3, + 'bc_y%end': -3, + 'bc_z%beg': -3, + 'bc_z%end': -3, + 'patch_icpp(1)%geometry': 9, + 'patch_icpp(1)%z_centroid': 0.05, + 'patch_icpp(1)%length_z': 0.1, + 'patch_icpp(2)%z_centroid': 0.45, + 'patch_icpp(2)%length_z': 0.7, + 'patch_icpp(3)%z_centroid': 0.9, + 'patch_icpp(3)%length_z': 0.2, + 'patch_icpp(1)%y_centroid': 0.5, + 'patch_icpp(1)%length_y': 1, + 'patch_icpp(1)%x_centroid': 0.5, + 'patch_icpp(1)%length_x': 1, + 'patch_icpp(1)%vel(1)': 0.0, + 'patch_icpp(1)%vel(2)': 0.0, + 'patch_icpp(1)%vel(3)': 0.0, + 'patch_icpp(2)%geometry': 9, + 'patch_icpp(2)%y_centroid': 0.5, + 'patch_icpp(2)%length_y': 1, + 'patch_icpp(2)%x_centroid': 0.5, + 'patch_icpp(2)%length_x': 1, + 'patch_icpp(2)%vel(1)': 0.0, + 'patch_icpp(2)%vel(2)': 0.0, + 'patch_icpp(2)%vel(3)': 0.0, + 'patch_icpp(3)%geometry': 9, + 'patch_icpp(3)%y_centroid': 0.5, + 'patch_icpp(3)%length_y': 1, + 'patch_icpp(3)%x_centroid': 0.5, + 'patch_icpp(3)%length_x': 1, + 'patch_icpp(3)%vel(1)': 0.0, + 'patch_icpp(3)%vel(2)': 0.0, + 'patch_icpp(3)%vel(3)': 0.0, + 'hyperelasticity': 'T', + 'hyper_model': 1, + 'fd_order': 4, + 'patch_icpp(1)%tau_e(1)': 0.0, + 'patch_icpp(2)%tau_e(1)': 0.0, + 'patch_icpp(3)%tau_e(1)': 0.0, + 'fluid_pp(1)%G': 1000000000.0, + 'fluid_pp(2)%gamma': 0.3, + 'fluid_pp(2)%pi_inf': 780000.0, + 'patch_icpp(1)%alpha_rho(2)': 100, + 'patch_icpp(1)%alpha(2)': 0.1, + 'patch_icpp(2)%alpha_rho(2)': 900, + 'patch_icpp(2)%alpha(2)': 0.9, + 'patch_icpp(3)%alpha_rho(2)': 100, + 'patch_icpp(3)%alpha(2)': 0.1, + 'fluid_pp(2)%G': 0.0, #50000.0, + 'patch_icpp(1)%tau_e(2)': 0.0, + 'patch_icpp(1)%tau_e(3)': 0.0, + 'patch_icpp(2)%tau_e(2)': 0.0, + 'patch_icpp(2)%tau_e(3)': 0.0, + 'patch_icpp(3)%tau_e(2)': 0.0, + 'patch_icpp(3)%tau_e(3)': 0.0, + 'patch_icpp(1)%tau_e(4)': 0.0, + 'patch_icpp(1)%tau_e(5)': 0.0, + 'patch_icpp(1)%tau_e(6)': 0.0, + 'patch_icpp(2)%tau_e(4)': 0.0, + 'patch_icpp(2)%tau_e(5)': 0.0, + 'patch_icpp(2)%tau_e(6)': 0.0, + 'patch_icpp(3)%tau_e(4)': 0.0, + 'patch_icpp(3)%tau_e(5)': 0.0, + 'patch_icpp(3)%tau_e(6)': 0.0, + 'parallel_io' : 'T', 'cons_vars_wrt' : 'T', + 'prim_vars_wrt': 'T', 'alpha_rho_wrt(1)': 'T', + 'rho_wrt' : 'T', 'mom_wrt(1)' : 'T', + 'vel_wrt(1)' : 'T', 'E_wrt' : 'T', + 'pres_wrt' : 'T', 'alpha_wrt(1)' : 'T', + 'gamma_wrt' : 'T', 'heat_ratio_wrt' : 'T', + 'pi_inf_wrt' : 'T', 'pres_inf_wrt' : 'T', + 'c_wrt' : 'T', +})) diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 78e774b984..1c6bca060f 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -122,7 +122,11 @@ contains alpha_rho_k, Re, j, k, l, G, Gs) rho = max(rho, sgm_eps) G = max(G, sgm_eps) - !if ( G <= verysmall ) G_K = 0._wp + + !$acc loop seq + do i = 1, tensor_size + tensora(i) = 0._wp + end do if (G > verysmall) then ! STEP 1: computing grad_xi (tensora) using finite differences @@ -153,6 +157,7 @@ contains ! derivatives in the y-direction tensora(3) = tensora(3) + q_prim_vf(xibeg)%sf(j, k + r, l)*fd_coeff_y(r, k) tensora(4) = tensora(4) + q_prim_vf(xibeg + 1)%sf(j, k + r, l)*fd_coeff_y(r, k) + ! print *, 'tensora(1)::', tensora,'tensora(2) ::', tensora(2), 'tensora(3) ::', tensora(3), 'tensora(4)::', tensora(4) else ! derivatives in the x-direction tensora(1) = tensora(1) + q_prim_vf(xibeg)%sf(j + r, k, l)*fd_coeff_x(r, j) @@ -174,6 +179,26 @@ contains tensora(tensor_size) = tensora(1)*(tensora(5)*tensora(9) - tensora(6)*tensora(8)) & - tensora(2)*(tensora(4)*tensora(9) - tensora(6)*tensora(7)) & + tensora(3)*(tensora(4)*tensora(8) - tensora(5)*tensora(7)) + if (tensora(tensor_size) > verysmall) then + ! STEP 2c: computing the inverse of grad_xi tensor = F (tensora) + !$acc loop seq + do i = 1, tensor_size - 1 + tensora(i) = tensorb(i)/tensora(tensor_size) + end do + ! STEP 2d: computing J = det(F) + tensorb(tensor_size) = 1._wp/tensora(tensor_size) + ! STEP 2e: computing F transpose F + tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 + tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 + tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 + tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) + tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) + tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) + ! STEP 3a: update the btensor, this is consistent with Riemann solvers + #:for BIJ, TXY in [(1,1),(2,2),(3,5),(4,3),(5,6),(6,9)] + btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) + #:endfor + end if elseif (n > 0) then ! STEP 2a: computing the cofactor (tensorb) of the grad_xi tensor for the inverse tensorb(1) = tensora(4) @@ -182,34 +207,8 @@ contains tensorb(4) = tensora(1) ! STEP 2b: computing the determinant of the grad_xi tensor tensora(tensor_size) = tensora(1)*tensora(4) - tensora(3)*tensora(2) - else - ! STEP 2a: computing the determinant of the grad_xi tensor - tensorb(tensor_size) = tensora(1) - ! STEP 2b: computing the inverse of the grad_xi tensor - tensorb(1) = 1._wp/tensora(1) - end if - - if (tensora(tensor_size) > verysmall) then - if (p > 0) then - ! STEP 2c: computing the inverse of grad_xi tensor = F (tensora) - !$acc loop seq - do i = 1, tensor_size - 1 - tensora(i) = tensorb(i)/tensora(tensor_size) - end do - ! STEP 2d: computing J = det(F) - tensorb(tensor_size) = 1._wp/tensora(tensor_size) - ! STEP 2e: computing F transpose F - tensorb(1) = tensora(1)**2 + tensora(2)**2 + tensora(3)**2 - tensorb(5) = tensora(4)**2 + tensora(5)**2 + tensora(6)**2 - tensorb(9) = tensora(7)**2 + tensora(8)**2 + tensora(9)**2 - tensorb(2) = tensora(1)*tensora(4) + tensora(2)*tensora(5) + tensora(3)*tensora(6) - tensorb(3) = tensora(1)*tensora(7) + tensora(2)*tensora(8) + tensora(3)*tensora(9) - tensorb(6) = tensora(4)*tensora(7) + tensora(5)*tensora(8) + tensora(6)*tensora(9) - ! STEP 3a: update the btensor, this is consistent with Riemann solvers - #:for BIJ, TXY in [(1,1),(2,2),(3,5),(4,3),(5,6),(6,9)] - btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) - #:endfor - elseif (n > 0) then + ! print *, 'I compute determinant::', tensora(tensor_size) + if (tensora(tensor_size) > verysmall) then ! STEP 2c: computing the inverse of grad_xi tensor = F (tensora) !$acc loop seq do i = 1, tensor_size - 1 @@ -217,6 +216,7 @@ contains end do ! STEP 2d: computing J = det(F) tensorb(tensor_size) = 1._wp/tensora(tensor_size) + ! print *, 'I compute J::', tensorb(tensor_size) ! STEP 2e: override adjoint (tensorb) to be F transpose F tensorb(1) = tensora(4)**2 + tensora(3)**2 tensorb(4) = tensora(2)**2 + tensora(1)**2 @@ -224,34 +224,39 @@ contains tensorb(3) = tensorb(2) ! STEP 3: update the btensor, this is consistent with Riemann solvers #:for BIJ, TXY in [(1,1),(2,2),(3,4)] - btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) - #:endfor - else - ! STEP 3: update the btensor, this is consistent with Riemann solvers - ! \b_xx - btensor%vf(1)%sf(j, k, l) = tensorb(1)**2 - end if - - !STEP 3b: store the determinant at the last entry of the btensor - btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) - - ! STEP 4a: updating the Cauchy stress primitive scalar field - if (hyper_model == 1) then - call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) - elseif (hyper_model == 2) then - call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) + btensor%vf(${BIJ}$)%sf(j, k, l) = tensorb(${TXY}$) + #:endfor + end if + else + ! STEP 2a: computing the determinant of the grad_xi tensor + tensorb(tensor_size) = tensora(1) + ! STEP 2b: computing the inverse of the grad_xi tensor + tensorb(1) = 1._wp/tensora(1) + if (tensora(tensor_size) > verysmall) then + ! STEP 3: update the btensor b_xx, this is consistent with Riemann solvers + btensor%vf(1)%sf(j, k, l) = tensorb(1)**2 end if + end if - ! STEP 4b: updating the pressure field - q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & - G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma + !STEP 3b: store the determinant at the last entry of the btensor + btensor%vf(b_size)%sf(j, k, l) = tensorb(tensor_size) - ! STEP 4c: updating the Cauchy stress conservative scalar field - !$acc loop seq - do i = 1, b_size - 1 - q_cons_vf(strxb + i - 1)%sf(j, k, l) = rho*q_prim_vf(strxb + i - 1)%sf(j, k, l) - end do + ! STEP 4a: updating the Cauchy stress primitive scalar field + if (hyper_model == 1) then + call s_neoHookean_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) + elseif (hyper_model == 2) then + call s_Mooney_Rivlin_cauchy_solver(btensor%vf, q_prim_vf, G, j, k, l) end if + + ! STEP 4b: updating the pressure field + q_prim_vf(E_idx)%sf(j, k, l) = q_prim_vf(E_idx)%sf(j, k, l) - & + G*q_prim_vf(xiend + 1)%sf(j, k, l)/gamma + + ! STEP 4c: updating the Cauchy stress conservative scalar field + !$acc loop seq + do i = 1, b_size - 1 + q_cons_vf(strxb + i - 1)%sf(j, k, l) = rho*q_prim_vf(strxb + i - 1)%sf(j, k, l) + end do end if end do end do