diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp new file mode 100644 index 000000000..df7bd13ef --- /dev/null +++ b/src/common/m_checker_common.fpp @@ -0,0 +1,478 @@ +!> +!!@file m_checker_common.f90 +!!@brief Contains module m_checker_common + +!> @brief The purpose of the module is to check for compatible input files for. +!! inputs common to pre-processing, post-processing and simulation +module m_checker_common + + 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_check_inputs_common + +contains + + !> Checks compatibility of parameters in the input file. + !! Used by all three stages + subroutine s_check_inputs_common + +#ifndef MFC_PRE_PROCESS + call s_check_inputs_time_stepping + call s_check_inputs_finite_difference +#endif + +#ifndef MFC_SIMULATION + call s_check_total_cells +#endif + +#ifndef MFC_POST_PROCESS + if (bubbles) call s_check_inputs_bubbles + call s_check_inputs_qbmm_and_polydisperse + if (adv_n) call s_check_inputs_adv_n + if (hypoelasticity) call s_check_inputs_hypoelasticity + call s_check_inputs_phase_change + call s_check_inputs_ibm +#endif + + ! Run by all three stages + call s_check_inputs_simulation_domain + call s_check_inputs_model_eqns_and_num_fluids + call s_check_inputs_weno + call s_check_inputs_bc + call s_check_inputs_stiffened_eos + call s_check_inputs_surface_tension + call s_check_inputs_moving_bc + + end subroutine s_check_inputs_common + +#ifndef MFC_PRE_PROCESS + + !> Checks constraints on the time-stepping parameters. + !! Called by s_check_inputs_common for simulation and post-processing + subroutine s_check_inputs_time_stepping + if (t_step_start < 0) then + call s_mpi_abort('t_step_start must be non-negative. Exiting ...') + elseif (t_step_stop <= t_step_start) then + call s_mpi_abort('t_step_stop must be greater than t_step_start. '// & + 'Exiting ...') + elseif (t_step_save > t_step_stop - t_step_start) then + call s_mpi_abort('t_step_save must be less or equal to '// & + '(t_step_stop - t_step_start). Exiting ...') + end if + end subroutine s_check_inputs_time_stepping + + !> Checks constraints on the finite difference parameters. + !! Called by s_check_inputs_common for simulation and post-processing + subroutine s_check_inputs_finite_difference + if (all(fd_order /= (/dflt_int, 1, 2, 4/))) then + call s_mpi_abort('fd_order must be 1, 2, or 4. Exiting ...') + end if + end subroutine s_check_inputs_finite_difference + +#endif + +#ifndef MFC_SIMULATION + + ! Checks constraints on the total number of cells + subroutine s_check_total_cells + character(len=5) :: numStr !< for int to string conversion + + if (nGlobal < 2**(min(1, m) + min(1, n) + min(1, p))*num_procs) then + call s_int_to_str(2**(min(1, m) + min(1, n) + min(1, p))*num_procs, numStr) + call s_mpi_abort('Total number of cells must be at least '// & + '(2^[number of dimensions])*num_procs, which is currently '// & + trim(numStr)//'. Exiting ...') + end if + end subroutine s_check_total_cells + +#endif + +#ifndef MFC_POST_PROCESS + + !> Checks constraints on the bubble parameters. + !! Called by s_check_inputs_common for pre-processing and simulation + subroutine s_check_inputs_bubbles + if (nb < 1) then + call s_mpi_abort('The Ensemble-Averaged Bubble Model '// & + 'requires nb >= 1. Exiting ...') + elseif (polydisperse .and. (nb == 1)) then + call s_mpi_abort('Polydisperse bubble dynamics requires nb > 1 '// & + 'Exiting ...') + elseif (polydisperse .and. (mod(nb, 2) == 0)) then + call s_mpi_abort('nb must be odd '// & + 'Exiting ...') + elseif ((.not. polytropic) .and. f_is_default(R0ref)) then + call s_mpi_abort('R0ref must be set if using bubbles with '// & + 'polytropic = .false.. Exiting ...') + elseif (nb == dflt_int) then + call s_mpi_abort('nb must be set if using bubbles. Exiting ...') + elseif (thermal > 3) then + call s_mpi_abort('thermal must be less than 4 if using bubbles. '// & + 'Exiting ...') + elseif (model_eqns == 3) then + call s_mpi_abort('Bubble models untested with '// & + '6-equation model (model_eqns = 3). Exiting ...') + elseif (model_eqns == 1) then + call s_mpi_abort('Bubble models untested with '// & + 'pi-gamma model (model_eqns = 1). Exiting ...') + !TODO: Comment this out when testing riemann with hll + elseif (model_eqns == 4 .and. f_is_default(rhoref)) then + call s_mpi_abort('rhoref must be set if using bubbles with '// & + 'model_eqns = 4. Exiting ...') + elseif (model_eqns == 4 .and. f_is_default(pref)) then + call s_mpi_abort('pref must be set if using bubbles with '// & + 'model_eqns = 4. Exiting ...') + elseif (model_eqns == 4 .and. num_fluids > 1) then + call s_mpi_abort('4-equation model (model_eqns = 4) is '// & + 'single-component and requires num_fluids = 1. '// & + 'Exiting ...') + elseif (cyl_coord) then + call s_mpi_abort('Bubble models untested in cylindrical coordinates') + end if + end subroutine s_check_inputs_bubbles + + !> Checks constraints on the QBMM and polydisperse bubble parameters. + !! Called by s_check_inputs_common for pre-processing and simulation + subroutine s_check_inputs_qbmm_and_polydisperse + if ((.not. bubbles) .and. polydisperse) then + call s_mpi_abort('Polydisperse bubble modeling requires the '// & + 'bubbles flag to be set. Exiting ...') + elseif (polydisperse .and. f_is_default(poly_sigma)) then + call s_mpi_abort('Polydisperse bubble modeling requires '// & + 'poly_sigma > 0. Exiting ...') + elseif (qbmm .and. (.not. bubbles)) then + call s_mpi_abort('QBMM is enabled but bubbles are not. Exiting ...') + elseif (qbmm .and. (nnode /= 4)) then + call s_mpi_abort('nnode not supported. Exiting ...') + end if + end subroutine s_check_inputs_qbmm_and_polydisperse + + !> Checks constraints on the adv_n flag. + !! Called by s_check_inputs_common for pre-processing and simulation + subroutine s_check_inputs_adv_n + if (.not. bubbles) then + call s_mpi_abort('adv_n requires bubbles = true.'// & + 'Exiting ...') + else if (num_fluids > 1) then + call s_mpi_abort('adv_n requires num_fluids = 1. '// & + 'Exiting ...') + else if (qbmm) then + call s_mpi_abort('adv_n is incompatible with qbmm.'// & + 'Exiting ...') + end if + end subroutine + + !> 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 ...') + end if + end subroutine s_check_inputs_hypoelasticity + + !> Checks constraints on the phase change parameters. + !! Called by s_check_inputs_common for pre-processing and simulation + subroutine s_check_inputs_phase_change + if (relax) then + if (model_eqns /= 3) then + call s_mpi_abort('phase change requires model_eqns = 3. '// & + 'Exiting ...') + elseif ((relax_model < 0) .or. (relax_model > 6)) then + call s_mpi_abort('relax_model should be in between 0 and 6. '// & + 'Exiting ...') + elseif ((palpha_eps <= 0d0) .or. (palpha_eps >= 1d0)) then + call s_mpi_abort('palpha_eps must be in (0,1). Exiting ...') + elseif ((ptgalpha_eps <= 0d0) .or. (ptgalpha_eps >= 1d0)) then + call s_mpi_abort('ptgalpha_eps must be in (0,1). Exiting ...') + end if + elseif ((relax_model /= dflt_int) .or. (.not. f_is_default(palpha_eps)) & + .or. (.not. f_is_default(ptgalpha_eps))) then + call s_mpi_abort('relax is not set as true, but other phase '// & + 'change parameters have been modified. Either '// & + 'activate phase change or set the values '// & + 'to default. Exiting ...') + end if + end subroutine s_check_inputs_phase_change + + !> Checks constraints on the Immersed Boundaries parameters. + !! Called by s_check_inputs_common for pre-processing and simulation + subroutine s_check_inputs_ibm + if (ib) then + if (n <= 0) then + call s_mpi_abort('ib is enabled but n = 0. '// & + 'Immersed Boundaries do not work in 1D. '// & + 'Exiting ...') + else if (num_ibs <= 0 .or. num_ibs > num_patches_max) then + call s_mpi_abort('num_ibs must be between 1 and '// & + 'num_patches_max. Exiting ...') + end if + end if + + if ((.not. ib) .and. num_ibs > 0) then + call s_mpi_abort('num_ibs is set, but ib is not enabled. Exiting ...') + end if + end subroutine s_check_inputs_ibm + +#endif + + !> 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 + if (m == dflt_int) then + call s_mpi_abort('m must be set. Exiting ...') + elseif (n == dflt_int) then + call s_mpi_abort('n must be set. Exiting ...') + elseif (p == dflt_int) then + call s_mpi_abort('p must be set. Exiting ...') + elseif (m <= 0) then + call s_mpi_abort('m must be positive. Exiting ...') + elseif (n < 0) then + call s_mpi_abort('n must be non-negative. Exiting ...') + elseif (p < 0) then + call s_mpi_abort('p must be non-negative. Exiting ...') + elseif (cyl_coord .and. p > 0 .and. mod(p, 2) /= 1) then + call s_mpi_abort('p must be odd for cylindrical coordinates '// & + '(cyl_coord = T and p != 0). Exiting ...') + elseif (n == 0 .and. p > 0) then + call s_mpi_abort('p must be 0 if n = 0. Exiting ...') + end if + end subroutine s_check_inputs_simulation_domain + + !> Checks constraints on model equations and number of fluids in the flow. + !! Called by s_check_inputs_common for all three stages + subroutine s_check_inputs_model_eqns_and_num_fluids + if (all(model_eqns /= (/1, 2, 3, 4/))) then + call s_mpi_abort('model_eqns must be 1, 2, 3, or 4. Exiting ...') + elseif (num_fluids /= dflt_int .and. num_fluids < 1) then + call s_mpi_abort('num_fluids must be positive. Exiting ...') + elseif (model_eqns == 1 .and. num_fluids /= dflt_int) then + call s_mpi_abort('num_fluids is not supported for '// & + 'model_eqns = 1. Exiting ...') + elseif (model_eqns == 2 .and. num_fluids == dflt_int) then + call s_mpi_abort('5-equation model (model_eqns = 2) '// & + 'requires num_fluids to be set. Exiting ...') + elseif (model_eqns == 3 .and. num_fluids == dflt_int) then + call s_mpi_abort('6-equation model (model_eqns = 3) '// & + 'requires num_fluids to be set. Exiting ...') + elseif (model_eqns == 1 .and. adv_alphan) then + call s_mpi_abort('adv_alphan is not supported for '// & + 'model_eqns = 1. Exiting ...') + elseif (model_eqns == 1 .and. mpp_lim) then + call s_mpi_abort('mpp_lim is not supported for '// & + 'model_eqns = 1. Exiting ...') + elseif (num_fluids == 1 .and. mpp_lim) then + call s_mpi_abort('mpp_lim is not supported for '// & + 'num_fluids = 1. Exiting ...') + elseif (model_eqns == 3 .and. cyl_coord .and. p /= 0) then + call s_mpi_abort('6-equation model (model_eqns = 3) '// & + 'does not support cylindrical coordinates '// & + '(cyl_coord = T and p != 0). Exiting ...') + end if + end subroutine s_check_inputs_model_eqns_and_num_fluids + + !> Checks constraints regarding WENO order. + !! Called by s_check_inputs_common for all three stages + subroutine s_check_inputs_weno + if (all(weno_order /= (/1, 3, 5/))) then + call s_mpi_abort('weno_order must be 1, 3, or 5. Exiting ...') + elseif (m + 1 < weno_order) then + call s_mpi_abort('m must be at least weno_order - 1. Exiting ...') + elseif (n > 0 .and. n + 1 < weno_order) then + call s_mpi_abort('n must be at least weno_order - 1. Exiting ...') + elseif (p > 0 .and. p + 1 < weno_order) then + call s_mpi_abort('p must be at least weno_order - 1. Exiting ...') + end if + end subroutine s_check_inputs_weno + + !> Checks constraints on the boundary conditions in the x-direction. + !! Called by s_check_inputs_common for all three stages + subroutine s_check_inputs_bc + logical :: skip_check !< Flag to skip the check when iterating over + !! x, y, and z directions, for special treatment of cylindrical coordinates + + #:for X, VAR in [('x', 'm'), ('y', 'n'), ('z', 'p')] + #:for BOUND in ['beg', 'end'] + if (${VAR}$ == 0 .and. bc_${X}$%${BOUND}$ /= dflt_int) then + call s_mpi_abort('bc_${X}$%${BOUND}$ is not '// & + 'supported for ${VAR}$ = 0. Exiting ...') + elseif (${VAR}$ > 0 .and. bc_${X}$%${BOUND}$ == dflt_int) then + call s_mpi_abort('${VAR}$ != 0 but bc_${X}$%${BOUND}$ '// & + 'is not set. Exiting ...') + elseif ((bc_${X}$%beg == -1 .and. bc_${X}$%end /= -1) & + .or. & + (bc_${X}$%end == -1 .and. bc_${X}$%beg /= -1)) then + call s_mpi_abort('bc_${X}$%beg and bc_${X}$%end '// & + 'must be both periodic (= -1) or both '// & + 'non-periodic. Exiting ...') + end if + + ! For cylindrical coordinates, y and z directions use a different check + #:if (X == 'y') or (X == 'z') + skip_check = cyl_coord + #:else + skip_check = .false. + #:endif + + if (.not. skip_check) then + if (bc_${X}$%${BOUND}$ /= dflt_int) then + if (bc_${X}$%${BOUND}$ > -1 .or. bc_${X}$%${BOUND}$ < -16) then + call s_mpi_abort('bc_${X}$%${BOUND}$ must be '// & + 'between -1 and -16. Exiting ...') + elseif (bc_${X}$%${BOUND}$ == -14) then + call s_mpi_abort('bc_${X}$%${BOUND}$ must not '// & + 'be -14 for non-cylindrical '// & + 'coordinates. Exiting ...') + end if + end if + end if + + #:endfor + #:endfor + + if (any((/bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, bc_z%end/) == -13)) then + call s_mpi_abort('Boundary condition -13 is not supported. Exiting ...') + end if + + ! Check for y and z directions for cylindrical coordinates + if (cyl_coord) then + if (n == 0) then + call s_mpi_abort('n must be positive for cylindrical '// & + 'coordinates. Exiting ...') + elseif (p > 0 .and. bc_y%beg /= -14) then + call s_mpi_abort('bc_y%beg must be -14 for 3D cylindrical '// & + 'coordinates (p > 0). Exiting ...') + elseif (p == 0 .and. bc_y%beg /= -2) then + call s_mpi_abort('bc_y%beg must be -2 for 2D cylindrical '// & + 'coordinates (p = 0). Exiting ...') + elseif (bc_y%end > -1 .or. bc_y%end < -16) then + call s_mpi_abort('bc_y%end must be between -1 and -16. '// & + 'Exiting ...') + elseif (bc_y%end == -14) then + call s_mpi_abort('bc_y%end must not be -14. Exiting ...') + end if + + ! 3D cylindrical coordinates + if (p /= 0) then + if (bc_z%beg /= -1 .and. bc_z%beg /= -2) then + call s_mpi_abort('bc_z%beg must be -1 or -2 for 3D '// & + 'cylindrical coordinates. Exiting ...') + elseif (bc_z%end /= -1 .and. bc_z%end /= -2) then + call s_mpi_abort('bc_z%end must be -1 or -2 for 3D '// & + 'cylindrical coordinates. Exiting ...') + end if + end if + end if + end subroutine s_check_inputs_bc + + !> Checks constraints on the stiffened equation of state fluids parameters. + !! Called by s_check_inputs_common for all three stages + subroutine s_check_inputs_stiffened_eos + character(len=5) :: iStr !< for int to string conversion + integer :: bub_fac !< For allowing an extra fluid_pp if there are subgrid bubbles + integer :: i + + bub_fac = 0 + if (bubbles .and. (num_fluids == 1)) bub_fac = 1 + + do i = 1, num_fluids + call s_int_to_str(i, iStr) + if (.not. f_is_default(fluid_pp(i)%gamma) & + .and. & + fluid_pp(i)%gamma <= 0d0) then + call s_mpi_abort('fluid_pp('//trim(iStr)//')%'// & + 'gamma must be positive. Exiting ...') + elseif (model_eqns == 1 & + .and. & + (.not. f_is_default(fluid_pp(i)%gamma))) then + call s_mpi_abort('model_eqns = 1 does not support '// & + 'fluid_pp('//trim(iStr)//')%'// & + 'gamma. Exiting ...') + elseif ((i <= num_fluids + bub_fac .and. fluid_pp(i)%gamma <= 0d0) & + .or. & + (i > num_fluids + bub_fac .and. & + (.not. f_is_default(fluid_pp(i)%gamma)))) & + then + call s_mpi_abort('Unsupported combination '// & + 'of values of num_fluids '// & + 'and fluid_pp('//trim(iStr)//')%'// & + 'gamma. Exiting ...') + elseif (.not. f_is_default(fluid_pp(i)%pi_inf) & + .and. & + fluid_pp(i)%pi_inf < 0d0) then + call s_mpi_abort('fluid_pp('//trim(iStr)//')%'// & + 'pi_inf must be non-negative. Exiting ...') + elseif (model_eqns == 1 & + .and. & + .not. f_is_default(fluid_pp(i)%pi_inf)) then + call s_mpi_abort('model_eqns = 1 does not support '// & + 'fluid_pp('//trim(iStr)//')%'// & + 'pi_inf. Exiting ...') + elseif ((i <= num_fluids + bub_fac .and. fluid_pp(i)%pi_inf < 0d0) & + .or. & + (i > num_fluids + bub_fac .and. (.not. f_is_default(fluid_pp(i)%pi_inf)))) & + then + call s_mpi_abort('Unsupported combination '// & + 'of values of num_fluids '// & + 'and fluid_pp('//trim(iStr)//')%'// & + 'pi_inf. Exiting ...') + elseif (fluid_pp(i)%cv < 0d0) then + call s_mpi_abort('fluid_pp('//trim(iStr)//')%'// & + 'cv must be positive. Exiting ...') + end if + end do + end subroutine s_check_inputs_stiffened_eos + + !> Checks constraints on the surface tension parameters. + !! Called by s_check_inputs_common for all three stages + subroutine s_check_inputs_surface_tension + if (.not. f_is_default(sigma) .and. sigma < 0d0) then + call s_mpi_abort('The surface tension coefficient must be'// & + 'greater than or equal to zero. Exiting ...') + elseif (.not. f_is_default(sigma) .and. model_eqns /= 3) then + call s_mpi_abort("The surface tension model requires"// & + 'model_eqns=3. Exiting ...') + end if + end subroutine s_check_inputs_surface_tension + + !> Checks constraints on the inputs for moving boundaries. + !! Called by s_check_inputs_common for all three stages + subroutine s_check_inputs_moving_bc + #:for X, VB2, VB3 in [('x', 'vb2', 'vb3'), ('y', 'vb3', 'vb1'), ('z', 'vb1', 'vb2')] + if (any((/bc_${X}$%vb1, bc_${X}$%vb2, bc_${X}$%vb3/) /= 0d0)) then + if (bc_${X}$%beg == -15) then + if (any((/bc_${X}$%${VB2}$, bc_${X}$%${VB3}$/) /= 0d0)) then + call s_mpi_abort("bc_${X}$%beg must be -15 if "// & + "bc_${X}$%${VB2}$ or bc_${X}$%${VB3}$ "// & + "is set. Exiting ...") + end if + elseif (bc_${X}$%beg /= -16) then + call s_mpi_abort("bc_${X}$%beg must be -15 or -16 if "// & + "bc_${X}$%vb[1,2,3] is set. Exiting ...") + end if + end if + #:endfor + + #:for X, VE2, VE3 in [('x', 've2', 've3'), ('y', 've3', 've1'), ('z', 've1', 've2')] + if (any((/bc_${X}$%ve1, bc_${X}$%ve2, bc_${X}$%ve3/) /= 0d0)) then + if (bc_${X}$%end == -15) then + if (any((/bc_${X}$%${VE2}$, bc_${X}$%${VE3}$/) /= 0d0)) then + call s_mpi_abort("bc_${X}$%end must be -15 if "// & + "bc_${X}$%${VE2}$ or bc_${X}$%${VE3}$ "// & + "is set. Exiting ...") + end if + elseif (bc_${X}$%end /= -16) then + call s_mpi_abort("bc_${X}$%end must be -15 or -16 if "// & + "bc_${X}$%ve[1,2,3] is set. Exiting ...") + end if + end if + #:endfor + end subroutine s_check_inputs_moving_bc + +end module m_checker_common diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp index b6d487297..b41ff20bf 100644 --- a/src/common/m_helper.fpp +++ b/src/common/m_helper.fpp @@ -36,7 +36,10 @@ module m_helper f_create_bbox, & s_print_2D_array, & f_xor, & - f_logical_to_int + f_logical_to_int, & + f_approx_equal, & + f_is_default, & + f_all_default contains @@ -532,4 +535,56 @@ contains end if end function f_logical_to_int + !> This procedure checks if two floating point numbers of kind(0d0) are within tolerance. + !! @param a First number. + !! @param b Second number. + !! @param tol_input Relative error (default = 1d-6). + !! @return Result of the comparison. + logical function f_approx_equal(a, b, tol_input) result(res) + ! Reference: https://floating-point-gui.de/errors/comparison/ + + real(kind(0d0)), intent(in) :: a, b + real(kind(0d0)), optional, intent(in) :: tol_input + real(kind(0d0)) :: tol + + if (present(tol_input)) then + if (tol_input <= 0d0) then + call s_mpi_abort('tol_input must be positive. Exiting ...') + end if + tol = tol_input + else + tol = 1d-6 + end if + + if (a == b) then + res = .true. + else if (a == 0d0 .or. b == 0d0 .or. (abs(a) + abs(b) < tiny(a))) then + res = (abs(a - b) < (tol*tiny(a))) + else + res = (abs(a - b)/min(abs(a) + abs(b), huge(a)) < tol) + end if + end function f_approx_equal + + !> Checks if a real(kind(0d0)) variable is of default value. + !! @param var Variable to check. + logical function f_is_default(var) result(res) + real(kind(0d0)), intent(in) :: var + + res = f_approx_equal(var, dflt_real) + end function f_is_default + + !> Checks if ALL elements of a real(kind(0d0)) array are of default value. + !! @param var_array Array to check. + logical function f_all_default(var_array) result(res) + real(kind(0d0)), intent(in) :: var_array(:) + logical :: res_array(size(var_array)) + integer :: i + + do i = 1, size(var_array) + res_array(i) = f_is_default(var_array(i)) + end do + + res = all(res_array) + end function f_all_default + end module m_helper diff --git a/src/post_process/m_checker.f90 b/src/post_process/m_checker.f90 index f8d712cb4..89a7fa8e2 100644 --- a/src/post_process/m_checker.f90 +++ b/src/post_process/m_checker.f90 @@ -17,474 +17,162 @@ module m_checker contains + !> Checks compatibility of parameters in the input file. + !! Used by the post_process stage subroutine s_check_inputs - integer :: bub_fac - integer :: i - character(len=5) :: iStr - - bub_fac = 0; - if (bubbles .and. (num_fluids == 1)) bub_fac = 1 - - ! Constraints on dimensionality and the number of cells for the grid - if (m <= 0) then - call s_mpi_abort('Unsupported choice for the value of m. '// & - 'Exiting ...') - elseif (n < 0) then - call s_mpi_abort('Unsupported choice for the value of n. '// & - 'Exiting ...') - elseif (p < 0) then - call s_mpi_abort('Unsupported choice for the value of p. '// & - 'Exiting ...') - elseif (cyl_coord .and. p > 0 .and. mod(p, 2) /= 1) then - call s_mpi_abort('Unsupported choice for the value of p. '// & - 'Exiting ...') - elseif (n == 0 .and. p > 0) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for n and p. Exiting ...') - elseif (nGlobal < 2**(min(1, m) + min(1, n) + min(1, p))*num_procs) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for num_procs, m, n and p. '// & - 'Exiting ...') - - ! Constraints on the time-stepping parameters - elseif (t_step_start < 0) then - call s_mpi_abort('Unsupported choice for the value of '// & - 't_step_start. Exiting ...') - elseif (t_step_stop < t_step_start) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for t_step_start and t_step_stop. '// & - 'Exiting ...') - elseif (t_step_save > t_step_stop - t_step_start) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for t_step_start, t_step_stop and '// & - 't_step_save. Exiting ...') - - ! Constraints on model equations and number of fluids in the flow - elseif (all(model_eqns /= (/1, 2, 3, 4/))) then - call s_mpi_abort('Unsupported value of model_eqns. Exiting ...') - elseif (num_fluids /= dflt_int & - .and. & - (num_fluids < 1 .or. num_fluids > num_fluids)) then - call s_mpi_abort('Unsupported value of num_fluids. Exiting ...') - elseif ((model_eqns == 1 .and. num_fluids /= dflt_int) & - .or. & - (model_eqns == 2 .and. num_fluids == dflt_int) & - .or. & - (model_eqns == 3 .and. num_fluids == dflt_int)) then - call s_mpi_abort('Unsupported combination of values of '// & - 'model_eqns and num_fluids. '// & - 'Exiting ...') - elseif (model_eqns == 1 .and. adv_alphan) then - call s_mpi_abort('Unsupported combination of values of '// & - 'model_eqns and adv_alphan. '// & - 'Exiting ...') - - ! Constraints on the order of the WENO scheme - elseif (weno_order /= 1 .and. weno_order /= 3 & - .and. & - weno_order /= 5) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'weno_order. Exiting ...') - elseif (m + 1 < weno_order) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for m and weno_order. Exiting ...') - elseif (n > 0 .and. n + 1 < weno_order) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for n and weno_order. Exiting ...') - elseif (p > 0 .and. p + 1 < weno_order) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for p and weno_order. Exiting ...') - elseif (nGlobal < weno_order**(min(1, m) + min(1, n) + min(1, p))*num_procs) & - then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for num_procs, m, n, p and '// & - 'weno_order. Exiting ...') - - ! Constraints on the boundary conditions in the x-direction - elseif (bc_x%beg < -16 .or. bc_x%beg > -1 .or. bc_x%beg == -14) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'bc_x%beg. Exiting ...') - elseif (bc_x%end < -16 .or. bc_x%end > -1 .or. bc_x%beg == -14) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'bc_x%end. Exiting ...') - elseif ((bc_x%beg == -1 .and. bc_x%end /= -1) & - .or. & - (bc_x%end == -1 .and. bc_x%beg /= -1)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for bc_x%beg and bc_x%end. '// & - 'Exiting ...') + call s_check_inputs_output_format + call s_check_inputs_partial_density + call s_check_inputs_velocity + call s_check_inputs_flux_limiter + call s_check_inputs_volume_fraction + call s_check_inputs_vorticity + call s_check_inputs_schlieren + call s_check_inputs_surface_tension + call s_check_inputs_no_flow_variables - ! Constraints on the boundary conditions in the y-direction - elseif (bc_y%beg /= dflt_int & - .and. & - ((((cyl_coord .neqv. .true.) & - .or. & - (cyl_coord .and. p == 0)) & - .and. & - (bc_y%beg < -16 .or. bc_y%beg > -1 .or. bc_y%beg == -14)) & - .or. & - (cyl_coord .and. p > 0 & - .and. & - (bc_y%beg < -16 .or. bc_y%beg > -1)))) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'bc_y%beg. Exiting ...') - elseif (bc_y%end /= dflt_int & - .and. & - (bc_y%end < -16 .or. bc_y%end > -1 .or. bc_y%end == -14)) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'bc_y%end. Exiting ...') - elseif ((n == 0 .and. bc_y%beg /= dflt_int) & - .or. & - (n > 0 .and. bc_y%beg == dflt_int)) then - call s_mpi_abort('Unsupported choice for the value of n and '// & - 'bc_y%beg. Exiting ...') - elseif ((n == 0 .and. bc_y%end /= dflt_int) & - .or. & - (n > 0 .and. bc_y%end == dflt_int)) then - call s_mpi_abort('Unsupported choice for the value of n and '// & - 'bc_y%end. Exiting ...') - elseif (n > 0 & - .and. & - ((bc_y%beg == -1 .and. bc_y%end /= -1) & - .or. & - (bc_y%end == -1 .and. bc_y%beg /= -1))) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for n, bc_y%beg and bc_y%end. '// & - 'Exiting ...') - - ! Constraints on the boundary conditions in the z-direction - elseif (bc_z%beg /= dflt_int & - .and. & - (bc_z%beg < -16 .or. bc_z%beg > -1 .or. bc_z%beg == -14)) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'bc_z%beg. Exiting ...') - elseif (bc_z%end /= dflt_int & - .and. & - (bc_z%end < -16 .or. bc_z%end > -1 .or. bc_z%end == -14)) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'bc_z%end. Exiting ...') - elseif (any((/bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, bc_z%end/) == -13)) then - call s_mpi_abort('Unsupported choice of boundary condition -13') - elseif ((p == 0 .and. bc_z%beg /= dflt_int) & - .or. & - (p > 0 .and. bc_z%beg == dflt_int)) then - call s_mpi_abort('Unsupported choice for the value of p and '// & - 'bc_z%beg. Exiting ...') - elseif ((p == 0 .and. bc_z%end /= dflt_int) & - .or. & - (p > 0 .and. bc_z%end == dflt_int)) then - call s_mpi_abort('Unsupported choice for the value of p and '// & - 'bc_z%end. Exiting ...') - elseif (p > 0 & - .and. & - ((bc_z%beg == -1 .and. bc_z%end /= -1) & - .or. & - (bc_z%end == -1 .and. bc_z%beg /= -1))) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for p, bc_z%beg and bc_z%end. '// & - 'Exiting ...') - end if - - ! Constraints on the stiffened equation of state fluids parameters - do i = 1, num_fluids - call s_int_to_str(i, iStr) - if (fluid_pp(i)%gamma /= dflt_real & - .and. & - fluid_pp(i)%gamma <= 0d0) then - call s_mpi_abort('Unsupported value of '// & - 'fluid_pp('//trim(iStr)//')%'// & - 'gamma. Exiting ...') - elseif (model_eqns == 1 & - .and. & - fluid_pp(i)%gamma /= dflt_real) then - call s_mpi_abort('Unsupported combination '// & - 'of values of model_eqns '// & - 'and fluid_pp('//trim(iStr)//')%'// & - 'gamma. Exiting ...') - elseif ((i <= num_fluids + bub_fac .and. fluid_pp(i)%gamma <= 0d0) & - .or. & - (i > num_fluids + bub_fac .and. fluid_pp(i)%gamma /= dflt_real)) & - then - call s_mpi_abort('Unsupported combination '// & - 'of values of num_fluids '// & - 'and fluid_pp('//trim(iStr)//')%'// & - 'gamma. Exiting ...') - elseif (fluid_pp(i)%pi_inf /= dflt_real & - .and. & - fluid_pp(i)%pi_inf < 0d0) then - call s_mpi_abort('Unsupported value of '// & - 'fluid_pp('//trim(iStr)//')%'// & - 'pi_inf. Exiting ...') - elseif (model_eqns == 1 & - .and. & - fluid_pp(i)%pi_inf /= dflt_real) then - call s_mpi_abort('Unsupported combination '// & - 'of values of model_eqns '// & - 'and fluid_pp('//trim(iStr)//')%'// & - 'pi_inf. Exiting ...') - elseif ((i <= num_fluids + bub_fac .and. fluid_pp(i)%pi_inf < 0d0) & - .or. & - (i > num_fluids + bub_fac .and. fluid_pp(i)%pi_inf /= dflt_real)) & - then - call s_mpi_abort('Unsupported combination '// & - 'of values of num_fluids '// & - 'and fluid_pp('//trim(iStr)//')%'// & - 'pi_inf. Exiting ...') - end if - - end do + end subroutine s_check_inputs - ! Constraints on the format of the formatted database file(s) + !> Checks constraints on output format parameters + subroutine s_check_inputs_output_format if (format /= 1 .and. format /= 2) then - call s_mpi_abort('Unsupported choice for the value of format. '// & - 'Exiting ...') - - ! Constraints on the precision of the formatted database file(s) + call s_mpi_abort('format must be 1 or 2. Exiting ...') elseif (precision /= 1 .and. precision /= 2) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'precision. Exiting ...') + call s_mpi_abort('precision must be 1 or 2. Exiting ...') end if + end subroutine s_check_inputs_output_format + + !> Checks constraints on partial density parameters + subroutine s_check_inputs_partial_density + character(len=5) :: iStr + integer :: i - ! Constraints on the post-processing of the partial densities do i = 1, num_fluids - call s_int_to_str(i, iStr) - if (((i > num_fluids .or. model_eqns == 1) & - .and. & - alpha_rho_wrt(i)) & - .or. & - ((i <= num_fluids .and. model_eqns == 1) & - .and. & - alpha_rho_wrt(i))) then - call s_mpi_abort('Unsupported choice of the '// & - 'combination of values for '// & - 'model_eqns, num_fluids and '// & - 'alpha_rho_wrt('//trim(iStr)//'). Exiting ...') + if (alpha_rho_wrt(i)) then + call s_int_to_str(i, iStr) + if (model_eqns == 1) then + call s_mpi_abort('alpha_rho_wrt('//trim(iStr)//') is not '// & + 'supported for model_eqns = 1. Exiting ...') + end if + if (i > num_fluids) then + call s_mpi_abort('Index of alpha_rho_wrt('//trim(iStr)//') '// & + 'exceeds the total number of fluids. Exiting ...') + end if end if end do + end subroutine s_check_inputs_partial_density - ! Constraints on the post-processing of the momentum + !> Checks constraints on momentum parameters + subroutine s_check_inputs_momentum if (n == 0 .and. mom_wrt(2)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for n and mom_wrt(2). Exiting ...') - elseif (n == 0 .and. mom_wrt(3)) then - call s_mpi_abort('Unsupported cohice of the combination of '// & - 'values for n and mom_wrt(3). Exiting ...') + call s_mpi_abort('mom_wrt(2) is not supported for n = 0. Exiting ...') elseif (p == 0 .and. mom_wrt(3)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for p and mom_wrt(3). Exiting ...') + call s_mpi_abort('mom_wrt(3) is not supported for p = 0. Exiting ...') + end if + end subroutine s_check_inputs_momentum - ! Constraints on the post-processing of the velocity - elseif (n == 0 .and. vel_wrt(2)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for n and vel_wrt(2). Exiting ...') - elseif (n == 0 .and. vel_wrt(3)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for n and vel_wrt(3). Exiting ...') + !> Checks constraints on velocity parameters + subroutine s_check_inputs_velocity + if (n == 0 .and. vel_wrt(2)) then + call s_mpi_abort('vel_wrt(2) is not supported for n = 0. Exiting ...') elseif (p == 0 .and. vel_wrt(3)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for p and vel_wrt(3). Exiting ...') + call s_mpi_abort('vel_wrt(3) is not supported for p = 0. Exiting ...') end if + end subroutine s_check_inputs_velocity - ! Constraints on the post-processing of the flux limiter function + !> Checks constraints on flux limiter parameters + subroutine s_check_inputs_flux_limiter if (n == 0 .and. flux_wrt(2)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for n and flux_wrt(2). Exiting ...') - elseif (n == 0 .and. flux_wrt(3)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for n and flux_wrt(3). Exiting ...') + call s_mpi_abort('flux_wrt(2) is not supported for n = 0. Exiting ...') elseif (p == 0 .and. flux_wrt(3)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for p and flux_wrt(3). Exiting ...') + call s_mpi_abort('flux_wrt(3) is not supported for p = 0. Exiting ...') elseif (all(flux_lim /= (/dflt_int, 1, 2, 3, 4, 5, 6, 7/))) then - call s_mpi_abort('Unsupported value of flux_lim. Exiting ...') + call s_mpi_abort('flux_lim must be between 1 and 7. Exiting ...') end if + end subroutine s_check_inputs_flux_limiter - ! Constraints on the post-processing of the volume fractions - do i = 1, num_fluids - call s_int_to_str(i, iStr) - if (((i > num_fluids .or. model_eqns == 1) & - .and. & - alpha_wrt(i)) & - .or. & - ((i <= num_fluids .and. model_eqns == 1) & - .and. & - alpha_wrt(i))) then - call s_mpi_abort('Unsupported choice of the '// & - 'combination of values for '// & - 'model_eqns, num_fluids and '// & - 'alpha_wrt('//trim(iStr)//'). Exiting ...') - end if - end do - - ! Constraints on the post-processing of the vorticity - if (n == 0 .and. omega_wrt(1)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for n and omega_wrt(1). Exiting ...') - elseif (n == 0 .and. omega_wrt(2)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for n and omega_wrt(2). Exiting ...') - elseif (n == 0 .and. omega_wrt(3)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for n and omega_wrt(3). Exiting ...') - elseif (p == 0 .and. omega_wrt(1)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for p and omega_wrt(1). Exiting ...') - elseif (p == 0 .and. omega_wrt(2)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for p and omega_wrt(2). Exiting ...') - - ! Constraints on post-processing of numerical Schlieren function - elseif (n == 0 .and. schlieren_wrt) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for n and schlieren_wrt. Exiting ...') - - ! Constraints on post-processing combination of flow variables - elseif ((any(alpha_rho_wrt) .neqv. .true.) & - .and. & - (any(mom_wrt) .neqv. .true.) & - .and. & - (any(vel_wrt) .neqv. .true.) & - .and. & - (any(flux_wrt) .neqv. .true.) & - .and. & - (any((/rho_wrt, E_wrt, pres_wrt, & - gamma_wrt, heat_ratio_wrt, & - pi_inf_wrt, pres_inf_wrt, & - cons_vars_wrt, & - prim_vars_wrt, & - c_wrt, schlieren_wrt/)) .neqv. .true.) & - .and. & - (any(alpha_wrt) .neqv. .true.) & - .and. & - (any(omega_wrt) .neqv. .true.)) then - call s_mpi_abort('None of the flow variables have been '// & - 'selected for post-process. Exiting ...') - end if + !> Checks constraints on volume fraction parameters + subroutine s_check_inputs_volume_fraction + character(len=5) :: iStr + integer :: i - ! Constraints on the coefficients of numerical Schlieren function do i = 1, num_fluids - call s_int_to_str(i, iStr) - if (schlieren_alpha(i) /= dflt_real & - .and. & - schlieren_alpha(i) <= 0d0) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'schlieren_alpha('//trim(iStr)//'). Exiting ...') - elseif (((i > num_fluids .or. (schlieren_wrt .neqv. .true.)) & - .and. & - schlieren_alpha(i) /= dflt_real) & - .or. & - ((i <= num_fluids .and. schlieren_wrt) & - .and. & - schlieren_alpha(i) <= 0d0)) then - call s_mpi_abort('Unsupported choice of the '// & - 'combination of values for '// & - 'num_fluids, schlieren_wrt and '// & - 'schlieren_alpha('//trim(iStr)//'). Exiting ...') - end if - end do - - ! Constraints on the order of the finite difference scheme - if (fd_order /= dflt_int & - .and. & - fd_order /= 1 .and. fd_order /= 2 .and. fd_order /= 4) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'fd_order. Exiting ...') - elseif ((any(omega_wrt) .or. schlieren_wrt) & - .and. & - fd_order == dflt_int) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for omega_wrt, schlieren_wrt and '// & - 'fd_order. Exiting ...') - end if - - ! Moving Boundaries Checks: x boundaries - if (any((/bc_x%vb1, bc_x%vb2, bc_x%vb3/) /= 0d0)) then - if (bc_x%beg == 15) then - if (any((/bc_x%vb2, bc_x%vb3/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_x%beg and"// & - "bc_x%vb2 or bc_x%vb3. Exiting ...") + if (alpha_wrt(i)) then + call s_int_to_str(i, iStr) + if (model_eqns == 1) then + call s_mpi_abort('alpha_wrt('//trim(iStr)//') is not '// & + 'supported for model_eqns = 1. Exiting ...') end if - elseif (bc_x%beg /= -16) then - call s_mpi_abort("Unsupported combination of bc_x%beg and"// & - "bc_x%vb1, bc_x%vb2, or bc_x%vb3. Exiting...") - end if - end if - - if (any((/bc_x%ve1, bc_x%ve2, bc_x%ve3/) /= 0d0)) then - if (bc_x%end == 15) then - if (any((/bc_x%ve2, bc_x%ve3/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_x%end and"// & - "bc_x%ve2 or bc_x%ve3. Exiting ...") - end if - elseif (bc_x%end /= -16) then - call s_mpi_abort("Unsupported combination of bc_x%end and"// & - "bc_x%ve1, bc_x%ve2, or bc_x%ve3. Exiting...") - end if - end if - - ! Moving Boundaries Checks: y boundaries - if (any((/bc_y%vb1, bc_y%vb2, bc_y%vb3/) /= 0d0)) then - if (bc_y%beg == 15) then - if (any((/bc_y%vb1, bc_y%vb3/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_y%beg and"// & - "bc_y%vb1 or bc_y%vb3. Exiting ...") + if (i > num_fluids) then + call s_mpi_abort('Index of alpha_wrt('//trim(iStr)//') '// & + 'exceeds the total number of fluids. Exiting ...') end if - elseif (bc_y%beg /= -16) then - call s_mpi_abort("Unsupported combination of bc_y%beg and"// & - "bc_y%vb1, bc_y%vb2, or bc_y%vb3. Exiting...") end if + end do + end subroutine s_check_inputs_volume_fraction + + !> Checks constraints on vorticity parameters + subroutine s_check_inputs_vorticity + if (n == 0 .and. any(omega_wrt)) then + call s_mpi_abort('omega_wrt is not supported for n = 0. Exiting ...') + elseif (p == 0 .and. (omega_wrt(1) .or. omega_wrt(2))) then + call s_mpi_abort('omega_wrt(1) and omega_wrt(2) are not supported '// & + 'for p = 0. Exiting ...') + elseif (any(omega_wrt) .and. fd_order == dflt_int) then + call s_mpi_abort('fd_order must be set for omega_wrt. Exiting ...') end if + end subroutine s_check_inputs_vorticity - if (any((/bc_y%ve1, bc_y%ve2, bc_y%ve3/) /= 0d0)) then - if (bc_y%end == 15) then - if (any((/bc_y%ve1, bc_y%ve3/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_y%end and"// & - "bc_y%ve1 or bc_y%ve3. Exiting ...") - end if - elseif (bc_y%end /= -16) then - call s_mpi_abort("Unsupported combination of bc_y%end and"// & - "bc_y%ve1, bc_y%ve2, or bc_y%ve3. Exiting...") - end if - end if + !> Checks constraints on numerical Schlieren parameters + !! (schlieren_wrt and schlieren_alpha) + subroutine s_check_inputs_schlieren + character(len=5) :: iStr + integer :: i - ! Moving Boundaries Checks: z boundaries - if (any((/bc_z%vb1, bc_z%vb2, bc_z%vb3/) /= 0d0)) then - if (bc_z%beg == 15) then - if (any((/bc_x%vb1, bc_x%vb2/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_z%beg and"// & - "bc_x%vb1 or bc_x%vb1. Exiting ...") - end if - elseif (bc_z%beg /= -16) then - call s_mpi_abort("Unsupported combination of bc_z%beg and"// & - "bc_z%vb1, bc_z%vb2, or bc_z%vb3. Exiting...") - end if + if (n == 0 .and. schlieren_wrt) then + call s_mpi_abort('schlieren_wrt is not supported for n = 0. Exiting ...') + elseif (schlieren_wrt .and. fd_order == dflt_int) then + call s_mpi_abort('fd_order must be set for schlieren_wrt. Exiting ...') end if - if (any((/bc_z%ve1, bc_z%ve2, bc_z%ve3/) /= 0d0)) then - if (bc_z%end == 15) then - if (any((/bc_x%ve1, bc_x%ve2/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_z%end and"// & - "bc_z%ve2 or bc_z%ve3. Exiting ...") + do i = 1, num_fluids + if (.not. f_is_default(schlieren_alpha(i))) then + call s_int_to_str(i, iStr) + if (schlieren_alpha(i) <= 0d0) then + call s_mpi_abort('schlieren_alpha('//trim(iStr)//') must be '// & + 'greater than zero. Exiting ...') + elseif (i > num_fluids) then + call s_mpi_abort('Index of schlieren_alpha('//trim(iStr)//') '// & + 'exceeds the total number of fluids. Exiting ...') + elseif (.not. schlieren_wrt) then + call s_mpi_abort('schlieren_alpha('//trim(iStr)//') should '// & + 'be set only with schlieren_wrt enabled. Exiting ...') end if - elseif (bc_z%end /= -16) then - call s_mpi_abort("Unsupported combination of bc_z%end and"// & - "bc_z%ve1, bc_z%ve2, or bc_z%ve3. Exiting...") end if - end if + end do + end subroutine s_check_inputs_schlieren - ! Constraints on the surface tension model - if (sigma /= dflt_real .and. sigma < 0d0) then - call s_mpi_abort('The surface tension coefficient must be'// & - 'greater than or equal to zero. Exiting ...') - elseif (sigma /= dflt_real .and. model_eqns /= 3) then - call s_mpi_abort("The surface tension model requires"// & - 'model_eqns=3. Exiting ...') - elseif (sigma == dflt_real .and. cf_wrt) then + !> Checks constraints on surface tension parameters (cf_wrt and sigma) + subroutine s_check_inputs_surface_tension + if (f_is_default(sigma) .and. cf_wrt) then call s_mpi_abort('cf_wrt can only be anabled if the surface'// & 'coefficient is set') end if - - end subroutine s_check_inputs + end subroutine s_check_inputs_surface_tension + + !> Checks constraints on the absence of flow variables + subroutine s_check_inputs_no_flow_variables + if (.not. any([ & + (/rho_wrt, E_wrt, pres_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])) then + call s_mpi_abort('None of the flow variables have been '// & + 'selected for post-process. Exiting ...') + end if + end subroutine s_check_inputs_no_flow_variables end module m_checker diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 8cf0fd4a1..55659e254 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -31,6 +31,8 @@ module m_start_up use m_compile_specific + use m_checker_common + use m_checker ! ========================================================================== @@ -131,6 +133,7 @@ subroutine s_check_input_file 'case_dir. Exiting ...') end if + call s_check_inputs_common() call s_check_inputs() end subroutine s_check_input_file diff --git a/src/pre_process/m_check_patches.fpp b/src/pre_process/m_check_patches.fpp index 535c3208f..d73baa662 100644 --- a/src/pre_process/m_check_patches.fpp +++ b/src/pre_process/m_check_patches.fpp @@ -49,9 +49,9 @@ contains elseif (patch_icpp(i)%geometry == 5) then call s_check_ellipse_patch_geometry(i) elseif (patch_icpp(i)%geometry == 6) then - call s_mpi_abort('Unimplemented choice of geometry 6'// & - ' (formerly "Vortex") of active patch '//trim(iStr)// & - ' detected. Exiting ...') + call s_mpi_abort('geometry 6 (formerly "Vortex")'// & + 'is no longer supported for patch '//trim(iStr)// & + '. Exiting ...') elseif (patch_icpp(i)%geometry == 7) then call s_check_2D_analytical_patch_geometry(i) elseif (patch_icpp(i)%geometry == 8) then @@ -83,17 +83,15 @@ contains elseif (patch_icpp(i)%geometry == 21) then call s_check_model_geometry(i) else - call s_mpi_abort('Unsupported choice of the '// & - 'geometry of active patch '//trim(iStr)// & - ' detected. Exiting ...') + call s_mpi_abort('patch_icpp('//trim(iStr)//')%geometry '// & + 'must be between 1 and 21. Exiting ...') end if else if (patch_icpp(i)%geometry == dflt_int) then call s_check_inactive_patch_geometry(i) else - call s_mpi_abort('Unsupported choice of the '// & - 'geometry of inactive patch '//trim(iStr)// & - ' detected. Exiting ...') + call s_mpi_abort('patch_icpp('//trim(iStr)//')%geometry '// & + 'must must be set. Exiting ...') end if end if end do @@ -145,18 +143,19 @@ contains integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) - ! Constraints on the geometric parameters of the line segment patch - if (n > 0 .or. patch_icpp(patch_id)%length_x <= 0d0 & - .or. & - patch_icpp(patch_id)%x_centroid == dflt_real & - .or. & - cyl_coord) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of line segment '// & + if (n > 0) then + call s_mpi_abort('n must be zero for line segment '// & 'patch '//trim(iStr)//'. Exiting ...') - + elseif (patch_icpp(patch_id)%length_x <= 0d0) then + call s_mpi_abort('length_x must be greater than zero for '// & + 'line segment patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%x_centroid)) then + call s_mpi_abort('x_centroid must be set for line segment '// & + 'patch '//trim(iStr)//'. Exiting ...') + elseif (cyl_coord) then + call s_mpi_abort('cyl_coord is not supported for '// & + 'line segment patch '//trim(iStr)//'. Exiting ...') end if end subroutine s_check_line_segment_patch_geometry @@ -171,16 +170,21 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the circle patch - 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 circle '// & - 'patch '//trim(iStr)//'. Exiting ...') - + if (n == 0) then + call s_mpi_abort('n must be greater than zero for '// & + 'circle patch '//trim(iStr)//'. Exiting ...') + elseif (p > 0) then + call s_mpi_abort('p must be zero for circle patch '//trim(iStr)// & + '. Exiting ...') + elseif (patch_icpp(patch_id)%radius <= 0d0) then + call s_mpi_abort('radius must be greater than zero for '// & + 'circle patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%x_centroid)) then + call s_mpi_abort('x_centroid must be set for '// & + 'circle patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%y_centroid)) then + call s_mpi_abort('y_centroid must be set for '// & + 'circle patch '//trim(iStr)//'. Exiting ...') end if end subroutine s_check_circle_patch_geometry @@ -195,20 +199,24 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the rectangle patch - if (n == 0 .or. p > 0 & - .or. & - patch_icpp(patch_id)%x_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%y_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%length_x <= 0d0 & - .or. & - patch_icpp(patch_id)%length_y <= 0d0) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of rectangle '// & - 'patch '//trim(iStr)//'. Exiting ...') - + if (n == 0) then + call s_mpi_abort('n must be greater than zero for '// & + 'rectangle patch '//trim(iStr)//'. Exiting ...') + elseif (p > 0) then + call s_mpi_abort('p must be zero for rectangle patch '//trim(iStr)// & + '. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%x_centroid)) then + call s_mpi_abort('x_centroid must be set for '// & + 'rectangle patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%y_centroid)) then + call s_mpi_abort('y_centroid must be set for '// & + 'rectangle patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%length_x <= 0d0) then + call s_mpi_abort('length_x must be greater than zero for '// & + 'rectangle patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%length_y <= 0d0) then + call s_mpi_abort('length_y must be greater than zero for '// & + 'rectangle patch '//trim(iStr)//'. Exiting ...') end if end subroutine s_check_rectangle_patch_geometry @@ -223,22 +231,27 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the line sweep patch - if (n == 0 .or. p > 0 & - .or. & - patch_icpp(patch_id)%x_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%y_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%normal(1) == dflt_real & - .or. & - patch_icpp(patch_id)%normal(2) == dflt_real & - .or. & - patch_icpp(patch_id)%normal(3) /= dflt_real) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of line sweep '// & - 'patch '//trim(iStr)//'. Exiting ...') - + if (n == 0) then + call s_mpi_abort('n must be greater than zero for '// & + 'sweep line patch '//trim(iStr)//'. Exiting ...') + elseif (p > 0) then + call s_mpi_abort('p must be zero for sweep line patch '//trim(iStr)// & + '. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%x_centroid)) then + call s_mpi_abort('x_centroid must be set for '// & + 'sweep line patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%y_centroid)) then + call s_mpi_abort('y_centroid must be set for '// & + 'sweep line patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%normal(1))) then + call s_mpi_abort('normal(1) must be set for '// & + 'sweep line patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%normal(2))) then + call s_mpi_abort('normal(2) must be set for '// & + 'sweep line patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%normal(3))) then + call s_mpi_abort('normal(3) must be equal to dflt_real for '// & + 'sweep line patch '//trim(iStr)//'. Exiting ...') end if end subroutine s_check_line_sweep_patch_geometry @@ -253,22 +266,27 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the ellipse patch - if (n == 0 .or. p > 0 & - .or. & - patch_icpp(patch_id)%x_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%y_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%radii(1) == dflt_real & - .or. & - patch_icpp(patch_id)%radii(2) == dflt_real & - .or. & - patch_icpp(patch_id)%radii(3) /= dflt_real) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of ellipse '// & - 'patch '//trim(iStr)//'. Exiting ...') - + if (n == 0) then + call s_mpi_abort('n must be greater than zero for '// & + 'ellipse patch '//trim(iStr)//'. Exiting ...') + elseif (p > 0) then + call s_mpi_abort('p must be zero for ellipse patch '//trim(iStr)// & + '. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%x_centroid)) then + call s_mpi_abort('x_centroid must be set for '// & + 'ellipse patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%y_centroid)) then + call s_mpi_abort('y_centroid must be set for '// & + 'ellipse patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%radii(1))) then + call s_mpi_abort('radii(1) must be set for '// & + 'ellipse patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%radii(2))) then + call s_mpi_abort('radii(2) must be set for '// & + 'ellipse patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%radii(3))) then + call s_mpi_abort('radii(3) must be equal to dflt_real for '// & + 'ellipse patch '//trim(iStr)//'. Exiting ...') end if end subroutine s_check_ellipse_patch_geometry @@ -283,22 +301,27 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the TaylorGreen vortex patch geometric parameters - if (n == 0 .or. p > 0 & - .or. & - patch_icpp(patch_id)%x_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%y_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%length_x <= 0d0 & - .or. & - patch_icpp(patch_id)%length_y <= 0d0 & - .or. & - patch_icpp(patch_id)%vel(2) <= 0d0) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of Taylor Green '// & + if (n == 0) then + call s_mpi_abort('n must be greater than zero for '// & + 'vortex patch '//trim(iStr)//'. Exiting ...') + elseif (p > 0) then + call s_mpi_abort('p must be zero for vortex patch '//trim(iStr)// & + '. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%x_centroid)) then + call s_mpi_abort('x_centroid must be set for '// & + 'vortex patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%y_centroid)) then + call s_mpi_abort('y_centroid must be set for '// & + 'vortex patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%length_x <= 0d0) then + call s_mpi_abort('length_x must be greater than zero for '// & + 'vortex patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%length_y <= 0d0) then + call s_mpi_abort('length_y must be greater than zero for '// & + 'vortex patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%vel(2) <= 0d0) then + call s_mpi_abort('vel(2) must be greater than zero for '// & 'vortex patch '//trim(iStr)//'. Exiting ...') - end if end subroutine s_check_2D_TaylorGreen_vortex_patch_geometry @@ -313,17 +336,21 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the analytical patch - if (n > 0 .or. p > 0 & - .or. & - (model_eqns /= 4 .and. model_eqns /= 2) & - .or. & - patch_icpp(patch_id)%x_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%length_x <= 0d0) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of 1D analytical '// & - 'patch '//trim(iStr)//'. Exiting...') + if (n > 0) then + call s_mpi_abort('n must be zero for 1D analytical patch '//trim(iStr)// & + '. Exiting ...') + elseif (p > 0) then + call s_mpi_abort('p must be zero for 1D analytical patch '//trim(iStr)// & + '. Exiting ...') + elseif (model_eqns /= 4 .and. model_eqns /= 2) then + call s_mpi_abort('model_eqns must be either 4 or 2 for '// & + '1D analytical patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%x_centroid)) then + call s_mpi_abort('x_centroid must be set for '// & + '1D analytical patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%length_x <= 0d0) then + call s_mpi_abort('length_x must be greater than zero for '// & + '1D analytical patch '//trim(iStr)//'. Exiting ...') end if end subroutine s_check_1D_analytical_patch_geometry @@ -337,19 +364,24 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the analytical patch - if (n == 0 .or. p > 0 & - .or. & - patch_icpp(patch_id)%x_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%y_centroid == dflt_real & - .or. & - patch_icpp(patch_id)%length_x <= 0d0 & - .or. & - patch_icpp(patch_id)%length_y <= 0d0) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of 2D analytical '// & - 'patch '//trim(iStr)//'. Exiting...') + if (n == 0) then + call s_mpi_abort('n must be greater than zero for '// & + '2D analytical patch '//trim(iStr)//'. Exiting ...') + elseif (p > 0) then + call s_mpi_abort('p must be zero for 2D analytical patch '//trim(iStr)// & + '. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%x_centroid)) then + call s_mpi_abort('x_centroid must be set for '// & + '2D analytical patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%y_centroid)) then + call s_mpi_abort('y_centroid must be set for '// & + '2D analytical patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%length_x <= 0d0) then + call s_mpi_abort('length_x must be greater than zero for '// & + '2D analytical patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%length_y <= 0d0) then + call s_mpi_abort('length_y must be greater than zero for '// & + '2D analytical patch '//trim(iStr)//'. Exiting ...') end if end subroutine s_check_2D_analytical_patch_geometry @@ -363,23 +395,27 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the analytical patch - if (p == 0 & - .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. & - patch_icpp(patch_id)%length_x <= 0d0 & - .or. & - patch_icpp(patch_id)%length_y <= 0d0 & - .or. & - patch_icpp(patch_id)%length_z <= 0d0) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of 3D analytical '// & - 'patch '//trim(iStr)//'. Exiting...') + if (p == 0) then + call s_mpi_abort('p must be greater than zero for '// & + '3D analytical '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%x_centroid)) then + call s_mpi_abort('x_centroid must be set for '// & + '3D analytical '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%y_centroid)) then + call s_mpi_abort('y_centroid must be set for '// & + '3D analytical '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%z_centroid)) then + call s_mpi_abort('z_centroid must be set for '// & + '3D analytical '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%length_x <= 0d0) then + call s_mpi_abort('length_x must be greater than zero for '// & + '3D analytical '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%length_y <= 0d0) then + call s_mpi_abort('length_y must be greater than zero for '// & + '3D analytical '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%length_z <= 0d0) then + call s_mpi_abort('length_z must be greater than zero for '// & + '3D analytical '//trim(iStr)//'. Exiting ...') end if end subroutine s_check_3D_analytical_patch_geometry @@ -393,20 +429,21 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the sphere 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) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of sphere '// & - 'patch '//trim(iStr)//'. Exiting ...') - + if (p == 0) then + call s_mpi_abort('p must be greater than zero for '// & + 'sphere patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%radius <= 0d0) then + call s_mpi_abort('radius must be greater than zero for '// & + 'sphere patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%x_centroid)) then + call s_mpi_abort('x_centroid must be set for '// & + 'sphere patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%y_centroid)) then + call s_mpi_abort('y_centroid must be set for '// & + 'sphere patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%z_centroid)) then + call s_mpi_abort('z_centroid must be set for '// & + 'sphere patch '//trim(iStr)//'. Exiting ...') end if end subroutine s_check_sphere_patch_geometry @@ -421,26 +458,30 @@ 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 - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of spherical '// & - 'harmonic patch '//trim(iStr)//'. Exiting ...') - + if (p == 0) then + call s_mpi_abort('p must be greater than zero for '// & + 'spherical harmonic patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%radius <= 0d0) then + call s_mpi_abort('radius must be greater than zero for '// & + 'spherical harmonic patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%x_centroid)) then + call s_mpi_abort('x_centroid must be set for '// & + 'spherical harmonic patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%y_centroid)) then + call s_mpi_abort('y_centroid must be set for '// & + 'spherical harmonic patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%z_centroid)) then + call s_mpi_abort('z_centroid must be set for '// & + 'spherical harmonic patch '//trim(iStr)//'. Exiting ...') + elseif (all(patch_icpp(patch_id)%epsilon /= (/1d0, 2d0, 3d0, 4d0, 5d0/))) then + call s_mpi_abort('epsilon must be one of 1, 2, 3, 4, 5 for '// & + 'spherical harmonic patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%beta < 0d0) then + call s_mpi_abort('beta must be greater than or equal to zero for '// & + 'spherical harmonic patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%beta > patch_icpp(patch_id)%epsilon) then + call s_mpi_abort('beta must be less than or equal to epsilon for '// & + 'spherical harmonic patch '//trim(iStr)//'. Exiting ...') end if end subroutine s_check_spherical_harmonic_patch_geometry @@ -456,24 +497,27 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the cuboid patch - if (p == 0 & - .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. & - patch_icpp(patch_id)%length_x <= 0d0 & - .or. & - patch_icpp(patch_id)%length_y <= 0d0 & - .or. & - patch_icpp(patch_id)%length_z <= 0d0) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of cuboid '// & - 'patch '//trim(iStr)//'. Exiting ...') - + if (p == 0) then + call s_mpi_abort('p must be greater than zero for '// & + 'cuboid patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%x_centroid)) then + call s_mpi_abort('x_centroid must be set for '// & + 'cuboid patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%y_centroid)) then + call s_mpi_abort('y_centroid must be set for '// & + 'cuboid patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%z_centroid)) then + call s_mpi_abort('z_centroid must be set for '// & + 'cuboid patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%length_x <= 0d0) then + call s_mpi_abort('length_x must be greater than zero for '// & + 'cuboid patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%length_y <= 0d0) then + call s_mpi_abort('length_y must be greater than zero for '// & + 'cuboid patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%length_z <= 0d0) then + call s_mpi_abort('length_z must be greater than zero for '// & + 'cuboid patch '//trim(iStr)//'. Exiting ...') end if end subroutine s_check_cuboid_patch_geometry @@ -489,36 +533,39 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the cylinder patch - if (p == 0 & - .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. & - (patch_icpp(patch_id)%length_x <= 0d0 .and. & - patch_icpp(patch_id)%length_y <= 0d0 .and. & - patch_icpp(patch_id)%length_z <= 0d0) & - .or. & - (patch_icpp(patch_id)%length_x > 0d0 .and. & - (patch_icpp(patch_id)%length_y /= dflt_real .or. & - patch_icpp(patch_id)%length_z /= dflt_real)) & - .or. & - (patch_icpp(patch_id)%length_y > 0d0 .and. & - (patch_icpp(patch_id)%length_x /= dflt_real .or. & - patch_icpp(patch_id)%length_z /= dflt_real)) & - .or. & - (patch_icpp(patch_id)%length_z > 0d0 .and. & - (patch_icpp(patch_id)%length_x /= dflt_real .or. & - patch_icpp(patch_id)%length_y /= dflt_real)) & - .or. & - patch_icpp(patch_id)%radius <= 0d0) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of cylinder '// & - 'patch '//trim(iStr)//'. Exiting ...') - + if (p == 0) then + call s_mpi_abort('p must be greater than zero for '// & + 'cylinder patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%x_centroid)) then + call s_mpi_abort('x_centroid must be set for '// & + 'cylinder patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%y_centroid)) then + call s_mpi_abort('y_centroid must be set for '// & + 'cylinder patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%z_centroid)) then + call s_mpi_abort('z_centroid must be set for '// & + 'cylinder patch '//trim(iStr)//'. Exiting ...') + elseif ((patch_icpp(patch_id)%length_x <= 0d0 .and. & + patch_icpp(patch_id)%length_y <= 0d0 .and. & + patch_icpp(patch_id)%length_z <= 0d0) & + .or. & + (patch_icpp(patch_id)%length_x > 0d0 .and. & + ((.not. f_is_default(patch_icpp(patch_id)%length_y)) .or. & + (.not. f_is_default(patch_icpp(patch_id)%length_z)))) & + .or. & + (patch_icpp(patch_id)%length_y > 0d0 .and. & + ((.not. f_is_default(patch_icpp(patch_id)%length_x)) .or. & + (.not. f_is_default(patch_icpp(patch_id)%length_z)))) & + .or. & + (patch_icpp(patch_id)%length_z > 0d0 .and. & + ((.not. f_is_default(patch_icpp(patch_id)%length_x)) .or. & + (.not. f_is_default(patch_icpp(patch_id)%length_y))))) then + call s_mpi_abort('At least one of length_x, length_y, or length_z '// & + 'must be defined for '// & + 'cylinder patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%radius <= 0d0) then + call s_mpi_abort('radius must be greater than zero for '// & + 'cylinder patch '//trim(iStr)//'. Exiting ...') end if end subroutine s_check_cylinder_patch_geometry @@ -534,24 +581,27 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the plane sweep patch - if (p == 0 & - .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. & - patch_icpp(patch_id)%normal(1) == dflt_real & - .or. & - patch_icpp(patch_id)%normal(2) == dflt_real & - .or. & - patch_icpp(patch_id)%normal(3) == dflt_real) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of plane sweep '// & - 'patch '//trim(iStr)//'. Exiting ...') - + if (p == 0) then + call s_mpi_abort('p must be greater than zero for '// & + 'plane sweep patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%x_centroid)) then + call s_mpi_abort('x_centroid must be set for '// & + 'plane sweep patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%y_centroid)) then + call s_mpi_abort('y_centroid must be set for '// & + 'plane sweep patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%z_centroid)) then + call s_mpi_abort('z_centroid must be set for '// & + 'plane sweep patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%normal(1))) then + call s_mpi_abort('normal(1) must be set for '// & + 'plane sweep patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%normal(2))) then + call s_mpi_abort('normal(2) must be set for '// & + 'plane sweep patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%normal(3))) then + call s_mpi_abort('normal(3) must be set for '// & + 'plane sweep patch '//trim(iStr)//'. Exiting ...') end if end subroutine s_check_plane_sweep_patch_geometry @@ -566,24 +616,27 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the ellipsoid patch - if (p == 0 & - .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. & - patch_icpp(patch_id)%radii(1) == dflt_real & - .or. & - patch_icpp(patch_id)%radii(2) == dflt_real & - .or. & - patch_icpp(patch_id)%radii(3) == dflt_real) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of ellipsoid '// & - 'patch '//trim(iStr)//'. Exiting ...') - + if (p == 0) then + call s_mpi_abort('p must be greater than zero for '// & + 'ellipsoid patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%x_centroid)) then + call s_mpi_abort('x_centroid must be set for '// & + 'ellipsoid patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%y_centroid)) then + call s_mpi_abort('y_centroid must be set for '// & + 'ellipsoid patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%z_centroid)) then + call s_mpi_abort('z_centroid must be set for '// & + 'ellipsoid patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%radii(1))) then + call s_mpi_abort('radii(1) must be set for '// & + 'ellipsoid patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%radii(2))) then + call s_mpi_abort('radii(2) must be set for '// & + 'ellipsoid patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%radii(3))) then + call s_mpi_abort('radii(3) must be set for '// & + 'ellipsoid patch '//trim(iStr)//'. Exiting ...') end if end subroutine s_check_ellipsoid_patch_geometry @@ -597,40 +650,51 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the inactive patch - if (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. & - patch_icpp(patch_id)%length_x /= dflt_real & - .or. & - patch_icpp(patch_id)%length_y /= dflt_real & - .or. & - patch_icpp(patch_id)%length_z /= dflt_real & - .or. & - patch_icpp(patch_id)%radius /= dflt_real & - .or. & - patch_icpp(patch_id)%epsilon /= dflt_real & - .or. & - patch_icpp(patch_id)%beta /= dflt_real & - .or. & - patch_icpp(patch_id)%normal(1) /= dflt_real & - .or. & - patch_icpp(patch_id)%normal(2) /= dflt_real & - .or. & - patch_icpp(patch_id)%normal(3) /= dflt_real & - .or. & - patch_icpp(patch_id)%radii(1) /= dflt_real & - .or. & - patch_icpp(patch_id)%radii(2) /= dflt_real & - .or. & - patch_icpp(patch_id)%radii(3) /= dflt_real) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'geometric parameters of inactive '// & - 'patch '//trim(iStr)//'. Exiting ...') - + if (.not. f_is_default(patch_icpp(patch_id)%x_centroid)) then + call s_mpi_abort('x_centroid must not be set for '// & + 'inactive patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%y_centroid)) then + call s_mpi_abort('y_centroid must not be set for '// & + 'inactive patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%z_centroid)) then + call s_mpi_abort('z_centroid must not be set for '// & + 'inactive patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%length_x)) then + call s_mpi_abort('length_x must not be set for '// & + 'inactive patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%length_y)) then + call s_mpi_abort('length_y must not be set for '// & + 'inactive patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%length_z)) then + call s_mpi_abort('length_z must not be set for '// & + 'inactive patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%radius)) then + call s_mpi_abort('radius must not be set for '// & + 'inactive patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%epsilon)) then + call s_mpi_abort('epsilon must not be set for '// & + 'inactive patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%beta)) then + call s_mpi_abort('beta must not be set for '// & + 'inactive patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%normal(1))) then + call s_mpi_abort('normal(1) must not be set for '// & + 'inactive patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%normal(2))) then + call s_mpi_abort('normal(2) must not be set for '// & + 'inactive patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%normal(3))) then + call s_mpi_abort('normal(3) must not be set for '// & + 'inactive patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%radii(1))) then + call s_mpi_abort('radii(1) must not be set for '// & + 'inactive patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%radii(2))) then + call s_mpi_abort('radii(2) must not be set for '// & + 'inactive patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%radii(3))) then + call s_mpi_abort('radii(3) must not be set for '// & + 'inactive patch '//trim(iStr)//'. Exiting ...') end if end subroutine s_check_inactive_patch_geometry @@ -645,14 +709,12 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the alteration rights of an active patch - if (patch_icpp(patch_id)%alter_patch(0) .eqv. .false. & - .or. & - any(patch_icpp(patch_id)%alter_patch(patch_id:))) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'alteration rights of active '// & - 'patch '//trim(iStr)//'. Exiting ...') - + if (patch_icpp(patch_id)%alter_patch(0) .eqv. .false.) then + call s_mpi_abort('alter_patch(0) must be true for '// & + 'active patch '//trim(iStr)//'. Exiting ...') + elseif (any(patch_icpp(patch_id)%alter_patch(patch_id:))) then + call s_mpi_abort('alter_patch(i) must be false for i >= '// & + 'active patch '//trim(iStr)//'. Exiting ...') end if end subroutine s_check_active_patch_alteration_rights @@ -672,9 +734,8 @@ contains .or. & any(patch_icpp(patch_id)%alter_patch(1:))) then - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'alteration rights of inactive '// & - 'patch '//trim(iStr)//'. Exiting ...') + call s_mpi_abort('alter_patch(i) must not be set for i >= 1 for '// & + 'inactive patch '//trim(iStr)//'. Exiting ...') end if @@ -690,49 +751,49 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the smoothing parameters of a supported patch - if ((patch_icpp(patch_id)%smoothen & - .and. & - (patch_icpp(patch_id)%smooth_patch_id >= patch_id & - .or. & - patch_icpp(patch_id)%smooth_patch_id == 0 & - .or. & - patch_icpp(patch_id)%smooth_coeff <= 0d0)) & - .or. & - ((patch_icpp(patch_id)%smoothen .neqv. .true.) & - .and. & - (patch_icpp(patch_id)%smooth_patch_id /= patch_id & - .or. & - patch_icpp(patch_id)%smooth_coeff /= dflt_real))) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'smoothing parameters of supported '// & - 'patch '//trim(iStr)//'. Exiting ...') - + if (patch_icpp(patch_id)%smoothen) then + if (patch_icpp(patch_id)%smooth_patch_id >= patch_id) then + call s_mpi_abort('smooth_patch_id must be less than '// & + 'patch_id for supported patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%smooth_patch_id == 0) then + call s_mpi_abort('smooth_patch_id must be greater than zero for '// & + 'supported patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%smooth_coeff <= 0d0) then + call s_mpi_abort('smooth_coeff must be greater than zero for '// & + 'supported patch '//trim(iStr)//'. Exiting ...') + end if + else + if (patch_icpp(patch_id)%smooth_patch_id /= patch_id) then + call s_mpi_abort('smooth_patch_id must be equal to patch_id when '// & + 'smoothen is false for supported patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%smooth_coeff)) then + call s_mpi_abort('smooth_coeff must be equal to dflt_real when '// & + 'smoothen is false for supported patch '//trim(iStr)//'. Exiting ...') + end if end if end subroutine s_check_supported_patch_smoothing !> This subroutine verifies that the smoothing parameters of !! the given patch, which does not support the smoothing out - !! of its boundaries, remain unaltered by the user inputs. + !! of its boundaries, remain unaltered by the user inputs. !! @param patch_id Patch identifier subroutine s_check_unsupported_patch_smoothing(patch_id) ! Patch identifier integer, intent(in) :: patch_id - ! call s_int_to_str(patch_id, iStr) + call s_int_to_str(patch_id, iStr) ! Constraints on the smoothing parameters of an unsupported patch - if (patch_icpp(patch_id)%smoothen & - .or. & - patch_icpp(patch_id)%smooth_patch_id /= patch_id & - .or. & - patch_icpp(patch_id)%smooth_coeff /= dflt_real) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'smoothing parameters of unsupported '// & + if (patch_icpp(patch_id)%smoothen) then + call s_mpi_abort('smoothen must be false for unsupported '// & + 'patch '//trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%smooth_patch_id /= patch_id) then + call s_mpi_abort('smooth_patch_id must be equal to patch_id for unsupported '// & + 'patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%smooth_coeff)) then + call s_mpi_abort('smooth_coeff must not be set for unsupported '// & 'patch '//trim(iStr)//'. Exiting ...') - end if end subroutine s_check_unsupported_patch_smoothing @@ -747,53 +808,61 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the primitive variables of an active patch - if (patch_icpp(patch_id)%vel(1) == dflt_real & - .or. & - (n == 0 .and. patch_icpp(patch_id)%vel(2) /= dflt_real .and. patch_icpp(patch_id)%vel(2) /= 0) & - .or. & - (n > 0 .and. patch_icpp(patch_id)%vel(2) == dflt_real) & - .or. & - (p == 0 .and. patch_icpp(patch_id)%vel(3) /= dflt_real .and. patch_icpp(patch_id)%vel(3) /= 0) & - .or. & - (p > 0 .and. patch_icpp(patch_id)%vel(3) == dflt_real) & - ! .OR. & - ! patch_icpp(patch_id)%pres <= 0d0 & - .or. & - (model_eqns == 1 .and. & - (patch_icpp(patch_id)%rho <= 0d0 .or. & - patch_icpp(patch_id)%gamma <= 0d0 .or. & - patch_icpp(patch_id)%pi_inf < 0d0)) & - .or. & - (patch_icpp(patch_id)%geometry == 5 & - .and. & - patch_icpp(patch_id)%pi_inf > 0) & - .or. & - (model_eqns == 2 & - .and. & - (any(patch_icpp(patch_id)%alpha_rho(1:num_fluids) < 0d0)))) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'primitive variables of active '// & - 'patch '//trim(iStr)//'. Exiting ...') - + if (f_is_default(patch_icpp(patch_id)%vel(1))) then + call s_mpi_abort('vel(1) must be set for active patch '// & + trim(iStr)//'. Exiting ...') + elseif (n == 0 .and. (.not. f_is_default(patch_icpp(patch_id)%vel(2))) .and. & + patch_icpp(patch_id)%vel(2) /= 0) then + call s_mpi_abort('vel(2) must not be set when n = 0 '// & + 'for active patch '//trim(iStr)//'. Exiting ...') + elseif (n > 0 .and. f_is_default(patch_icpp(patch_id)%vel(2))) then + call s_mpi_abort('vel(2) must be set when n > 0 for '// & + 'active patch '//trim(iStr)//'. Exiting ...') + elseif (p == 0 .and. (.not. f_is_default(patch_icpp(patch_id)%vel(3))) .and. & + patch_icpp(patch_id)%vel(3) /= 0) then + call s_mpi_abort('vel(3) must not be set when p = 0 '// & + 'for active patch '//trim(iStr)//'. Exiting ...') + elseif (p > 0 .and. f_is_default(patch_icpp(patch_id)%vel(3))) then + call s_mpi_abort('vel(3) must be set when p > 0 for '// & + 'active patch '//trim(iStr)//'. Exiting ...') + elseif (model_eqns == 1 .and. patch_icpp(patch_id)%rho <= 0d0) then + call s_mpi_abort('rho must be greater than zero when '// & + 'model_eqns = 1 for active patch '// & + trim(iStr)//'. Exiting ...') + elseif (model_eqns == 1 .and. patch_icpp(patch_id)%gamma <= 0d0) then + call s_mpi_abort('gamma must be greater than zero when '// & + 'model_eqns = 1 for active patch '// & + trim(iStr)//'. Exiting ...') + elseif (model_eqns == 1 .and. patch_icpp(patch_id)%pi_inf < 0d0) then + call s_mpi_abort('pi_inf must be greater than or equal to '// & + 'zero when model_eqns = 1 for active patch '// & + trim(iStr)//'. Exiting ...') + elseif (patch_icpp(patch_id)%geometry == 5 .and. & + patch_icpp(patch_id)%pi_inf > 0) then + call s_mpi_abort('pi_inf must be less than or equal to zero '// & + 'when geometry = 5 for active patch '// & + trim(iStr)//'. Exiting ...') + elseif (model_eqns == 2 .and. & + any(patch_icpp(patch_id)%alpha_rho(1:num_fluids) < 0d0)) then + call s_mpi_abort('alpha_rho(1:num_fluids) must be greater '// & + 'than or equal to zero when model_eqns = 2 '// & + 'for active patch '//trim(iStr)//'. Exiting ...') end if if (model_eqns == 2 .and. num_fluids < num_fluids) then - - if (any(patch_icpp(patch_id)%alpha_rho(num_fluids + 1:) & - /= dflt_real) & - .or. & - any(patch_icpp(patch_id)%alpha(num_fluids + 1:) & - /= dflt_real) & - .or. & - (patch_icpp(patch_id)%alpha(num_fluids) == dflt_real)) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'primitive variables of active '// & + if (.not. f_all_default(patch_icpp(patch_id)%alpha_rho(num_fluids + 1:))) then + call s_mpi_abort('alpha_rho(num_fluids+1:) must not be '// & + 'set when num_fluids < num_fluids '// & + 'for active patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_all_default(patch_icpp(patch_id)%alpha(num_fluids + 1:))) then + call s_mpi_abort('alpha(num_fluids+1:) must not be '// & + 'set when num_fluids < num_fluids '// & + 'for active patch '//trim(iStr)//'. Exiting ...') + elseif (f_is_default(patch_icpp(patch_id)%alpha(num_fluids))) then + call s_mpi_abort('alpha(num_fluids) must be set '// & + 'when num_fluids < num_fluids for active '// & 'patch '//trim(iStr)//'. Exiting ...') - end if - end if end subroutine s_check_active_patch_primitive_variables @@ -808,24 +877,27 @@ contains call s_int_to_str(patch_id, iStr) ! Constraints on the primitive variables of an inactive patch - if (any(patch_icpp(patch_id)%alpha_rho /= dflt_real) & - .or. & - patch_icpp(patch_id)%rho /= dflt_real & - .or. & - any(patch_icpp(patch_id)%vel /= dflt_real) & - .or. & - patch_icpp(patch_id)%pres /= dflt_real & - .or. & - any(patch_icpp(patch_id)%alpha /= dflt_real) & - .or. & - patch_icpp(patch_id)%gamma /= dflt_real & - .or. & - patch_icpp(patch_id)%pi_inf /= dflt_real) then - - call s_mpi_abort('Inconsistency(ies) detected in '// & - 'primitive variables of inactive '// & + if (.not. f_all_default(patch_icpp(patch_id)%alpha_rho)) then + call s_mpi_abort('alpha_rho must not be altered for inactive '// & + 'patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%rho)) then + call s_mpi_abort('rho must not be altered for inactive '// & + 'patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_all_default(patch_icpp(patch_id)%vel)) then + call s_mpi_abort('vel must not be altered for inactive '// & + 'patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%pres)) then + call s_mpi_abort('pres must not be altered for inactive '// & + 'patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_all_default(patch_icpp(patch_id)%alpha)) then + call s_mpi_abort('alpha must not be altered for inactive '// & + 'patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%gamma)) then + call s_mpi_abort('gamma must not be altered for inactive '// & + 'patch '//trim(iStr)//'. Exiting ...') + elseif (.not. f_is_default(patch_icpp(patch_id)%pi_inf)) then + call s_mpi_abort('pi_inf must not be altered for inactive '// & 'patch '//trim(iStr)//'. Exiting ...') - end if end subroutine s_check_inactive_patch_primitive_variables @@ -839,12 +911,9 @@ contains inquire (file=patch_icpp(patch_id)%model%filepath, exist=file_exists) if (.not. file_exists) then - - print '(A,I0,A)', 'Model file '//trim(patch_icpp(patch_id)%model%filepath)// & - ' requested by patch ', patch_id, ' does not exist. Exiting ...' - - call s_mpi_abort() - + call s_mpi_abort('Model file '//trim(patch_icpp(patch_id)%model%filepath)// & + ' requested by patch '//trim(iStr)//' does not exist. '// & + 'Exiting ...') end if end subroutine s_check_model_geometry diff --git a/src/pre_process/m_checker.f90 b/src/pre_process/m_checker.f90 deleted file mode 100644 index bcbb862dc..000000000 --- a/src/pre_process/m_checker.f90 +++ /dev/null @@ -1,790 +0,0 @@ -!> -!!@file m_checker.f90 -!!@brief Contains module m_checker - -!> @brief The purpose of the module is to check for compatible input files -module m_checker - - 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_check_inputs - -contains - - subroutine s_check_inputs - - integer :: bub_fac !< For allowing an extra fluid_pp if there are subgrid bubbles - character(len=5) :: iStr !< for int to string conversion - integer :: i - logical :: dir_check !< Logical variable used to test the existence of folders - -#ifndef MFC_MPI - if (parallel_io .eqv. .true.) then - print '(A)', 'MFC built with --no-mpi requires parallel_io=F. '// & - 'Exiting ...' - call s_mpi_abort() - end if -#endif - - bub_fac = 0 - if (bubbles .and. (num_fluids == 1)) bub_fac = 1 - ! Startup checks for bubbles and bubble variables - if (bubbles) then - if (model_eqns /= 4 .and. model_eqns /= 2) then - call s_mpi_abort('Unsupported combination of values of '// & - 'bubbles and model_eqns. '// & - 'Exiting ...') - elseif (nb < 1) then - call s_mpi_abort('The Ensemble-Averaged Bubble Model requires nb >= 1'// & - 'Exiting ...') - elseif (polydisperse .and. (nb == 1)) then - call s_mpi_abort('Polydisperse bubble dynamics requires nb > 1 '// & - 'Exiting ...') - elseif (polydisperse .and. (mod(nb, 2) == 0)) then - call s_mpi_abort('nb must be odd '// & - 'Exiting ...') - elseif (model_eqns == 4 .and. (rhoref == dflt_real)) then - call s_mpi_abort('Unsupported combination of values of '// & - 'bubbles and rhoref. '// & - 'Exiting ...') - elseif (model_eqns == 4 .and. (pref == dflt_real)) then - call s_mpi_abort('Unsupported combination of values of '// & - 'bubbles and pref. '// & - 'Exiting ...') - elseif (model_eqns == 4 .and. (num_fluids > 1)) then - call s_mpi_abort('Unsupported combination of values of '// & - 'model_eqns and num_fluids. '// & - 'Exiting ...') - elseif ((.not. polytropic) .and. R0ref == dflt_real) then - call s_mpi_abort('Unsupported combination of values of '// & - 'polytropic and R0ref. '// & - 'Exiting ...') - elseif (nb == dflt_int) then - call s_mpi_abort('unsupported combination of values of '// & - 'bubbles and nb. '// & - 'exiting ...') - elseif (thermal > 3) then - call s_mpi_abort('unsupported combination of values of '// & - 'bubbles and thermal. '// & - 'exiting ...') - end if - - end if - - if (adv_n) then - if (bubbles .neqv. .true.) then - call s_mpi_abort('adv_n requires bubbles = true.'// & - 'Exiting ...') - else if (num_fluids > 1) then - call s_mpi_abort('adv_n requires num_fluids = 1. '// & - 'Exiting ...') - else if (qbmm .eqv. .true.) then - call s_mpi_abort('adv_n is incompatible with qbmm.'// & - 'Exiting ...') - end if - end if - - if (qbmm .and. dist_type == dflt_int) then - call s_mpi_abort('Dist type must be set if using QBMM. Exiting ...') - else if (qbmm .and. (dist_type /= 1) .and. rhoRV > 0d0) then - call s_mpi_abort('rhoRV cannot be used with dist_type \ne 1. Exiting ...') - else if (polydisperse .and. R0_type == dflt_int) then - 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 - ! phase change checkers. - if (relax) then - if (model_eqns /= 3) then - call s_mpi_abort('phase change requires model_eqns = 3. '// & - 'Exiting ...') - elseif ((relax_model < 0) .or. (relax_model > 6)) then - call s_mpi_abort('relax_model should be in between 0 and 6. '// & - 'Exiting ...') - elseif ((palpha_eps <= 0d0) .or. (palpha_eps >= 1d0) .or. & - (ptgalpha_eps <= 0d0) .or. (ptgalpha_eps >= 1d0)) then - call s_mpi_abort('both palpha_eps and ptgalpha_eps must & - & be in (0,1). '//'Exiting ...') - end if - - elseif ((relax_model /= dflt_int) .or. (palpha_eps /= dflt_real) & - .or. (ptgalpha_eps /= dflt_real)) then - call s_mpi_abort('relax is not set as true, but other phase change parameters have & -& been modified. Either activate phase change or set the values to default. '//'Exiting ...') - end if - if ((old_grid .neqv. .true.) .and. old_ic) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for old_grid and old_ic. Exiting ...') - - elseif ((old_grid .or. old_ic) .and. t_step_old == dflt_int) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for old_grid and old_ic and t_step_old. Exiting ...') - - ! Constraints on dimensionality and the number of cells for the grid - elseif (m <= 0) then - call s_mpi_abort('Unsupported choice for the value of m. '// & - 'Exiting ...') - elseif (n < 0) then - call s_mpi_abort('Unsupported choice for the value of n. '// & - 'Exiting ...') - elseif (p < 0) then - call s_mpi_abort('Unsupported choice for the value of p. '// & - 'Exiting ...') - elseif (cyl_coord .and. p > 0 .and. mod(p, 2) /= 1) then - call s_mpi_abort('Unsupported choice for the value of p. '// & - 'Total number of cells in azimuthal direction '// & - 'must be an even number. Exiting ...') - elseif (n == 0 .and. p > 0) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for n and p. Exiting ...') - elseif (nGlobal < 2**(min(1, m) + min(1, n) + min(1, p))*num_procs) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for num_procs, m, n and p. '// & - 'Exiting ...') - - ! Constraints on domain boundaries locations in the x-direction - elseif ((old_grid .and. x_domain%beg /= dflt_real) & - .or. & - ((old_grid .neqv. .true.) .and. & - x_domain%beg == dflt_real)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for old_grid and x_domain%beg. '// & - 'Exiting ...') - elseif ((old_grid .and. x_domain%end /= dflt_real) & - .or. & - ((old_grid .neqv. .true.) .and. & - x_domain%end == dflt_real)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for old_grid and x_domain%end. '// & - 'Exiting ...') - elseif ((old_grid .neqv. .true.) & - .and. & - x_domain%beg >= x_domain%end) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for old_grid, x_domain%beg and '// & - 'x_domain%end. Exiting ...') - end if - - if (cyl_coord) then ! Cartesian coordinates - - ! in case restart of a simulation - if (old_grid .and. old_ic) then - ! checking of there is any input to the domains - if ((x_domain%beg /= dflt_real .or. x_domain%end /= dflt_real) & - .or. & - (y_domain%beg /= dflt_real .or. y_domain%end /= dflt_real) & - .or. & - (y_domain%beg /= dflt_real .or. y_domain%end /= dflt_real)) then - call s_mpi_abort('domain are not dflt_real.'// & - 'Please, correct them') - elseif (m == dflt_int .or. n == dflt_int .or. p == dflt_int) then - call s_mpi_abort('m, n, and/or p are set to dflt_int.'// & - 'Please, correct them') - end if - ! in case it is NOT restart - ! Constraints on domain boundaries for cylindrical coordinates - elseif (n == 0 & - .or. & - y_domain%beg /= 0d0 & - .or. & - y_domain%end == dflt_real & - .or. & - y_domain%end < 0d0 & - .or. & - y_domain%beg >= y_domain%end) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'cyl_coord and n, y_domain%beg, or '// & - 'y_domain%end. Exiting ...') - elseif ((p == 0 .and. z_domain%beg /= dflt_real) & - .or. & - (p == 0 .and. z_domain%end /= dflt_real)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'cyl_coord and p, z_domain%beg, or '// & - 'z_domain%end. Exiting ...') - elseif (p > 0 .and. (z_domain%beg /= 0d0 & - .or. & - z_domain%end /= 2d0*pi)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'cyl_coord and p, z_domain%beg, or '// & - 'z_domain%end. Exiting ...') - end if - - else - - ! Constraints on domain boundaries locations in the y-direction - if ((n == 0 .and. y_domain%beg /= dflt_real) & - .or. & - (n > 0 & - .and. & - ((old_grid .and. y_domain%beg /= dflt_real) & - .or. & - ((old_grid .neqv. .true.) .and. & - y_domain%beg == dflt_real)))) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for old_grid, n and y_domain%beg. '// & - 'Exiting ...') - elseif ((n == 0 .and. y_domain%end /= dflt_real) & - .or. & - (n > 0 & - .and. & - ((old_grid .and. y_domain%end /= dflt_real) & - .or. & - ((old_grid .neqv. .true.) .and. & - y_domain%end == dflt_real)))) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for old_grid, n and y_domain%end. '// & - 'Exiting ...') - elseif (n > 0 & - .and. & - (old_grid .neqv. .true.) & - .and. & - y_domain%beg >= y_domain%end) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for old_grid, n, y_domain%beg and '// & - 'y_domain%end. Exiting ...') - - ! Constraints on domain boundaries locations in the z-direction - elseif ((p == 0 .and. z_domain%beg /= dflt_real) & - .or. & - (p > 0 & - .and. & - ((old_grid .and. z_domain%beg /= dflt_real) & - .or. & - ((old_grid .neqv. .true.) .and. & - z_domain%beg == dflt_real)))) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for old_grid, p and z_domain%beg. '// & - 'Exiting ...') - elseif ((p == 0 .and. z_domain%end /= dflt_real) & - .or. & - (p > 0 & - .and. & - ((old_grid .and. z_domain%end /= dflt_real) & - .or. & - ((old_grid .neqv. .true.) .and. & - z_domain%end == dflt_real)))) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for old_grid, p and z_domain%end. '// & - 'Exiting ...') - elseif (p > 0 & - .and. & - (old_grid .neqv. .true.) & - .and. & - z_domain%beg >= z_domain%end) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for old_grid, p, z_domain%beg and '// & - 'z_domain%end. Exiting ...') - end if - end if - - if (loops_z < 1) then - call s_mpi_abort('Unsupported choice for the value of loops_z. '// & - 'Exiting ...') - elseif (loops_y < 1) then - call s_mpi_abort('Unsupported choice for the value of loops_y. '// & - 'Exiting ...') - end if - - ! Constraints on the grid stretching in the x-direction - if (stretch_x) then - if (old_grid) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for old_grid and stretch_x. '// & - 'Exiting ...') - elseif (a_x == dflt_real) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for stretch_x and a_x. Exiting ...') - elseif (x_a == dflt_real) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for stretch_x and x_a. Exiting ...') - elseif (x_b == dflt_real) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for stretch_x and x_b. Exiting ...') - elseif (x_a >= x_b) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for stretch_x, x_a and x_b. '// & - 'Exiting ...') - elseif ((a_x + log(cosh(a_x*(x_domain%beg - x_a))) & - + log(cosh(a_x*(x_domain%beg - x_b))) & - - 2d0*log(cosh(0.5d0*a_x*(x_b - x_a))))/a_x <= 0d0) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for x_domain%beg, stretch_x, a_x, '// & - 'x_a, and x_b. Exiting ...') - elseif ((a_x + log(cosh(a_x*(x_domain%end - x_a))) & - + log(cosh(a_x*(x_domain%end - x_b))) & - - 2d0*log(cosh(0.5d0*a_x*(x_b - x_a))))/a_x <= 0d0) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for x_domain%end, stretch_x, a_x, '// & - 'x_a, and x_b. Exiting ...') - end if - end if - - if (stretch_y) then - ! Constraints on the grid stretching in the y-direction - if (old_grid) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for old_grid and stretch_y. '// & - 'Exiting ...') - elseif (n == 0) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for n and stretch_y. Exiting ...') - elseif (a_y == dflt_real) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for stretch_y and a_y. Exiting ...') - elseif (y_a == dflt_real) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for stretch_y and y_a. Exiting ...') - elseif (y_b == dflt_real) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for stretch_y and y_b. Exiting ...') - elseif (y_a >= y_b) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for stretch_y, y_a and y_b. '// & - 'Exiting ...') - elseif ((a_y + log(cosh(a_y*(y_domain%beg - y_a))) & - + log(cosh(a_y*(y_domain%beg - y_b))) & - - 2d0*log(cosh(0.5d0*a_y*(y_b - y_a))))/a_y <= 0d0) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for y_domain%beg, stretch_y, a_y, '// & - 'y_a, and y_b. Exiting ...') - elseif ((a_y + log(cosh(a_y*(y_domain%end - y_a))) & - + log(cosh(a_y*(y_domain%end - y_b))) & - - 2d0*log(cosh(0.5d0*a_y*(y_b - y_a))))/a_y <= 0d0) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for y_domain%end, stretch_y, a_y, '// & - 'y_a, and y_b. Exiting ...') - end if - end if - - ! Constraints on the grid stretching in the z-direction - if (stretch_z) then - if (old_grid) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for old_grid and stretch_z. '// & - 'Exiting ...') - elseif (cyl_coord) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for cyl_coord and stretch_z. '// & - 'Exiting ...') - elseif (p == 0) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for p and stretch_z. Exiting ...') - elseif (a_z == dflt_real) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for stretch_z and a_z. Exiting ...') - elseif (z_a == dflt_real) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for stretch_z and z_a. Exiting ...') - elseif (z_b == dflt_real) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for stretch_z and z_b. Exiting ...') - elseif (z_a >= z_b) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for stretch_z, z_a and z_b. '// & - 'Exiting ...') - elseif ((a_z + log(cosh(a_z*(z_domain%beg - z_a))) & - + log(cosh(a_z*(z_domain%beg - z_b))) & - - 2d0*log(cosh(0.5d0*a_z*(z_b - z_a))))/a_z <= 0d0) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for z_domain%beg, stretch_z, a_z, '// & - 'z_a, and z_b. Exiting ...') - elseif ((a_z + log(cosh(a_z*(z_domain%end - z_a))) & - + log(cosh(a_z*(z_domain%end - z_b))) & - - 2d0*log(cosh(0.5d0*a_z*(z_b - z_a))))/a_z <= 0d0) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for z_domain%end, stretch_z, a_z, '// & - 'z_a, and z_b. Exiting ...') - end if - end if - - ! Constraints on model equations and number of fluids in the flow - if (all(model_eqns /= (/1, 2, 3, 4/))) then - call s_mpi_abort('Unsupported value of model_eqns. Exiting ...') - elseif (num_fluids /= dflt_int & - .and. & - (num_fluids < 1 .or. num_fluids > num_fluids)) then - call s_mpi_abort('Unsupported value of num_fluids. Exiting ...') - elseif (model_eqns == 1 .and. adv_alphan) then - call s_mpi_abort('Unsupported combination of values of '// & - 'model_eqns and adv_alphan. '// & - 'Exiting ...') - ! Constraints on the order of the WENO scheme - elseif (weno_order /= 1 .and. weno_order /= 3 & - .and. & - weno_order /= 5) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'weno_order. Exiting ...') - elseif (m + 1 < weno_order) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for m and weno_order. Exiting ...') - elseif (n > 0 .and. n + 1 < weno_order) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for n and weno_order. Exiting ...') - elseif (p > 0 .and. p + 1 < weno_order) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for p and weno_order. Exiting ...') - elseif (nGlobal < weno_order**(min(1, m) + min(1, n) + min(1, p))*num_procs) & - then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for num_procs, m, n, p and '// & - 'weno_order. Exiting ...') - - ! Constraints on the boundary conditions in the x-direction - elseif (bc_x%beg < -16 .or. bc_x%beg > -1 .or. bc_x%beg == -14) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'bc_x%beg. Exiting ...') - elseif (bc_x%end < -16 .or. bc_x%end > -1 .or. bc_x%beg == -14) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'bc_x%end. Exiting ...') - elseif ((bc_x%beg == -1 .and. bc_x%end /= -1) & - .or. & - (bc_x%end == -1 .and. bc_x%beg /= -1)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for bc_x%beg and bc_x%end. '// & - 'Exiting ...') - end if - - if (cyl_coord) then ! Cartesian coordinates - - ! Constraints on the boundary conditions in the r-direction - if (bc_y%beg /= dflt_int & - .and. & - ((p > 0 .and. bc_y%beg /= -14) & - .or. & - (p == 0 .and. bc_y%beg /= -2))) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'bc_y%beg. Exiting ...') - elseif (bc_y%end /= dflt_int & - .and. & - (bc_y%end < -16 .or. bc_y%end > -1 .or. bc_y%end == -14)) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'bc_y%end. Exiting ...') - elseif ((n > 0 .and. bc_y%beg == dflt_int)) then - call s_mpi_abort('Unsupported choice for the value of n and '// & - 'bc_y%beg. Exiting ...') - elseif ((n > 0 .and. bc_y%end == dflt_int)) then - call s_mpi_abort('Unsupported choice for the value of n and '// & - 'bc_y%end. Exiting ...') - - ! Constraints on the boundary conditions in the theta-direction - elseif (bc_z%beg /= dflt_int & - .and. & - (bc_z%beg /= -1 .and. bc_z%beg /= -2)) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'bc_z%beg. Exiting ...') - elseif (bc_z%end /= dflt_int & - .and. & - (bc_z%end /= -1 .and. bc_z%end /= -2)) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'bc_z%end. Exiting ...') - elseif ((p == 0 .and. bc_z%beg /= dflt_int) & - .or. & - (p > 0 .and. bc_z%beg == dflt_int)) then - call s_mpi_abort('Unsupported choice for the value of p and '// & - 'bc_z%beg. Exiting ...') - elseif ((p == 0 .and. bc_z%end /= dflt_int) & - .or. & - (p > 0 .and. bc_z%end == dflt_int)) then - call s_mpi_abort('Unsupported choice for the value of p and '// & - 'bc_z%end. Exiting ...') - elseif (p > 0 & - .and. & - ((bc_z%beg == -1 .and. bc_z%end /= -1) & - .or. & - (bc_z%end == -1 .and. bc_z%beg /= -1))) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for p, bc_z%beg and bc_z%end. '// & - 'Exiting ...') - end if - - else - - ! Constraints on the boundary conditions in the y-direction - if (bc_y%beg /= dflt_int & - .and. & - (bc_y%beg < -16 .or. bc_y%beg > -1 .or. bc_y%beg == -14)) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'bc_y%beg. Exiting ...') - elseif (bc_y%end /= dflt_int & - .and. & - (bc_y%end < -16 .or. bc_y%end > -1 .or. bc_y%end == -14)) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'bc_y%end. Exiting ...') - elseif ((n == 0 .and. bc_y%beg /= dflt_int) & - .or. & - (n > 0 .and. bc_y%beg == dflt_int)) then - call s_mpi_abort('Unsupported choice for the value of n and '// & - 'bc_y%beg. Exiting ...') - elseif ((n == 0 .and. bc_y%end /= dflt_int) & - .or. & - (n > 0 .and. bc_y%end == dflt_int)) then - call s_mpi_abort('Unsupported choice for the value of n and '// & - 'bc_y%end. Exiting ...') - elseif (n > 0 & - .and. & - ((bc_y%beg == -1 .and. bc_y%end /= -1) & - .or. & - (bc_y%end == -1 .and. bc_y%beg /= -1))) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for n, bc_y%beg and bc_y%end. '// & - 'Exiting ...') - - ! Constraints on the boundary conditions in the z-direction - elseif (bc_z%beg /= dflt_int & - .and. & - (bc_z%beg < -16 .or. bc_z%beg > -1 .or. bc_z%beg == -14)) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'bc_z%beg. Exiting ...') - elseif (bc_z%end /= dflt_int & - .and. & - (bc_z%end < -16 .or. bc_z%end > -1 .or. bc_z%end == -14)) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'bc_z%end. Exiting ...') - elseif (any((/bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, bc_z%end/) == -13)) then - call s_mpi_abort('Unsupported choice of boundary condition -13') - elseif ((p == 0 .and. bc_z%beg /= dflt_int) & - .or. & - (p > 0 .and. bc_z%beg == dflt_int)) then - call s_mpi_abort('Unsupported choice for the value of p and '// & - 'bc_z%beg. Exiting ...') - elseif ((p == 0 .and. bc_z%end /= dflt_int) & - .or. & - (p > 0 .and. bc_z%end == dflt_int)) then - call s_mpi_abort('Unsupported choice for the value of p and '// & - 'bc_z%end. Exiting ...') - elseif (p > 0 & - .and. & - ((bc_z%beg == -1 .and. bc_z%end /= -1) & - .or. & - (bc_z%end == -1 .and. bc_z%beg /= -1))) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for p, bc_z%beg and bc_z%end. '// & - 'Exiting ...') - end if - - end if - - ! Constraints on number of patches making up the initial condition - if (num_patches < 0 .or. num_patches > num_patches .or. & - (num_patches == 0 .and. t_step_old == dflt_int)) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'num_patches. Exiting ...') - ! Constraints on perturbing the initial condition - elseif ((perturb_flow & - .and. & - (perturb_flow_fluid == dflt_int .or. perturb_flow_mag == dflt_real)) & - .or. & - ((perturb_flow .neqv. .true.) & - .and. & - (perturb_flow_fluid /= dflt_int .or. perturb_flow_mag /= dflt_real))) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for perturb_flow, perturb_flow_fluid, and perturb_flow_mag. '// & - 'Exiting ...') - elseif ((perturb_flow_fluid > num_fluids) & - .or. & - (perturb_flow_fluid < 0 .and. perturb_flow_fluid /= dflt_int)) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'perturb_flow_fluid. Exiting ...') - elseif ((perturb_sph .and. perturb_sph_fluid == dflt_int) & - .or. & - ((perturb_sph .neqv. .true.) .and. (perturb_sph_fluid /= dflt_int))) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for perturb_sph and perturb_sph_fluid. '// & - 'Exiting ...') - elseif ((perturb_sph_fluid > num_fluids) & - .or. & - (perturb_sph_fluid < 0 .and. perturb_sph_fluid /= dflt_int)) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'perturb_sph_fluid. Exiting ...') - elseif ((any(fluid_rho /= dflt_real)) .and. (perturb_sph .neqv. .true.)) then - call s_mpi_abort('Unsupported choices for values of perturb_sph '// & - 'and fluid_rho. Exiting ...') - end if - - if (perturb_sph) then - do i = 1, num_fluids - call s_int_to_str(i, iStr) - if (fluid_rho(i) == dflt_real) then - call s_mpi_abort('Unsupported choice for value of fluid_rho('// & - trim(iStr)//'). Exiting ...') - end if - end do - end if - - ! Constraints on the hypertangent velocity profile - if ((vel_profile .eqv. .true.) .and. (n == 0)) then - call s_mpi_abort('Unsupported choices of the combination of values for '// & - 'vel_profile and n. Exiting ...') - end if - - ! Constraints on the instability wave - if ((instability_wave .eqv. .true.) .and. (n == 0)) then - call s_mpi_abort('Unsupported choices of the combination of values for '// & - 'instability_wave and n. Exiting ...') - end if - - ! Constraints on Immersed Boundary Method - if (ib) then - if (n <= 0) then - call s_mpi_abort('Unsupported choices of the combination of values for '// & - 'ib and n. Immersed Boundaries do not work in 1D. Exiting ...') - else if (num_ibs <= 0 .or. num_ibs > num_patches_max) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'num_ibs. Exiting ...') - end if - end if - - if (num_ibs > 0 .and. .not. ib) then - call s_mpi_abort('Unsupported choices of the combination of values for '// & - 'num_ibs and ib. Exiting ...') - end if - - ! Constraints on the stiffened equation of state fluids parameters - do i = 1, num_fluids - call s_int_to_str(i, iStr) - if (fluid_pp(i)%gamma /= dflt_real & - .and. & - fluid_pp(i)%gamma <= 0d0) then - call s_mpi_abort('Unsupported value of '// & - 'fluid_pp('//trim(iStr)//')%'// & - 'gamma. Exiting ...') - elseif (model_eqns == 1 & - .and. & - fluid_pp(i)%gamma /= dflt_real) then - call s_mpi_abort('Unsupported combination '// & - 'of values of model_eqns '// & - 'and fluid_pp('//trim(iStr)//')%'// & - 'gamma. Exiting ...') - elseif ((i <= num_fluids + bub_fac .and. fluid_pp(i)%gamma <= 0d0) & - .or. & - (i > num_fluids + bub_fac .and. fluid_pp(i)%gamma /= dflt_real)) & - then - call s_mpi_abort('Unsupported combination '// & - 'of values of num_fluids '// & - 'and fluid_pp('//trim(iStr)//')%'// & - 'gamma. Exiting ...') - elseif (fluid_pp(i)%pi_inf /= dflt_real & - .and. & - fluid_pp(i)%pi_inf < 0d0) then - call s_mpi_abort('Unsupported value of '// & - 'fluid_pp('//trim(iStr)//')%'// & - 'pi_inf. Exiting ...') - elseif (model_eqns == 1 & - .and. & - fluid_pp(i)%pi_inf /= dflt_real) then - call s_mpi_abort('Unsupported combination '// & - 'of values of model_eqns '// & - 'and fluid_pp('//trim(iStr)//')%'// & - 'pi_inf. Exiting ...') - elseif ((i <= num_fluids + bub_fac .and. fluid_pp(i)%pi_inf < 0d0) & - .or. & - (i > num_fluids + bub_fac .and. fluid_pp(i)%pi_inf /= dflt_real)) & - then - call s_mpi_abort('Unsupported combination '// & - 'of values of num_fluids '// & - 'and fluid_pp('//trim(iStr)//')%'// & - 'pi_inf. Exiting ...') - elseif (fluid_pp(i)%cv < 0d0) then - call s_mpi_abort('Unsupported value of '// & - 'fluid_pp('//trim(iStr)//')%'// & - 'cv. Make sure cv is positive. Exiting ...') - end if - - end do - - ! Constraints on the surface tension model - if (sigma /= dflt_real .and. sigma < 0d0) then - call s_mpi_abort('The surface tension coefficient must be'// & - 'greater than or equal to zero. Exiting ...') - elseif (sigma /= dflt_real .and. model_eqns /= 3) then - call s_mpi_abort("The surface tension model requires"// & - 'model_eqns=3. Exiting ...') - end if - - ! Moving Boundaries Checks: x boundaries - if (any((/bc_x%vb1, bc_x%vb2, bc_x%vb3/) /= 0d0)) then - if (bc_x%beg == 15) then - if (any((/bc_x%vb2, bc_x%vb3/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_x%beg and"// & - "bc_x%vb2 or bc_x%vb3. Exiting ...") - end if - elseif (bc_x%beg /= -16) then - call s_mpi_abort("Unsupported combination of bc_x%beg and"// & - "bc_x%vb1, bc_x%vb2, or bc_x%vb3. Exiting...") - end if - end if - - if (any((/bc_x%ve1, bc_x%ve2, bc_x%ve3/) /= 0d0)) then - if (bc_x%end == 15) then - if (any((/bc_x%ve2, bc_x%ve3/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_x%end and"// & - "bc_x%ve2 or bc_x%ve3. Exiting ...") - end if - elseif (bc_x%end /= -16) then - call s_mpi_abort("Unsupported combination of bc_x%end and"// & - "bc_x%ve1, bc_x%ve2, or bc_x%ve3. Exiting...") - end if - end if - - ! Moving Boundaries Checks: y boundaries - if (any((/bc_y%vb1, bc_y%vb2, bc_y%vb3/) /= 0d0)) then - if (bc_y%beg == 15) then - if (any((/bc_y%vb1, bc_y%vb3/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_y%beg and"// & - "bc_y%vb1 or bc_y%vb3. Exiting ...") - end if - elseif (bc_y%beg /= -16) then - call s_mpi_abort("Unsupported combination of bc_y%beg and"// & - "bc_y%vb1, bc_y%vb2, or bc_y%vb3. Exiting...") - end if - end if - - if (any((/bc_y%ve1, bc_y%ve2, bc_y%ve3/) /= 0d0)) then - if (bc_y%end == 15) then - if (any((/bc_y%ve1, bc_y%ve3/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_y%end and"// & - "bc_y%ve1 or bc_y%ve3. Exiting ...") - end if - elseif (bc_y%end /= -16) then - call s_mpi_abort("Unsupported combination of bc_y%end and"// & - "bc_y%ve1, bc_y%ve2, or bc_y%ve3. Exiting...") - end if - end if - - ! Moving Boundaries Checks: z boundaries - if (any((/bc_z%vb1, bc_z%vb2, bc_z%vb3/) /= 0d0)) then - if (bc_z%beg == 15) then - if (any((/bc_x%vb1, bc_x%vb2/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_z%beg and"// & - "bc_x%vb1 or bc_x%vb1. Exiting ...") - end if - elseif (bc_z%beg /= -16) then - call s_mpi_abort("Unsupported combination of bc_z%beg and"// & - "bc_z%vb1, bc_z%vb2, or bc_z%vb3. Exiting...") - end if - end if - - if (any((/bc_z%ve1, bc_z%ve2, bc_z%ve3/) /= 0d0)) then - if (bc_z%end == 15) then - if (any((/bc_x%ve1, bc_x%ve2/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_z%end and"// & - "bc_z%ve2 or bc_z%ve3. Exiting ...") - end if - elseif (bc_z%end /= -16) then - call s_mpi_abort("Unsupported combination of bc_z%end and"// & - "bc_z%ve1, bc_z%ve2, or bc_z%ve3. Exiting...") - end if - end if - - end subroutine s_check_inputs - -end module m_checker diff --git a/src/pre_process/m_checker.fpp b/src/pre_process/m_checker.fpp new file mode 100644 index 000000000..5b03c6ae4 --- /dev/null +++ b/src/pre_process/m_checker.fpp @@ -0,0 +1,276 @@ +!> +!!@file m_checker.f90 +!!@brief Contains module m_checker + +!> @brief The purpose of the module is to check for compatible input files +module m_checker + + 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_check_inputs + +contains + + !> Checks compatibility of parameters in the input file. + !! Used by the pre_process stage + subroutine s_check_inputs + + call s_check_parallel_io + call s_check_inputs_restart + call s_check_inputs_grid_stretching + call s_check_inputs_qbmm_and_polydisperse + call s_check_inputs_perturb_density + call s_check_inputs_misc + + end subroutine s_check_inputs + + !> Checks if mpi is enabled with parallel_io + subroutine s_check_parallel_io +#ifndef MFC_MPI + if (parallel_io) then + print '(A)', 'MFC built with --no-mpi requires parallel_io=F. '// & + 'Exiting ...' + call s_mpi_abort() + end if +#endif + end subroutine s_check_parallel_io + + !> Checks constraints on the restart parameters + !! (old_grid, old_ic, etc.) + subroutine s_check_inputs_restart + logical :: skip_check !< Flag to skip the check when iterating over + !! x, y, and z directions, for special treatment of cylindrical coordinates + + if ((.not. old_grid) .and. old_ic) then + call s_mpi_abort('old_ic can only be enabled with old_grid enabled. '// & + 'Exiting ...') + end if + + if (old_grid) then + if (t_step_old == dflt_int) then + call s_mpi_abort('old_grid is enabled, but t_step_old not set. '// & + 'Exiting ...') + elseif ((.not. f_is_default(x_domain%beg)) .or. (.not. f_is_default(x_domain%end)) & + .or. & + (.not. f_is_default(y_domain%beg)) .or. (.not. f_is_default(y_domain%end)) & + .or. & + (.not. f_is_default(z_domain%beg)) .or. (.not. f_is_default(z_domain%end))) then + call s_mpi_abort('x_domain, y_domain, and/or z_domain '// & + 'are not supported with old_grid enabled. '// & + 'Exiting ...') + end if + end if + + #:for DIR, VAR in [('x', 'm'), ('y', 'n'), ('z', 'p')] + ! For cylindrical coordinates, the y and z directions use a different check + #:if (DIR == 'y') or (DIR == 'z') + skip_check = cyl_coord + #:else + skip_check = .false. + #:endif + + if (.not. skip_check) then + #:for BOUND in ['beg', 'end'] + if (${VAR}$ == 0) then + if (.not. f_is_default((${DIR}$_domain%${BOUND}$))) then + call s_mpi_abort('${DIR}$_domain%${BOUND}$ must not '// & + 'be set when ${VAR}$ = 0. Exiting ...') + end if + else ! ${VAR}$ > 0 + if (old_grid .and. (.not. f_is_default(${DIR}$_domain%${BOUND}$))) then + call s_mpi_abort('${DIR}$_domain%${BOUND}$ must not '// & + 'be set when ${VAR}$ > 0 and '// & + 'old_grid = T. Exiting ...') + elseif (.not. old_grid .and. f_is_default(${DIR}$_domain%${BOUND}$)) then + call s_mpi_abort('${DIR}$_domain%${BOUND}$ must be '// & + 'set when ${VAR}$ > 0 and '// & + 'old_grid = F. Exiting ...') + elseif (${DIR}$_domain%beg >= ${DIR}$_domain%end) then + call s_mpi_abort('${DIR}$_domain%beg must be less '// & + 'than ${DIR}$_domain%end when '// & + 'both are set. Exiting ...') + end if + end if + #:endfor + end if + + #:endfor + + ! Check for y and z directions for cylindrical coordinates + if (cyl_coord) then + if (n == 0) then + call s_mpi_abort('n must be positive for cylindrical '// & + 'coordinates. Exiting ...') + elseif (f_is_default(y_domain%beg) .or. f_is_default(y_domain%end)) then + call s_mpi_abort('y_domain%beg and y_domain%end '// & + 'must be set for n = 0 '// & + '(2D cylindrical coordinates). Exiting ...') + elseif (y_domain%beg /= 0d0 .or. y_domain%end <= 0d0) then + call s_mpi_abort('y_domain%beg must be 0 and y_domain%end '// & + 'must be positive for cylindrical '// & + 'coordinates. Exiting ...') + end if + + if (p == 0) then + if ((.not. f_is_default(z_domain%beg)) & + .or. & + (.not. f_is_default(z_domain%end))) then + call s_mpi_abort('z_domain%beg and z_domain%end '// & + 'are not supported for p = 0 '// & + '(2D cylindrical coordinates). Exiting ...') + end if + else if (p > 0) then + if (z_domain%beg /= 0d0 .or. z_domain%end /= 2d0*pi) then + call s_mpi_abort('z_domain%beg must be 0 and z_domain%end '// & + 'must be 2*pi for 3D cylindrical '// & + 'coordinates. Exiting ...') + end if + end if + end if + + if (num_patches < 0 .or. & + (num_patches == 0 .and. t_step_old == dflt_int)) then + call s_mpi_abort('num_patches must be non-negative for the '// & + 'non-restart case. Exiting ...') + end if + + end subroutine s_check_inputs_restart + + !> Checks constraints on grid stretching parameters + !! (loops_x[y,z], stretch_x[y,z], etc.) + subroutine s_check_inputs_grid_stretching + ! Constraints on loops for grid stretching + if (loops_z < 1) then + call s_mpi_abort('loops_z must be positive. Exiting ...') + elseif (loops_y < 1) then + call s_mpi_abort('loops_y must be positive. Exiting ...') + end if + + ! Constraints specific to stretch_y + if (stretch_y .and. n == 0) then + call s_mpi_abort('n must be positive if stretch_y = T. Exiting ...') + end if + + ! Constraints specific to stretch_z + if (stretch_z) then + if (cyl_coord) then + call s_mpi_abort('stretch_z is not supported for '// & + 'cylindrical coordinates. Exiting ...') + elseif (p == 0) then + call s_mpi_abort('p must be positive if stretch_z = T. '// & + 'Exiting ...') + end if + end if + + ! Common checks for all directions (stretch_x, stretch_y, and stretch_z) + #:for X in ['x', 'y', 'z'] + if (stretch_${X}$) then + if (old_grid) then + call s_mpi_abort('old_grid and stretch_${X}$ are '// & + 'incompatible. Exiting ...') + elseif (f_is_default(a_${X}$)) then + call s_mpi_abort('a_${X}$ must be set with stretch_${X}$ '// & + 'enabled. Exiting ...') + elseif (f_is_default(${X}$_a)) then + call s_mpi_abort('${X}$_a must be set with stretch_${X}$ '// & + 'enabled. Exiting ...') + elseif (f_is_default(${X}$_b)) then + call s_mpi_abort('${X}$_b must be set with stretch_${X}$ '// & + 'enabled. Exiting ...') + elseif (${X}$_a >= ${X}$_b) then + call s_mpi_abort('${X}$_a must be less than ${X}$_b with '// & + 'stretch_${X}$ enabled. Exiting ...') + end if + #:for BOUND in ['beg', 'end'] + ! Note: `!&` is used to prevent fprettify errors + if ((a_${X}$ + log(cosh(a_${X}$*(${X}$_domain%${BOUND}$ - ${X}$_a))) & !& + + log(cosh(a_${X}$*(${X}$_domain%${BOUND}$ - ${X}$_b))) & !& + - 2d0*log(cosh(0.5d0*a_${X}$*(${X}$_b - ${X}$_a)))) / a_${X}$ <= 0d0) then !& + call s_mpi_abort('${X}$_domain%${BOUND}$ is too close '// & + 'to ${X}$_a and ${X}$_b for the given '// & + 'a_${X}$. Exiting ...') + end if + #:endfor + end if + #:endfor + end subroutine s_check_inputs_grid_stretching + + !> Checks constraints on the QBMM and polydisperse bubble parameters + !! (qbmm, polydisperse, dist_type, rhoRV, and R0_type) + subroutine s_check_inputs_qbmm_and_polydisperse + if (qbmm .and. dist_type == dflt_int) then + call s_mpi_abort('dist_type must be set if using QBMM. Exiting ...') + else if (qbmm .and. (dist_type /= 1) .and. rhoRV > 0d0) then + call s_mpi_abort('rhoRV cannot be used with dist_type != 1. Exiting ...') + else if (polydisperse .and. R0_type == dflt_int) then + call s_mpi_abort('R0 type must be set if using Polydisperse. Exiting ...') + end if + end subroutine s_check_inputs_qbmm_and_polydisperse + + !> Checks constraints on initial partial density perturbation + !! (perturb_flow, perturb_flow_fluid, perturb_flow_mag, perturb_sph, + !! perturb_sph_fluid, and fluid_rho) + subroutine s_check_inputs_perturb_density + character(len=5) :: iStr !< for int to string conversion + integer :: i + + if (perturb_flow & + .and. & + (perturb_flow_fluid == dflt_int .or. f_is_default(perturb_flow_mag))) then + call s_mpi_abort('perturb_flow_fluid and perturb_flow_mag '// & + 'must be set with perturb_flow = T. Exiting ...') + elseif ((.not. perturb_flow) & + .and. & + (perturb_flow_fluid /= dflt_int .or. (.not. f_is_default(perturb_flow_mag)))) then + call s_mpi_abort('perturb_flow_fluid and perturb_flow_mag '// & + 'must not be set with perturb_flow = F. Exiting ...') + elseif ((perturb_flow_fluid > num_fluids) & + .or. & + (perturb_flow_fluid < 0 .and. perturb_flow_fluid /= dflt_int)) then + call s_mpi_abort('perturb_flow_fluid must be between 0 and '// & + 'num_fluids. Exiting ...') + elseif (perturb_sph .and. perturb_sph_fluid == dflt_int) then + call s_mpi_abort('perturb_sph_fluid must be set with perturb_sph = T. '// & + 'Exiting ...') + elseif (.not. perturb_sph .and. perturb_sph_fluid /= dflt_int) then + call s_mpi_abort('perturb_sph_fluid must not be set with perturb_sph = F. '// & + 'Exiting ...') + elseif ((perturb_sph_fluid > num_fluids) & + .or. & + (perturb_sph_fluid < 0 .and. perturb_sph_fluid /= dflt_int)) then + call s_mpi_abort('perturb_sph_fluid must be between 0 and '// & + 'num_fluids. Exiting ...') + elseif ((.not. perturb_sph) .and. (.not. f_all_default(fluid_rho))) then + call s_mpi_abort('fluid_rho must not be set with perturb_sph = F. '// & + 'Exiting ...') + end if + + do i = 1, num_fluids + call s_int_to_str(i, iStr) + if (perturb_sph .and. f_is_default(fluid_rho(i))) then + call s_mpi_abort('fluid_rho('//trim(iStr)//') must be set '// & + 'if perturb_sph = T. Exiting ...') + end if + end do + end subroutine s_check_inputs_perturb_density + + !> Checks miscellaneous constraints + !! (vel_profile and instability_wave) + subroutine s_check_inputs_misc + ! Hypertangent velocity profile + if (vel_profile .and. (n == 0)) then + call s_mpi_abort('vel_profile requires n > 0. Exiting ...') + end if + ! Instability wave + if (instability_wave .and. (n == 0)) then + call s_mpi_abort('instability_wave requires n > 0. Exiting ...') + end if + end subroutine s_check_inputs_misc + +end module m_checker diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index 1d365aa77..e14aa6f49 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -45,6 +45,8 @@ module m_start_up use m_helper + use m_checker_common + use m_checker ! ========================================================================== @@ -195,6 +197,7 @@ contains 'Exiting ...') end if + call s_check_inputs_common() call s_check_inputs() ! Check all the patch properties diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index 6426a2646..95a65a2ed 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -19,16 +19,28 @@ module m_checker contains + !> Checks compatibility of parameters in the input file. + !! Used by the simulation stage subroutine s_check_inputs - character(len=5) :: iStr - character(len=5) :: jStr - integer :: bub_fac !for allowing an extra fluid_pp if there are bubbles - integer :: i, j + 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 + if (hypoelasticity) call s_check_inputs_hypoelasticity + 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 + call s_check_inputs_stiffened_eos_viscosity + call s_check_inputs_body_forces + call s_check_inputs_misc - bub_fac = 0 - if (bubbles .and. (num_fluids == 1)) bub_fac = 1 + end subroutine s_check_inputs + !> Checks constraints on compiler options + subroutine s_check_inputs_compilers #if !defined(MFC_OpenACC) && !(defined(__PGI) || defined(_CRAYFTN)) if (rdma_mpi) then call s_mpi_abort('Unsupported value of rdma_mpi. Exiting ...') @@ -41,521 +53,234 @@ contains 'with the NVIDIA cuTENSOR library. Exiting ...') end if #endif + end subroutine s_check_inputs_compilers - ! Computational Domain Parameters ================================== - if (m <= 0) then - call s_mpi_abort('Unsupported value of m. Exiting ...') - elseif (n < 0) then - call s_mpi_abort('Unsupported value of n. Exiting ...') - elseif (p < 0) then - call s_mpi_abort('Unsupported value of p. Exiting ...') - elseif (cyl_coord .and. p > 0 .and. mod(p, 2) /= 1) then - call s_mpi_abort('Unsupported value of p. Exiting ...') - elseif (n == 0 .and. p > 0) then - call s_mpi_abort('Unsupported combination of values of '// & - 'n and p. Exiting ...') - elseif (dt <= 0) then - call s_mpi_abort('Unsupported value of dt. Exiting ...') - elseif (t_step_start < 0) then - call s_mpi_abort('Unsupported value of t_step_start. Exiting ...') - elseif (t_step_stop <= t_step_start) then - call s_mpi_abort('Unsupported combination of values of '// & - 't_step_start and t_step_stop. '// & - 'Exiting ...') - elseif (t_step_save > t_step_stop - t_step_start) then - call s_mpi_abort('Unsupported combination of values of '// & - 't_step_start, t_step_stop and '// & - 't_step_save. Exiting ...') - end if - ! ================================================================== - - ! Simulation Algorithm Parameters ================================== - if (all(model_eqns /= (/1, 2, 3, 4/))) then - call s_mpi_abort('Unsupported value of model_eqns. Exiting ...') - end if - - if (bubbles) then - if (model_eqns == 2 .and. bubble_model == 1) then - call s_mpi_abort('The 5-equation bubbly flow model requires bubble_model = 2 (Keller--Miksis)') - elseif (nb < 1) then - call s_mpi_abort('The Ensemble-Averaged Bubble Model requires nb >= 1') - elseif (bubble_model == 3 .and. (polytropic .neqv. .true.) .and. (.not. qbmm)) then - call s_mpi_abort('RP bubbles require polytropic compression') - elseif (cyl_coord) then - call s_mpi_abort('Bubble models untested in cylindrical coordinates') - elseif (model_eqns == 3) then - call s_mpi_abort('Bubble models untested with 6-equation model') - elseif (model_eqns == 1) then - call s_mpi_abort('Bubble models untested with pi-gamma model') - !TODO: Comment this out when testing riemann with hll - elseif (riemann_solver /= 2) then - call s_mpi_abort('Bubble modeling requires riemann_solver = 2') - elseif (avg_state == 1) then - call s_mpi_abort('Unsupported combination of values of '// & - 'bubbles and Roe average (please use avg_state = 2). '// & - 'Exiting ...') - end if - end if - - if (model_eqns == 4 .and. num_fluids /= 1) then - call s_mpi_abort('The 4-equation model implementation is not a multi-component and requires num_fluids = 1') - end if - - if ((bubbles .neqv. .true.) .and. polydisperse) then - call s_mpi_abort('Polydisperse bubble modeling requires the bubble switch to be activated') - elseif (polydisperse .and. (poly_sigma == dflt_real)) then - call s_mpi_abort('Polydisperse bubble modeling requires poly_sigma > 0') - elseif (qbmm .and. (bubbles .neqv. .true.)) then - call s_mpi_abort('QBMM requires bubbles') - elseif (qbmm .and. (nnode /= 4)) then - call s_mpi_abort('nnode not supported') - end if - - if (model_eqns == 3) then - if (riemann_solver /= 2) then - call s_mpi_abort('Unsupported combination of values of '// & - 'model_eqns (6-eq) and riemann_solver (please use riemann_solver = 2). '// & - 'Exiting ...') - elseif (alt_soundspeed) then - call s_mpi_abort('Unsupported combination of values of '// & - 'model_eqns (6-eq) and alt_soundspeed. '// & - 'Exiting ...') - elseif (avg_state == 1) then - call s_mpi_abort('Unsupported combination of values of '// & - 'model_eqns (6-eq) and Roe average (please use avg_state = 2). '// & - 'Exiting ...') - elseif (wave_speeds == 2) then - call s_mpi_abort('Unsupported combination of values of '// & - 'model_eqns (6-eq) and wave_speeds (please use wave_speeds = 1). '// & - 'Exiting ...') - elseif (cyl_coord .and. p /= 0) then - call s_mpi_abort('Unsupported combination of values of '// & - 'model_eqns (6-eq) and cylindrical coordinates. '// & - 'Exiting ...') - end if - end if - - ! phase change checkers. - if (relax) then - if (model_eqns /= 3) then - call s_mpi_abort('phase change requires model_eqns = 3. '// & - 'Exiting ...') - elseif ((relax_model < 0) .or. (relax_model > 6)) then - call s_mpi_abort('relax_model should be in between 0 and 6. '// & - 'Exiting ...') - elseif ((palpha_eps <= 0d0) .or. (palpha_eps >= 1d0) .or. & - (ptgalpha_eps <= 0d0) .or. (ptgalpha_eps >= 1d0)) then - call s_mpi_abort('both palpha_eps and ptgalpha_eps must & - & be in (0,1). '//'Exiting ...') - end if - elseif ((relax_model /= dflt_int) .or. (palpha_eps /= dflt_real) & - .or. (ptgalpha_eps /= dflt_real)) then - call s_mpi_abort('relax is not set as true, but other phase change parameters have & -& been modified. Either activate phase change or set the values to default. '//'Exiting ...') - end if + !> Checks constraints on WENO scheme parameters + subroutine s_check_inputs_weno + character(len=5) :: numStr !< for int to string conversion - if (num_fluids /= dflt_int & - .and. & - (num_fluids < 1 .or. num_fluids > num_fluids)) then - call s_mpi_abort('Unsupported value of num_fluids. Exiting ...') - elseif ((model_eqns == 1 .and. num_fluids /= dflt_int) & - .or. & - (model_eqns == 2 .and. num_fluids == dflt_int)) then - call s_mpi_abort('Unsupported combination of values of '// & - 'model_eqns and num_fluids. '// & - 'Exiting ...') - elseif (model_eqns == 1 .and. adv_alphan) then - call s_mpi_abort('Unsupported combination of values of '// & - 'model_eqns and adv_alphan. '// & - 'Exiting ...') - elseif (model_eqns == 1 .and. mpp_lim) then - call s_mpi_abort('Unsupported combination of values of '// & - 'model_eqns and mpp_lim. Exiting ...') - elseif (num_fluids == 1 .and. mpp_lim) then - call s_mpi_abort('Unsupported combination of values of '// & - 'num_fluids and mpp_lim. Exiting ...') - elseif (time_stepper < 1 .or. time_stepper > 5) then - if (time_stepper /= 23) then - call s_mpi_abort('Unsupported value of time_stepper. Exiting ...') - end if - elseif (all(weno_order /= (/1, 3, 5/))) then - call s_mpi_abort('Unsupported value of weno_order. Exiting ...') - elseif (m + 1 < num_stcls_min*weno_order) then - call s_mpi_abort('Unsupported combination of values of '// & - 'm and weno_order. Exiting ...') + if (m + 1 < num_stcls_min*weno_order) then + call s_int_to_str(num_stcls_min*weno_order, numStr) + call s_mpi_abort('m must be greater than or equal to '// & + '(num_stcls_min*weno_order - 1), whose value is '// & + trim(numStr)//'. Exiting ...') elseif (n + 1 < min(1, n)*num_stcls_min*weno_order) then - call s_mpi_abort('Unsupported combination of values of '// & - 'n and weno_order. Exiting ...') + call s_mpi_abort('For 2D simulation, n must be greater than or '// & + 'equal to (num_stcls_min*weno_order - 1), '// & + 'whose value is '//trim(numStr)//'. Exiting ...') elseif (p + 1 < min(1, p)*num_stcls_min*weno_order) then - call s_mpi_abort('Unsupported combination of values of '// & - 'p and weno_order. Exiting ...') - elseif (weno_eps <= 0d0 .or. weno_eps > 1d-6) then - call s_mpi_abort('Unsupported value of weno_eps. Exiting ...') + call s_mpi_abort('For 3D simulation, p must be greater than or '// & + 'equal to (num_stcls_min*weno_order - 1), '// & + 'whose value is '//trim(numStr)//'. Exiting ...') + elseif (weno_order /= 1 .and. f_is_default(weno_eps)) then + call s_mpi_abort('weno_order != 1, but weno_eps is not set. '// & + 'A typical value of weno_eps is 1e-6. '// & + 'Exiting ...') + elseif (weno_eps <= 0d0) then + call s_mpi_abort('weno_eps must be positive. '// & + 'A typical value of weno_eps is 1e-6. '// & + 'Exiting ...') + elseif (teno .and. f_is_default(teno_CT)) then + call s_mpi_abort('teno is used, but teno_CT is not set. '// & + 'A typical value of teno_CT is 1e-6. '// & + 'Exiting ...') elseif (teno .and. teno_CT <= 0d0) then - call s_mpi_abort('Unsupported value of teno_CT, or teno_CT '// & - 'is not set. teno requires teno_CT to be '// & - 'set to a small positive value. The '// & - 'recommended value is 1e-6. Exiting ...') + call s_mpi_abort('teno_CT must be positive. '// & + 'A typical value of teno_CT is 1e-6. '// & + 'Exiting ...') elseif (count([mapped_weno, wenoz, teno]) >= 2) then - call s_mpi_abort('Unsupported combination of values of '// & - 'mapped_weno, wenoz, and teno. '// & - 'Only one of mapped_weno, wenoz, or teno'// & + call s_mpi_abort('Only one of mapped_weno, wenoz, or teno'// & 'can be set to true. Exiting ...') elseif (weno_order == 1 .and. mapped_weno) then - call s_mpi_abort('Unsupported combination of values of '// & - 'weno_order and mapped_weno. '// & - 'Exiting ...') + call s_mpi_abort('mapped_weno is not supported for '// & + 'weno_order = 1. Exiting ...') elseif (weno_order == 1 .and. wenoz) then - call s_mpi_abort('Unsupported combination of values of '// & - 'weno_order and wenoz. Exiting ...') + call s_mpi_abort('wenoz is not supported for '// & + 'weno_order = 1. Exiting ...') elseif (weno_order /= 5 .and. teno) then - call s_mpi_abort('Unsupported combination of values of '// & - 'weno_order and teno. Exiting ...') + call s_mpi_abort('teno is only supported for '// & + 'weno_order = 5. Exiting ...') elseif (weno_order /= 5 .and. mp_weno) then - call s_mpi_abort('Unsupported combination of values of '// & - 'weno_order and mp_weno. Exiting ...') + call s_mpi_abort('mp_weno is only supported for '// & + 'weno_order = 5. Exiting ...') elseif (model_eqns == 1 .and. weno_avg) then - call s_mpi_abort('Unsupported combination of values of '// & - 'model_eqns and weno_avg. Exiting ...') + call s_mpi_abort('weno_avg is not supported for '// & + 'model_eqns = 1. Exiting ...') + end if + end subroutine s_check_inputs_weno + + !> Checks constraints on Riemann solver parameters + subroutine s_check_inputs_riemann_solver + if (riemann_solver /= 2 .and. model_eqns == 3) then + call s_mpi_abort('6-equation model (model_eqns = 3) '// & + 'requires riemann_solver = 2. Exiting ...') elseif (riemann_solver < 1 .or. riemann_solver > 3) then - call s_mpi_abort('Unsupported value of riemann_solver. Exiting ...') + call s_mpi_abort('riemann_solver must be 1, 2, or 3. Exiting ...') elseif (all(wave_speeds /= (/dflt_int, 1, 2/))) then - call s_mpi_abort('Unsupported value of wave_speeds. Exiting ...') - elseif ((riemann_solver /= 3 .and. wave_speeds == dflt_int) & - .or. & - (riemann_solver == 3 .and. wave_speeds /= dflt_int)) then - call s_mpi_abort('Unsupported combination of values of '// & - 'riemann_solver and wave_speeds. '// & - 'Exiting ...') + call s_mpi_abort('wave_speeds must be 1 or 2. Exiting ...') + elseif (riemann_solver == 3 .and. wave_speeds /= dflt_int) then + call s_mpi_abort('Exact Riemann (riemann_solver = 3) '// & + 'does not support wave_speeds. Exiting ...') elseif (all(avg_state /= (/dflt_int, 1, 2/))) then call s_mpi_abort('Unsupported value of avg_state. Exiting ...') + elseif (riemann_solver /= 3 .and. wave_speeds == dflt_int) then + call s_mpi_abort('wave_speeds must be set if '// & + 'riemann_solver != 3. Exiting ...') elseif (riemann_solver /= 3 .and. avg_state == dflt_int) then - call s_mpi_abort('Unsupported combination of values of '// & - 'riemann_solver and avg_state. '// & - 'Exiting ...') - elseif (bc_x%beg < -16 .or. bc_x%beg > -1 .or. bc_x%beg == -14) then - call s_mpi_abort('Unsupported value of bc_x%beg. Exiting ...') - elseif (bc_x%end < -16 .or. bc_x%end > -1 .or. bc_x%beg == -14) then - call s_mpi_abort('Unsupported value of bc_x%end. Exiting ...') - elseif ((bc_x%beg == -1 .and. bc_x%end /= -1) & - .or. & - (bc_x%end == -1 .and. bc_x%beg /= -1)) then - call s_mpi_abort('Unsupported combination of values of '// & - 'bc_x%beg and bc_x%end. Exiting ...') - elseif (bc_y%beg /= dflt_int & - .and. & - (((cyl_coord .neqv. .true.) .and. (bc_y%beg < -16 .or. bc_y%beg > -1 .or. bc_y%beg == -14)) & - .or. & - (cyl_coord .and. p == 0 .and. bc_y%beg /= -2) & - .or. & - (cyl_coord .and. p > 0 .and. bc_y%beg /= -14))) then - call s_mpi_abort('Unsupported value of bc_y%beg. Exiting ...') - elseif (bc_y%end /= dflt_int & - .and. & - (bc_y%end < -16 .or. bc_y%end > -1 .or. bc_y%end == -14)) then - call s_mpi_abort('Unsupported value of bc_y%end. Exiting ...') - elseif ((n == 0 .and. bc_y%beg /= dflt_int) & - .or. & - (n > 0 .and. bc_y%beg == dflt_int)) then - call s_mpi_abort('Unsupported combination of values of '// & - 'n and bc_y%beg. Exiting ...') - elseif ((n == 0 .and. bc_y%end /= dflt_int) & - .or. & - (n > 0 .and. bc_y%end == dflt_int)) then - call s_mpi_abort('Unsupported combination of values of '// & - 'n and bc_y%end. Exiting ...') - elseif ((bc_y%beg == -1 .and. bc_y%end /= -1) & - .or. & - (bc_y%end == -1 .and. bc_y%beg /= -1)) then - call s_mpi_abort('Unsupported combination of values of '// & - 'bc_y%beg and bc_y%end. Exiting ...') - elseif (bc_z%beg /= dflt_int & - .and. & - (bc_z%beg < -16 .or. bc_z%beg > -1 .or. bc_z%beg == -14)) then - call s_mpi_abort('Unsupported value of bc_z%beg. Exiting ...') - elseif (any((/bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, bc_z%end/) == -13)) then - call s_mpi_abort('Unsupported choice of boundary condition -13') - elseif (bc_z%end /= dflt_int & - .and. & - (bc_z%end < -16 .or. bc_z%end > -1 .or. bc_z%end == -14)) then - call s_mpi_abort('Unsupported value of bc_z%end. Exiting ...') - elseif ((p == 0 .and. bc_z%beg /= dflt_int) & - .or. & - (p > 0 .and. bc_z%beg == dflt_int)) then - call s_mpi_abort('Unsupported combination of values of '// & - 'p and bc_z%beg. Exiting ...') - elseif ((p == 0 .and. bc_z%end /= dflt_int) & - .or. & - (p > 0 .and. bc_z%end == dflt_int)) then - call s_mpi_abort('Unsupported combination of values of '// & - 'p and bc_z%end. Exiting ...') - elseif ((bc_z%beg == -1 .and. bc_z%end /= -1) & - .or. & - (bc_z%end == -1 .and. bc_z%beg /= -1)) then - call s_mpi_abort('Unsupported combination of values of '// & - 'bc_z%beg and bc_z%end. Exiting ...') - elseif (model_eqns == 1 .and. alt_soundspeed) then - call s_mpi_abort('Unsupported combination of model_eqns '// & - 'and alt_soundspeed. Exiting ...') - elseif (model_eqns == 4 .and. alt_soundspeed) then - call s_mpi_abort('Unsupported combination of model_eqns '// & - 'and alt_soundspeed. Exiting ...') - elseif ((num_fluids /= 2 .and. num_fluids /= 3) .and. alt_soundspeed) then - call s_mpi_abort('Unsupported combination of num_fluids '// & - 'and alt_soundspeed. Exiting ...') - 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 ...') + call s_mpi_abort('avg_state must be set if '// & + 'riemann_solver != 3. Exiting ...') end if + end subroutine s_check_inputs_riemann_solver - if (adap_dt) then - if (time_stepper /= 3) then - call s_mpi_abort('Unsupported combination of adap_dt '// & - 'and time_stepper. Exiting ...') - else if (qbmm) then - call s_mpi_abort('Unsupported combination of adap_dt '// & - 'and qbmm. Exiting ...') - else if (.not. polytropic) then - call s_mpi_abort('Unsupported combination of adap_dt '// & - 'and polytropic. Exiting ...') - else if (.not. adv_n) then - call s_mpi_abort('Unsupported combination of adap_dt '// & - 'and adv_n. Exiting ...') + !> Checks constraints on time stepping parameters + subroutine s_check_inputs_time_stepping + if (dt <= 0) then + call s_mpi_abort('dt must be positive. Exiting ...') + end if + + if (time_stepper < 1 .or. time_stepper > 5) then + if (time_stepper /= 23) then + call s_mpi_abort('time_stepper must be between 1 and 5. '// & + 'Exiting ...') + end if + end if + end subroutine s_check_inputs_time_stepping + + !> Checks constraints on parameters related to 6-equation model + subroutine s_check_inputs_model_eqns + if (model_eqns == 3) then + if (avg_state /= 2) then + call s_mpi_abort('6-equation model (model_eqns = 3) '// & + 'requires avg_state = 2. Exiting ...') + elseif (wave_speeds /= 1) then + call s_mpi_abort('6-equation model (model_eqns = 3) '// & + 'requires wave_speeds = 1. Exiting ...') end if end if - ! END: Simulation Algorithm Parameters ============================= + end subroutine s_check_inputs_model_eqns - ! Finite Difference Parameters ===================================== - if (fd_order /= dflt_int & - .and. & - fd_order /= 1 .and. fd_order /= 2 .and. fd_order /= 4) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'fd_order. Exiting ...') - elseif (probe_wrt .and. fd_order == dflt_int) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for probe_wrt, and fd_order. '// & + !> 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 ...') + end if + end subroutine + + !> Checks constraints on bubble parameters + subroutine s_check_inputs_bubbles + if (riemann_solver /= 2) then + call s_mpi_abort('Bubble modeling requires riemann_solver = 2') + elseif (avg_state /= 2) then + call s_mpi_abort('Bubble modeling requires arithmetic average '// & + '(avg_state = 2). Exiting ...') + elseif (model_eqns == 2 .and. bubble_model == 1) then + call s_mpi_abort('The 5-equation bubbly flow model requires '// & + 'bubble_model = 2 (Keller--Miksis). Exiting ...') + end if + end subroutine s_check_inputs_bubbles + + !> Checks constraints on adaptive time stepping parameters (adap_dt) + subroutine s_check_inputs_adapt_dt + if (time_stepper /= 3) then + call s_mpi_abort('adapt_dt requires Runge-Kutta 3 '// & + '(time_stepper = 3). Exiting ...') + else if (qbmm) then + call s_mpi_abort('adapt_dt is not supported with QBMM. Exiting ...') + else if (.not. polytropic) then + call s_mpi_abort('adapt_dt is enabled, but polytropic is not. '// & 'Exiting ...') - elseif (integral_wrt .and. (bubbles .neqv. .true.)) then - call s_mpi_abort('Unsupported choice of the combination of '// & - 'values for integral_wrt, and bubbles. '// & + else if (.not. adv_n) then + call s_mpi_abort('adapt_dt is enabled, but adv_n is not. '// & 'Exiting ...') end if - ! END: Finite Difference Parameters ================================ + end subroutine s_check_inputs_adapt_dt + + !> Checks constraints on alternative sound speed parameters (alt_soundspeed) + subroutine s_check_inputs_alt_soundspeed + if (model_eqns /= 2) then + call s_mpi_abort('5-equation model (model_eqns = 2) '// & + 'is required for alt_soundspeed. Exiting ...') + elseif (num_fluids /= 2 .and. num_fluids /= 3) then + call s_mpi_abort('alt_soundspeed requires num_fluids = 2 or 3. '// & + 'Exiting ...') + elseif (riemann_solver /= 2) then + call s_mpi_abort('alt_soundspeed requires HLLC Riemann solver '// & + '(riemann_solver = 2). Exiting ...') + end if + end subroutine s_check_inputs_alt_soundspeed - ! Fluids Physical Parameters ======================================= - do i = 1, num_fluids - call s_int_to_str(i, iStr) - if (fluid_pp(i)%gamma /= dflt_real & - .and. & - fluid_pp(i)%gamma <= 0d0) then - call s_mpi_abort('Unsupported value of '// & - 'fluid_pp('//trim(iStr)//')%'// & - 'gamma. Exiting ...') - elseif (model_eqns == 1 & - .and. & - fluid_pp(i)%gamma /= dflt_real) then - call s_mpi_abort('Unsupported combination '// & - 'of values of model_eqns '// & - 'and fluid_pp('//trim(iStr)//')%'// & - 'gamma. Exiting ...') - elseif ((i <= num_fluids + bub_fac .and. fluid_pp(i)%gamma <= 0d0) & - .or. & - (i > num_fluids + bub_fac .and. fluid_pp(i)%gamma /= dflt_real)) & - then - call s_mpi_abort('Unsupported combination '// & - 'of values of num_fluids '// & - 'and fluid_pp('//trim(iStr)//')%'// & - 'gamma. Exiting ...') - elseif (fluid_pp(i)%pi_inf /= dflt_real & - .and. & - fluid_pp(i)%pi_inf < 0d0) then - call s_mpi_abort('Unsupported value of '// & - 'fluid_pp('//trim(iStr)//')%'// & - 'pi_inf. Exiting ...') - elseif (model_eqns == 1 & - .and. & - fluid_pp(i)%pi_inf /= dflt_real) then - call s_mpi_abort('Unsupported combination '// & - 'of values of model_eqns '// & - 'and fluid_pp('//trim(iStr)//')%'// & - 'pi_inf. Exiting ...') - elseif ((i <= num_fluids + bub_fac .and. fluid_pp(i)%pi_inf < 0d0) & - .or. & - (i > num_fluids + bub_fac .and. fluid_pp(i)%pi_inf /= dflt_real)) & - then - call s_mpi_abort('Unsupported combination '// & - 'of values of num_fluids '// & - 'and fluid_pp('//trim(iStr)//')%'// & - 'pi_inf. Exiting ...') - elseif (fluid_pp(i)%cv < 0d0) then - call s_mpi_abort('Unsupported value of '// & - 'fluid_pp('//trim(iStr)//')%'// & - 'cv. Make sure cv is positive. Exiting ...') - end if + !> Checks constraints on viscosity parameters (fluid_pp(i)%Re(1:2)) + !! of the stiffened gas equation of state + subroutine s_check_inputs_stiffened_eos_viscosity + character(len=5) :: iStr, jStr + integer :: i, j + do i = 1, num_fluids do j = 1, 2 call s_int_to_str(j, jStr) - if (fluid_pp(i)%Re(j) /= dflt_real & + if ((.not. f_is_default(fluid_pp(i)%Re(j))) & .and. & fluid_pp(i)%Re(j) <= 0d0) then - call s_mpi_abort('Unsupported value of '// & + call s_mpi_abort('fluid_pp('//trim(iStr)//')%'// & + 'Re('//trim(jStr)//') must be positive. '// & + 'Exiting ...') + else if (model_eqns == 1 & + .and. & + (.not. f_is_default(fluid_pp(i)%Re(j)))) then + call s_mpi_abort('model_eqns = 1 does not support '// & 'fluid_pp('//trim(iStr)//')%'// & 'Re('//trim(jStr)//'). Exiting ...') - end if - - if (model_eqns == 1 & - .and. & - fluid_pp(i)%Re(j) /= dflt_real) then - call s_mpi_abort('Unsupported combination '// & - 'of values of model_eqns '// & - 'and fluid_pp('//trim(iStr)//')%'// & - 'Re('//trim(jStr)//'). Exiting ...') - end if - - if (i > num_fluids & - .and. & - fluid_pp(i)%Re(j) /= dflt_real) then - call s_mpi_abort('Unsupported combination '// & - 'of values of num_fluids '// & - 'and fluid_pp('//trim(iStr)//')%'// & - 'Re('//trim(jStr)//'). Exiting ...') - end if - - if (weno_order == 1 & - .and. & - (weno_avg .neqv. .true.) & - .and. & - fluid_pp(i)%Re(j) /= dflt_real) then - call s_mpi_abort('Unsupported combination '// & - 'of values of weno_order, '// & - 'weno_avg and fluid_pp('//trim(iStr)//')%'// & + else if (i > num_fluids & + .and. & + (.not. f_is_default(fluid_pp(i)%Re(j)))) then + call s_mpi_abort('First index ('//trim(iStr)//') of '// & + 'fluid_pp('//trim(iStr)//')%'// & + 'Re('//trim(jStr)//') exceeds '// & + 'num_fluids. Exiting ...') + else if (weno_order == 1 .and. (.not. weno_avg) & + .and. & + (.not. f_is_default(fluid_pp(i)%Re(j)))) then + call s_mpi_abort('weno_order = 1 without weno_avg '// & + 'does not support '// & + 'fluid_pp('//trim(iStr)//')%'// & 'Re('//trim(jStr)//'). Exiting ...') end if - end do - end do - ! END: Fluids Physical Parameters ================================== - - ! Constraints on the surface tension model - if (sigma /= dflt_real .and. sigma < 0d0) then - call s_mpi_abort('The surface tension coefficient must be'// & - 'greater than or equal to zero. Exiting ...') - elseif (sigma /= dflt_real .and. model_eqns /= 3) then - call s_mpi_abort("The surface tension model requires"// & - 'model_eqns=3. Exiting ...') - end if - - ! Moving Boundaries Checks: x boundaries - if (any((/bc_x%vb1, bc_x%vb2, bc_x%vb3/) /= 0d0)) then - if (bc_x%beg == -15) then - if (any((/bc_x%vb2, bc_x%vb3/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_x%beg and"// & - "bc_x%vb2 or bc_x%vb3. Exiting ...") - end if - elseif (bc_x%beg /= -16) then - call s_mpi_abort("Unsupported combination of bc_x%beg and"// & - "bc_x%vb1, bc_x%vb2, or bc_x%vb3. Exiting...") - end if - end if - - if (any((/bc_x%ve1, bc_x%ve2, bc_x%ve3/) /= 0d0)) then - if (bc_x%end == -15) then - if (any((/bc_x%ve2, bc_x%ve3/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_x%end and"// & - "bc_x%ve2 or bc_x%ve3. Exiting ...") - end if - elseif (bc_x%end /= -16) then - call s_mpi_abort("Unsupported combination of bc_x%end and"// & - "bc_x%ve1, bc_x%ve2, or bc_x%ve3. Exiting...") - end if - end if - - ! Moving Boundaries Checks: y boundaries - if (any((/bc_y%vb1, bc_y%vb2, bc_y%vb3/) /= 0d0)) then - if (bc_y%beg == -15) then - if (any((/bc_y%vb1, bc_y%vb3/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_y%beg and"// & - "bc_y%vb1 or bc_y%vb3. Exiting ...") - end if - elseif (bc_y%beg /= -16) then - call s_mpi_abort("Unsupported combination of bc_y%beg and"// & - "bc_y%vb1, bc_y%vb2, or bc_y%vb3. Exiting...") - end if - end if - - if (any((/bc_y%ve1, bc_y%ve2, bc_y%ve3/) /= 0d0)) then - if (bc_y%end == 15) then - if (any((/bc_y%ve1, bc_y%ve3/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_y%end and"// & - "bc_y%ve1 or bc_y%ve3. Exiting ...") - end if - elseif (bc_y%end /= -16) then - call s_mpi_abort("Unsupported combination of bc_y%end and"// & - "bc_y%ve1, bc_y%ve2, or bc_y%ve3. Exiting...") - end if - end if - - ! Moving Boundaries Checks: z boundaries - if (any((/bc_z%vb1, bc_z%vb2, bc_z%vb3/) /= 0d0)) then - if (bc_z%beg == -15) then - if (any((/bc_x%vb1, bc_x%vb2/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_z%beg and"// & - "bc_x%vb1 or bc_x%vb1. Exiting ...") - end if - elseif (bc_z%beg /= -16) then - call s_mpi_abort("Unsupported combination of bc_z%beg and"// & - "bc_z%vb1, bc_z%vb2, or bc_z%vb3. Exiting...") - end if - end if - - if (any((/bc_z%ve1, bc_z%ve2, bc_z%ve3/) /= 0d0)) then - if (bc_z%end == -15) then - if (any((/bc_x%ve1, bc_x%ve2/) /= 0d0)) then - call s_mpi_abort("Unsupported combination of bc_z%end and"// & - "bc_z%ve2 or bc_z%ve3. Exiting ...") - end if - elseif (bc_z%end /= -16) then - call s_mpi_abort("Unsupported combination of bc_z%end and"// & - "bc_z%ve1, bc_z%ve2, or bc_z%ve3. Exiting...") - end if - end if - - ! Check IB parameters - if (ib) then - if (n <= 0) then - call s_mpi_abort('Unsupported choices of the combination of values for '// & - 'ib and n. Immersed Boundaries do not work in 1D. Exiting ...') - else if (num_ibs <= 0 .or. num_ibs > num_patches_max) then - call s_mpi_abort('Unsupported choice for the value of '// & - 'num_ibs. Exiting ...') - end if - end if - - if (num_ibs > 0 .and. .not. ib) then - call s_mpi_abort('Unsupported choices of the combination of values for '// & - 'num_ibs and ib. Exiting ...') - end if + end subroutine s_check_inputs_stiffened_eos_viscosity + !> Checks constraints on body forces parameters (bf_x[y,z], etc.) + subroutine s_check_inputs_body_forces #:for DIR in ['x', 'y', 'z'] - if (bf_${DIR}$ .and. k_${DIR}$ == dflt_real) then + if (bf_${DIR}$ .and. f_is_default(k_${DIR}$)) then call s_mpi_abort('k_${DIR}$ must be specified if bf_${DIR}$ is true '// & 'Exiting ...') - elseif (bf_${DIR}$ .and. w_${DIR}$ == dflt_real) then + elseif (bf_${DIR}$ .and. f_is_default(w_${DIR}$)) then call s_mpi_abort('w_${DIR}$ must be specified if bf_${DIR}$ is true '// & 'Exiting ...') - elseif (bf_${DIR}$ .and. p_${DIR}$ == dflt_real) then + elseif (bf_${DIR}$ .and. f_is_default(p_${DIR}$)) then call s_mpi_abort('p_${DIR}$ must be specified if bf_${DIR}$ is true '// & 'Exiting ...') - elseif (bf_${DIR}$ .and. g_${DIR}$ == dflt_real) then + elseif (bf_${DIR}$ .and. f_is_default(g_${DIR}$)) then call s_mpi_abort('g_${DIR}$ must be specified if bf_${DIR}$ is true '// & 'Exiting ...') end if #:endfor - - end subroutine s_check_inputs + end subroutine s_check_inputs_body_forces + + !> Checks miscellaneous constraints, + !! including constraints on probe_wrt and integral_wrt + subroutine s_check_inputs_misc + ! Write probe data + if (probe_wrt .and. fd_order == dflt_int) then + call s_mpi_abort('probe_wrt is enabled, but fd_order is not set. '// & + 'Exiting ...') + ! Write integral data for bubbles + elseif (integral_wrt .and. (.not. bubbles)) then + call s_mpi_abort('integral_wrt is enabled, but bubbles is not. '// & + 'Exiting ...') + end if + end subroutine s_check_inputs_misc end module m_checker diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 31fffd3f8..c35ead7a4 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -152,7 +152,7 @@ module m_global_parameters !< amplitude, frequency, and phase shift sinusoid in each direction #:for dir in {'x', 'y', 'z'} #:for param in {'k','w','p','g'} - real :: ${param}$_${dir}$ + real(kind(0d0)) :: ${param}$_${dir}$ #:endfor #:endfor real(kind(0d0)), dimension(3) :: accel_bf diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 9bb39173f..82ac10aa5 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -67,6 +67,8 @@ module m_start_up use m_compile_specific + use m_checker_common + use m_checker use m_surface_tension @@ -230,6 +232,7 @@ contains end if ! ================================================================== + call s_check_inputs_common() call s_check_inputs() end subroutine s_check_input_file