From bc6fec9f798e7809b9bdbaaaa50aad16a921d1dc Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Thu, 19 Sep 2024 15:42:52 -0700 Subject: [PATCH 01/68] Replace kind(0d0) with wp declared in common --- src/common/include/macros.fpp | 4 +- src/common/m_constants.fpp | 18 +- src/common/m_delay_file_access.f90 | 3 +- src/common/m_derived_types.fpp | 175 +++++++-------- src/common/m_eigen_solver.f90 | 50 ++--- src/common/m_finite_differences.fpp | 6 +- src/common/m_helper.fpp | 14 +- src/common/m_helper_basic.f90 | 22 +- src/common/m_mpi_common.fpp | 40 ++-- src/common/m_phase_change.fpp | 10 +- src/common/m_precision_select.f90 | 23 ++ src/common/m_variables_conversion.fpp | 208 +++++++++--------- src/post_process/m_data_input.f90 | 6 +- src/post_process/m_data_output.fpp | 12 +- src/post_process/m_derived_variables.fpp | 44 ++-- src/post_process/m_global_parameters.fpp | 40 ++-- src/post_process/m_mpi_proxy.fpp | 18 +- src/post_process/m_start_up.f90 | 2 +- src/post_process/p_main.fpp | 6 +- src/pre_process/include/2dHardcodedIC.fpp | 6 +- src/pre_process/include/3dHardcodedIC.fpp | 4 +- src/pre_process/m_assign_variables.fpp | 74 +++---- src/pre_process/m_data_output.fpp | 18 +- src/pre_process/m_global_parameters.fpp | 50 ++--- src/pre_process/m_grid.f90 | 46 ++-- src/pre_process/m_model.fpp | 8 +- src/pre_process/m_mpi_proxy.fpp | 10 +- src/pre_process/m_patches.fpp | 80 +++---- src/pre_process/m_perturbation.fpp | 102 ++++----- src/pre_process/m_start_up.fpp | 14 +- src/pre_process/p_main.f90 | 4 +- src/simulation/m_acoustic_src.fpp | 92 ++++---- src/simulation/m_body_forces.fpp | 6 +- src/simulation/m_boundary_conditions.fpp | 16 +- src/simulation/m_bubbles.fpp | 124 +++++------ src/simulation/m_cbc.fpp | 156 +++++++------- src/simulation/m_chemistry.fpp | 12 +- src/simulation/m_compute_cbc.fpp | 112 +++++----- src/simulation/m_compute_levelset.fpp | 70 +++--- src/simulation/m_data_output.fpp | 148 ++++++------- src/simulation/m_derived_variables.f90 | 12 +- src/simulation/m_fftw.fpp | 24 +-- src/simulation/m_global_parameters.fpp | 90 ++++---- src/simulation/m_hypoelastic.fpp | 22 +- src/simulation/m_ibm.fpp | 90 ++++---- src/simulation/m_mpi_proxy.fpp | 26 +-- src/simulation/m_qbmm.fpp | 48 ++--- src/simulation/m_rhs.fpp | 88 ++++---- src/simulation/m_riemann_solvers.fpp | 252 +++++++++++----------- src/simulation/m_sim_helpers.f90 | 40 ++-- src/simulation/m_start_up.fpp | 46 ++-- src/simulation/m_surface_tension.fpp | 20 +- src/simulation/m_time_steppers.fpp | 64 +++--- src/simulation/m_viscous.fpp | 20 +- src/simulation/m_weno.fpp | 126 +++++------ src/simulation/p_main.fpp | 10 +- src/syscheck/syscheck.fpp | 2 +- 57 files changed, 1431 insertions(+), 1402 deletions(-) create mode 100644 src/common/m_precision_select.f90 diff --git a/src/common/include/macros.fpp b/src/common/include/macros.fpp index 27a1bf3385..36fa74ebc3 100644 --- a/src/common/include/macros.fpp +++ b/src/common/include/macros.fpp @@ -146,8 +146,8 @@ end if #:enddef -#define t_vec3 real(kind(0d0)), dimension(1:3) -#define t_mat4x4 real(kind(0d0)), dimension(1:4,1:4) +#define t_vec3 real(wp), dimension(1:3) +#define t_mat4x4 real(wp), dimension(1:4,1:4) #:def ASSERT(predicate, message = None) if (.not. (${predicate}$)) then diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp index a39fdb78ae..6f1f0d25e6 100644 --- a/src/common/m_constants.fpp +++ b/src/common/m_constants.fpp @@ -4,13 +4,15 @@ module m_constants + use m_precision_select + character, parameter :: dflt_char = ' ' !< Default string value - real(kind(0d0)), parameter :: dflt_real = -1d6 !< Default real value - real(kind(0d0)), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance - real(kind(0d0)), parameter :: small_alf = 1d-11 !< Small alf tolerance - real(kind(0d0)), parameter :: pi = 3.141592653589793d0 !< Pi - real(kind(0d0)), parameter :: verysmall = 1.d-12 !< Very small number + real(wp), parameter :: dflt_real = -1d6 !< Default real value + real(wp), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance + real(wp), parameter :: small_alf = 1d-11 !< Small alf tolerance + real(wp), parameter :: pi = 3.141592653589793d0 !< Pi + real(wp), parameter :: verysmall = 1.d-12 !< Very small number integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils integer, parameter :: path_len = 400 !< Maximum path length @@ -22,8 +24,8 @@ module m_constants integer, parameter :: num_patches_max = 10 integer, parameter :: pathlen_max = 400 integer, parameter :: nnode = 4 !< Number of QBMM nodes - real(kind(0d0)), parameter :: capillary_cutoff = 1e-6 !< color function gradient magnitude at which to apply the surface tension fluxes - real(kind(0d0)), parameter :: acoustic_spatial_support_width = 2.5d0 !< Spatial support width of acoustic source, used in s_source_spatial - real(kind(0d0)), parameter :: dflt_vcfl_dt = 100d0 !< value of vcfl_dt when viscosity is off for computing adaptive timestep size + real(wp), parameter :: capillary_cutoff = 1e-6 !< color function gradient magnitude at which to apply the surface tension fluxes + real(wp), parameter :: acoustic_spatial_support_width = 2.5d0 !< Spatial support width of acoustic source, used in s_source_spatial + real(wp), parameter :: dflt_vcfl_dt = 100d0 !< value of vcfl_dt when viscosity is off for computing adaptive timestep size end module m_constants diff --git a/src/common/m_delay_file_access.f90 b/src/common/m_delay_file_access.f90 index 54dd3edbad..df8b368dcd 100644 --- a/src/common/m_delay_file_access.f90 +++ b/src/common/m_delay_file_access.f90 @@ -1,4 +1,5 @@ module m_delay_file_access + use m_precision_select implicit none private @@ -14,7 +15,7 @@ subroutine DelayFileAccess(ProcessRank) integer, intent(in) :: ProcessRank integer :: iDelay, nFileAccessDelayIterations - real(kind(0d0)) :: Number, Dummy + real(wp) :: Number, Dummy nFileAccessDelayIterations & = (ProcessRank/N_PROCESSES_FILE_ACCESS)*FILE_ACCESS_DELAY_UNIT diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index 65d4094748..5c0b2a9524 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -9,23 +9,24 @@ module m_derived_types use m_constants !< Constants + use m_precision_select use m_thermochem !< Thermodynamic properties implicit none !> Derived type adding the field position (fp) as an attribute type field_position - real(kind(0d0)), allocatable, dimension(:, :, :) :: fp !< Field position + real(wp), allocatable, dimension(:, :, :) :: fp !< Field position end type field_position !> Derived type annexing a scalar field (SF) type scalar_field - real(kind(0d0)), pointer, dimension(:, :, :) :: sf => null() + real(wp), pointer, dimension(:, :, :) :: sf => null() end type scalar_field !> Derived type for bubble variables pb and mv at quadrature nodes (qbmm) type pres_field - real(kind(0d0)), pointer, dimension(:, :, :, :, :) :: sf => null() + real(wp), pointer, dimension(:, :, :, :, :) :: sf => null() end type pres_field !> Derived type annexing an integer scalar field (SF) @@ -52,18 +53,18 @@ module m_derived_types type int_bounds_info integer :: beg integer :: end - real(kind(0d0)) :: vb1 - real(kind(0d0)) :: vb2 - real(kind(0d0)) :: vb3 - real(kind(0d0)) :: ve1 - real(kind(0d0)) :: ve2 - real(kind(0d0)) :: ve3 + real(wp) :: vb1 + real(wp) :: vb2 + real(wp) :: vb3 + real(wp) :: ve1 + real(wp) :: ve2 + real(wp) :: ve3 end type int_bounds_info !> Derived type adding beginning (beg) and end bounds info as attributes type bounds_info - real(kind(0d0)) :: beg - real(kind(0d0)) :: end + real(wp) :: beg + real(wp) :: end end type bounds_info !> bounds for the bubble dynamic variables @@ -96,12 +97,12 @@ module m_derived_types integer :: spc !< !! Number of samples per cell to use when discretizing the STL object. - real(kind(0d0)) :: threshold !< + real(wp) :: threshold !< !! Threshold to turn on smoothen STL patch. end type ic_model_parameters type :: t_triangle - real(kind(0d0)), dimension(1:3, 1:3) :: v ! Vertices of the triangle + real(wp), dimension(1:3, 1:3) :: v ! Vertices of the triangle t_vec3 :: n ! Normal vector end type t_triangle @@ -128,24 +129,24 @@ module m_derived_types integer :: geometry !< Type of geometry for the patch - real(kind(0d0)) :: x_centroid, y_centroid, z_centroid !< + real(wp) :: x_centroid, y_centroid, z_centroid !< !! Location of the geometric center, i.e. the centroid, of the patch. It !! is specified through its x-, y- and z-coordinates, respectively. - real(kind(0d0)) :: length_x, length_y, length_z !< Dimensions of the patch. x,y,z Lengths. - real(kind(0d0)) :: radius !< Dimensions of the patch. radius. + real(wp) :: length_x, length_y, length_z !< Dimensions of the patch. x,y,z Lengths. + real(wp) :: radius !< Dimensions of the patch. radius. - real(kind(0d0)), dimension(3) :: radii !< + real(wp), dimension(3) :: radii !< !! Vector indicating the various radii for the elliptical and ellipsoidal !! patch geometries. It is specified through its x-, y-, and z-components !! respectively. type(ic_model_parameters) :: model !< Model parameters - real(kind(0d0)) :: epsilon, beta !< + real(wp) :: epsilon, beta !< !! The spherical harmonics eccentricity parameters. - real(kind(0d0)), dimension(3) :: normal !< + real(wp), dimension(3) :: normal !< !! Normal vector indicating the orientation of the patch. It is specified !! through its x-, y- and z-components, respectively. logical, dimension(0:num_patches_max - 1) :: alter_patch !< @@ -161,39 +162,39 @@ module m_derived_types integer :: smooth_patch_id !< !! Identity (id) of the patch with which current patch is to get smoothed - real(kind(0d0)) :: smooth_coeff !< + real(wp) :: smooth_coeff !< !! Smoothing coefficient (coeff) adminstrating the size of the stencil of !! cells across which boundaries of the current patch will be smeared out - real(kind(0d0)), dimension(num_fluids_max) :: alpha_rho - real(kind(0d0)) :: rho - real(kind(0d0)), dimension(3) :: vel - real(kind(0d0)) :: pres - real(kind(0d0)), dimension(num_fluids_max) :: alpha - real(kind(0d0)) :: gamma - real(kind(0d0)) :: pi_inf !< - real(kind(0d0)) :: cv !< - real(kind(0d0)) :: qv !< - real(kind(0d0)) :: qvp !< + real(wp), dimension(num_fluids_max) :: alpha_rho + real(wp) :: rho + real(wp), dimension(3) :: vel + real(wp) :: pres + real(wp), dimension(num_fluids_max) :: alpha + real(wp) :: gamma + real(wp) :: pi_inf !< + real(wp) :: cv !< + real(wp) :: qv !< + real(wp) :: qvp !< !! Primitive variables associated with the patch. In order, these include !! the partial densities, density, velocity, pressure, volume fractions, !! specific heat ratio function and the liquid stiffness function. - real(kind(0d0)), dimension(6) :: tau_e + real(wp), dimension(6) :: tau_e !! Elastic stresses added to primitive variables if hypoelasticity = True - real(kind(0d0)) :: R0 !< Bubble size - real(kind(0d0)) :: V0 !< Bubble velocity + real(wp) :: R0 !< Bubble size + real(wp) :: V0 !< Bubble velocity - real(kind(0d0)) :: p0 !< Bubble size - real(kind(0d0)) :: m0 !< Bubble velocity + real(wp) :: p0 !< Bubble size + real(wp) :: m0 !< Bubble velocity integer :: hcid !! id for hard coded initial condition - real(kind(0d0)) :: cf_val !! color function value - real(kind(0d0)) :: Y(1:num_species) + real(wp) :: cf_val !! color function value + real(wp) :: Y(1:num_species) end type ic_patch_parameters @@ -201,15 +202,15 @@ module m_derived_types integer :: geometry !< Type of geometry for the patch - real(kind(0d0)) :: x_centroid, y_centroid, z_centroid !< + real(wp) :: x_centroid, y_centroid, z_centroid !< !! Location of the geometric center, i.e. the centroid, of the patch. It !! is specified through its x-, y- and z-coordinates, respectively. - real(kind(0d0)) :: c, p, t, m + real(wp) :: c, p, t, m - real(kind(0d0)) :: length_x, length_y, length_z !< Dimensions of the patch. x,y,z Lengths. - real(kind(0d0)) :: radius !< Dimensions of the patch. radius. - real(kind(0d0)) :: theta + real(wp) :: length_x, length_y, length_z !< Dimensions of the patch. x,y,z Lengths. + real(wp) :: radius !< Dimensions of the patch. radius. + real(wp) :: theta logical :: slip @@ -218,27 +219,27 @@ module m_derived_types !> Derived type annexing the physical parameters (PP) of the fluids. These !! include the specific heat ratio function and liquid stiffness function. type physical_parameters - real(kind(0d0)) :: gamma !< Sp. heat ratio - real(kind(0d0)) :: pi_inf !< Liquid stiffness - real(kind(0d0)), dimension(2) :: Re !< Reynolds number - real(kind(0d0)) :: cv !< heat capacity - real(kind(0d0)) :: qv !< reference energy per unit mass for SGEOS, q (see Le Metayer (2004)) - real(kind(0d0)) :: qvp !< reference entropy per unit mass for SGEOS, q' (see Le Metayer (2004)) - real(kind(0d0)) :: mul0 !< Bubble viscosity - real(kind(0d0)) :: ss !< Bubble surface tension - real(kind(0d0)) :: pv !< Bubble vapour pressure - real(kind(0d0)) :: gamma_v !< Bubble constants (see Preston (2007), Ando (2010)) - real(kind(0d0)) :: M_v !< Bubble constants (see Preston (2007), Ando (2010)) - real(kind(0d0)) :: mu_v !< Bubble constants (see Preston (2007), Ando (2010)) - real(kind(0d0)) :: k_v !< Bubble constants (see Preston (2007), Ando (2010)) - real(kind(0d0)) :: G + real(wp) :: gamma !< Sp. heat ratio + real(wp) :: pi_inf !< Liquid stiffness + real(wp), dimension(2) :: Re !< Reynolds number + real(wp) :: cv !< heat capacity + real(wp) :: qv !< reference energy per unit mass for SGEOS, q (see Le Metayer (2004)) + real(wp) :: qvp !< reference entropy per unit mass for SGEOS, q' (see Le Metayer (2004)) + real(wp) :: mul0 !< Bubble viscosity + real(wp) :: ss !< Bubble surface tension + real(wp) :: pv !< Bubble vapour pressure + real(wp) :: gamma_v !< Bubble constants (see Preston (2007), Ando (2010)) + real(wp) :: M_v !< Bubble constants (see Preston (2007), Ando (2010)) + real(wp) :: mu_v !< Bubble constants (see Preston (2007), Ando (2010)) + real(wp) :: k_v !< Bubble constants (see Preston (2007), Ando (2010)) + real(wp) :: G end type physical_parameters !> Derived type annexing the flow probe location type probe_parameters - real(kind(0d0)) :: x !< First coordinate location - real(kind(0d0)) :: y !< Second coordinate location - real(kind(0d0)) :: z !< Third coordinate location + real(wp) :: x !< First coordinate location + real(wp) :: y !< Second coordinate location + real(wp) :: z !< Third coordinate location end type probe_parameters type mpi_io_airfoil_ib_var @@ -248,12 +249,12 @@ module m_derived_types !> Derived type annexing integral regions type integral_parameters - real(kind(0d0)) :: xmin !< Min. boundary first coordinate direction - real(kind(0d0)) :: xmax !< Max. boundary first coordinate direction - real(kind(0d0)) :: ymin !< Min. boundary second coordinate direction - real(kind(0d0)) :: ymax !< Max. boundary second coordinate direction - real(kind(0d0)) :: zmin !< Min. boundary third coordinate direction - real(kind(0d0)) :: zmax !< Max. boundary third coordinate direction + real(wp) :: xmin !< Min. boundary first coordinate direction + real(wp) :: xmax !< Max. boundary first coordinate direction + real(wp) :: ymin !< Min. boundary second coordinate direction + real(wp) :: ymax !< Max. boundary second coordinate direction + real(wp) :: zmin !< Min. boundary third coordinate direction + real(wp) :: zmax !< Max. boundary third coordinate direction end type integral_parameters !> Acoustic source parameters @@ -261,22 +262,22 @@ module m_derived_types integer :: pulse !< Type of pulse integer :: support !< Type of support logical :: dipole !< Whether the source is a dipole or monopole - real(kind(0d0)), dimension(3) :: loc !< Physical location of acoustic source - real(kind(0d0)) :: mag !< Acoustic pulse magnitude - real(kind(0d0)) :: length !< Length of planar source (2D/3D) - real(kind(0d0)) :: height !< Height of planar source (3D) - real(kind(0d0)) :: wavelength !< Wave length of pulse - real(kind(0d0)) :: frequency !< Frequency of pulse - real(kind(0d0)) :: gauss_sigma_dist !< sigma of Gaussian pulse multiplied by speed of sound - real(kind(0d0)) :: gauss_sigma_time !< sigma of Gaussian pulse - real(kind(0d0)) :: npulse !< Number of cycles of pulse - real(kind(0d0)) :: dir !< Direction of pulse - real(kind(0d0)) :: delay !< Time-delay of pulse start - real(kind(0d0)) :: foc_length ! < Focal length of transducer - real(kind(0d0)) :: aperture ! < Aperture diameter of transducer - real(kind(0d0)) :: element_spacing_angle !< Spacing between aperture elements in 2D acoustic array - real(kind(0d0)) :: element_polygon_ratio !< Ratio of aperture element diameter to side length of polygon connecting their centers, in 3D acoustic array - real(kind(0d0)) :: rotate_angle !< Angle of rotation of the entire circular 3D acoustic array + real(wp), dimension(3) :: loc !< Physical location of acoustic source + real(wp) :: mag !< Acoustic pulse magnitude + real(wp) :: length !< Length of planar source (2D/3D) + real(wp) :: height !< Height of planar source (3D) + real(wp) :: wavelength !< Wave length of pulse + real(wp) :: frequency !< Frequency of pulse + real(wp) :: gauss_sigma_dist !< sigma of Gaussian pulse multiplied by speed of sound + real(wp) :: gauss_sigma_time !< sigma of Gaussian pulse + real(wp) :: npulse !< Number of cycles of pulse + real(wp) :: dir !< Direction of pulse + real(wp) :: delay !< Time-delay of pulse start + real(wp) :: foc_length ! < Focal length of transducer + real(wp) :: aperture ! < Aperture diameter of transducer + real(wp) :: element_spacing_angle !< Spacing between aperture elements in 2D acoustic array + real(wp) :: element_polygon_ratio !< Ratio of aperture element diameter to side length of polygon connecting their centers, in 3D acoustic array + real(wp) :: rotate_angle !< Angle of rotation of the entire circular 3D acoustic array integer :: num_elements !< Number of elements in the acoustic array integer :: element_on !< Element in the acoustic array to turn on end type acoustic_parameters @@ -284,18 +285,18 @@ module m_derived_types !> Acoustic source source_spatial pre-calculated values type source_spatial_type integer, dimension(:, :), allocatable :: coord !< List of grid points indices with non-zero source_spatial values - real(kind(0d0)), dimension(:), allocatable :: val !< List of non-zero source_spatial values - real(kind(0d0)), dimension(:), allocatable :: angle !< List of angles with x-axis for mom source term vector - real(kind(0d0)), dimension(:, :), allocatable :: xyz_to_r_ratios !< List of [xyz]/r for mom source term vector + real(wp), dimension(:), allocatable :: val !< List of non-zero source_spatial values + real(wp), dimension(:), allocatable :: angle !< List of angles with x-axis for mom source term vector + real(wp), dimension(:, :), allocatable :: xyz_to_r_ratios !< List of [xyz]/r for mom source term vector end type source_spatial_type !> Ghost Point for Immersed Boundaries type ghost_point - real(kind(0d0)), dimension(3) :: loc !< Physical location of the ghost point - real(kind(0d0)), dimension(3) :: ip_loc !< Physical location of the image point + real(wp), dimension(3) :: loc !< Physical location of the ghost point + real(wp), dimension(3) :: ip_loc !< Physical location of the image point integer, dimension(3) :: ip_grid !< Top left grid point of IP - real(kind(0d0)), dimension(2, 2, 2) :: interp_coeffs !< Interpolation Coefficients of image point + real(wp), dimension(2, 2, 2) :: interp_coeffs !< Interpolation Coefficients of image point integer :: ib_patch_id !< ID of the IB Patch the ghost point is part of logical :: slip integer, dimension(3) :: DB diff --git a/src/common/m_eigen_solver.f90 b/src/common/m_eigen_solver.f90 index 8356f78fc6..3d120fd467 100644 --- a/src/common/m_eigen_solver.f90 +++ b/src/common/m_eigen_solver.f90 @@ -8,6 +8,8 @@ !! modifications for compatibility. module m_eigen_solver + use m_precision_select + implicit none private; @@ -33,10 +35,10 @@ module m_eigen_solver !! @param ierr an error completion code subroutine cg(nm, nl, ar, ai, wr, wi, zr, zi, fv1, fv2, fv3, ierr) integer, intent(in) :: nm, nl - real(kind(0d0)), dimension(nm, nl), intent(inout) :: ar, ai - real(kind(0d0)), dimension(nl), intent(out) :: wr, wi - real(kind(0d0)), dimension(nm, nl), intent(out) :: zr, zi - real(kind(0d0)), dimension(nl), intent(out) :: fv1, fv2, fv3 + real(wp), dimension(nm, nl), intent(inout) :: ar, ai + real(wp), dimension(nl), intent(out) :: wr, wi + real(wp), dimension(nm, nl), intent(out) :: zr, zi + real(wp), dimension(nl), intent(out) :: fv1, fv2, fv3 integer, intent(out) :: ierr integer :: is1, is2 @@ -76,12 +78,12 @@ end subroutine cg !! factors used. subroutine cbal(nm, nl, ar, ai, low, igh, scale) integer, intent(in) :: nm, nl - real(kind(0d0)), dimension(nm, nl), intent(inout) :: ar, ai + real(wp), dimension(nm, nl), intent(inout) :: ar, ai integer, intent(out) :: low, igh - real(kind(0d0)), dimension(nl), intent(out) :: scale + real(wp), dimension(nl), intent(out) :: scale integer :: i, j, k, l, ml, jj, iexc - real(kind(0d0)) :: c, f, g, r, s, b2, radix + real(wp) :: c, f, g, r, s, b2, radix logical :: noconv radix = 16.0d0 @@ -222,11 +224,11 @@ end subroutine cbal !! @param orti further information about the transformations subroutine corth(nm, nl, low, igh, ar, ai, ortr, orti) integer, intent(in) :: nm, nl, low, igh - real(kind(0d0)), dimension(nm, nl), intent(inout) :: ar, ai - real(kind(0d0)), dimension(igh), intent(out) :: ortr, orti + real(wp), dimension(nm, nl), intent(inout) :: ar, ai + real(wp), dimension(igh), intent(out) :: ortr, orti integer :: i, j, ml, ii, jj, la, mp, kp1, mll - real(kind(0d0)) :: f, g, h, fi, fr, scale, c + real(wp) :: f, g, h, fi, fr, scale, c mll = 6 @@ -344,14 +346,14 @@ end subroutine corth !! @param ierr an error completion code subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) integer, intent(in) :: nm, nl, low, igh - real(kind(0d0)), dimension(nm, nl), intent(inout) :: hr, hi - real(kind(0d0)), dimension(nl), intent(out) :: wr, wi - real(kind(0d0)), dimension(nm, nl), intent(out) :: zr, zi - real(kind(0d0)), dimension(igh), intent(inout) :: ortr, orti + real(wp), dimension(nm, nl), intent(inout) :: hr, hi + real(wp), dimension(nl), intent(out) :: wr, wi + real(wp), dimension(nm, nl), intent(out) :: zr, zi + real(wp), dimension(igh), intent(inout) :: ortr, orti integer, intent(out) :: ierr integer :: i, j, k, l, ml, en, ii, jj, ll, nn, ip1, itn, its, lp1, enm1, iend - real(kind(0d0)) :: si, sr, ti, tr, xi, xr, xxi, xxr, yi, yr, zzi, zzr, & + real(wp) :: si, sr, ti, tr, xi, xr, xxi, xxr, yi, yr, zzi, zzr, & norm, tst1, tst2, c, d ! ierr = 0 @@ -752,13 +754,13 @@ subroutine cbabk2(nm, nl, low, igh, scale, ml, zr, zi) end subroutine cbabk2 subroutine csroot(xr, xi, yr, yi) - real(kind(0d0)), intent(in) :: xr, xi - real(kind(0d0)), intent(out) :: yr, yi + real(wp), intent(in) :: xr, xi + real(wp), intent(out) :: yr, yi ! ! (yr,yi) = complex dsqrt(xr,xi) ! branch chosen so that yr .ge. 0.0 and sign(yi) .eq. sign(xi) ! - real(kind(0d0)) :: s, tr, ti, c + real(wp) :: s, tr, ti, c tr = xr ti = xi call pythag(tr, ti, c) @@ -772,9 +774,9 @@ subroutine csroot(xr, xi, yr, yi) end subroutine csroot subroutine cdiv(ar, ai, br, bi, cr, ci) - real(kind(0d0)), intent(in) :: ar, ai, br, bi - real(kind(0d0)), intent(out) :: cr, ci - real(kind(0d0)) :: s, ars, ais, brs, bis + real(wp), intent(in) :: ar, ai, br, bi + real(wp), intent(out) :: cr, ci + real(wp) :: s, ars, ais, brs, bis ! ! complex division, (cr,ci) = (ar,ai)/(br,bi) ! @@ -796,12 +798,12 @@ subroutine cdiv(ar, ai, br, bi, cr, ci) end subroutine cdiv subroutine pythag(a, b, c) - real(kind(0d0)), intent(in) :: a, b - real(kind(0d0)), intent(out) :: c + real(wp), intent(in) :: a, b + real(wp), intent(out) :: c ! ! finds dsqrt(a**2+b**2) without overflow or destructive underflow ! - real(kind(0d0)) :: p, r, s, t, u + real(wp) :: p, r, s, t, u p = dmax1(dabs(a), dabs(b)) if (p == 0.0d0) go to 20 r = (dmin1(dabs(a), dabs(b))/p)**2 diff --git a/src/common/m_finite_differences.fpp b/src/common/m_finite_differences.fpp index 9eb65a121d..1ae6d1ee82 100644 --- a/src/common/m_finite_differences.fpp +++ b/src/common/m_finite_differences.fpp @@ -14,7 +14,7 @@ contains integer :: x, y, z !< Generic loop iterators - real(kind(0d0)) :: divergence + real(wp) :: divergence !$acc parallel loop collapse(3) private(divergence) do x = ix_s%beg, ix_s%end @@ -74,9 +74,9 @@ contains integer, intent(IN) :: q integer, intent(IN) :: buff_size, fd_number_in, fd_order_in type(int_bounds_info), optional, intent(IN) :: offset_s - real(kind(0d0)), allocatable, dimension(:, :), intent(INOUT) :: fd_coeff_s + real(wp), allocatable, dimension(:, :), intent(INOUT) :: fd_coeff_s - real(kind(0d0)), & + real(wp), & dimension(-buff_size:q + buff_size), & intent(IN) :: s_cc diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp index fc26005fd8..50432eabd8 100644 --- a/src/common/m_helper.fpp +++ b/src/common/m_helper.fpp @@ -77,7 +77,7 @@ contains subroutine s_print_2D_array(A, div) - real(kind(0d0)), dimension(:, :), intent(in) :: A + real(wp), dimension(:, :), intent(in) :: A real, optional, intent(in) :: div integer :: i, j @@ -306,8 +306,8 @@ contains !! @return The cross product of the two vectors. function f_cross(a, b) result(c) - real(kind(0d0)), dimension(3), intent(in) :: a, b - real(kind(0d0)), dimension(3) :: c + real(wp), dimension(3), intent(in) :: a, b + real(wp), dimension(3) :: c c(1) = a(2)*b(3) - a(3)*b(2) c(2) = a(3)*b(1) - a(1)*b(3) @@ -319,8 +319,8 @@ contains !! @param rhs Right-hand side. subroutine s_swap(lhs, rhs) - real(kind(0d0)), intent(inout) :: lhs, rhs - real(kind(0d0)) :: ltemp + real(wp), intent(inout) :: lhs, rhs + real(wp) :: ltemp ltemp = lhs lhs = rhs @@ -377,7 +377,7 @@ contains t_vec3, intent(inout) :: vec t_mat4x4, intent(in) :: matrix - real(kind(0d0)), dimension(1:4) :: tmp + real(wp), dimension(1:4) :: tmp tmp = matmul(matrix, [vec(1), vec(2), vec(3), 1d0]) vec = tmp(1:3) @@ -394,7 +394,7 @@ contains integer :: i - real(kind(0d0)), dimension(1:4) :: tmp + real(wp), dimension(1:4) :: tmp do i = 1, 3 call s_transform_vec(triangle%v(i, :), matrix) diff --git a/src/common/m_helper_basic.f90 b/src/common/m_helper_basic.f90 index 0611ff86f5..bddc0d130c 100644 --- a/src/common/m_helper_basic.f90 +++ b/src/common/m_helper_basic.f90 @@ -19,7 +19,7 @@ module m_helper_basic contains - !> This procedure checks if two floating point numbers of kind(0d0) are within tolerance. + !> This procedure checks if two floating point numbers of wp are within tolerance. !! @param a First number. !! @param b Second number. !! @param tol_input Relative error (default = 1d-6). @@ -28,9 +28,9 @@ logical function f_approx_equal(a, b, tol_input) result(res) !$acc routine seq ! 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 + real(wp), intent(in) :: a, b + real(wp), optional, intent(in) :: tol_input + real(wp) :: tol if (present(tol_input)) then tol = tol_input @@ -47,19 +47,19 @@ logical function f_approx_equal(a, b, tol_input) result(res) end if end function f_approx_equal - !> Checks if a real(kind(0d0)) variable is of default value. + !> Checks if a real(wp) variable is of default value. !! @param var Variable to check. logical function f_is_default(var) result(res) !$acc routine seq - real(kind(0d0)), intent(in) :: var + real(wp), 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. + !> Checks if ALL elements of a real(wp) 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(:) + real(wp), intent(in) :: var_array(:) logical :: res_array(size(var_array)) integer :: i @@ -70,13 +70,13 @@ logical function f_all_default(var_array) result(res) res = all(res_array) end function f_all_default - !> Checks if a real(kind(0d0)) variable is an integer. + !> Checks if a real(wp) variable is an integer. !! @param var Variable to check. logical function f_is_integer(var) result(res) !$acc routine seq - real(kind(0d0)), intent(in) :: var + real(wp), intent(in) :: var - res = f_approx_equal(var, real(nint(var), kind(0d0))) + res = f_approx_equal(var, real(nint(var), wp)) end function f_is_integer end module m_helper_basic diff --git a/src/common/m_mpi_common.fpp b/src/common/m_mpi_common.fpp index 78fe8df374..0f7994fafe 100644 --- a/src/common/m_mpi_common.fpp +++ b/src/common/m_mpi_common.fpp @@ -192,8 +192,8 @@ contains subroutine mpi_bcast_time_step_values(proc_time, time_avg) - real(kind(0d0)), dimension(0:num_procs - 1), intent(inout) :: proc_time - real(kind(0d0)), intent(inout) :: time_avg + real(wp), dimension(0:num_procs - 1), intent(inout) :: proc_time + real(wp), intent(inout) :: time_avg #ifdef MFC_MPI @@ -226,15 +226,15 @@ contains ccfl_max_glb, & Rc_min_glb) - real(kind(0d0)), intent(in) :: icfl_max_loc - real(kind(0d0)), intent(in) :: vcfl_max_loc - real(kind(0d0)), intent(in) :: ccfl_max_loc - real(kind(0d0)), intent(in) :: Rc_min_loc + real(wp), intent(in) :: icfl_max_loc + real(wp), intent(in) :: vcfl_max_loc + real(wp), intent(in) :: ccfl_max_loc + real(wp), intent(in) :: Rc_min_loc - real(kind(0d0)), intent(out) :: icfl_max_glb - real(kind(0d0)), intent(out) :: vcfl_max_glb - real(kind(0d0)), intent(out) :: ccfl_max_glb - real(kind(0d0)), intent(out) :: Rc_min_glb + real(wp), intent(out) :: icfl_max_glb + real(wp), intent(out) :: vcfl_max_glb + real(wp), intent(out) :: ccfl_max_glb + real(wp), intent(out) :: Rc_min_glb #ifdef MFC_MPI #ifdef MFC_SIMULATION @@ -268,8 +268,8 @@ contains !! @param var_glb The globally reduced value subroutine s_mpi_allreduce_sum(var_loc, var_glb) - real(kind(0d0)), intent(in) :: var_loc - real(kind(0d0)), intent(out) :: var_glb + real(wp), intent(in) :: var_loc + real(wp), intent(out) :: var_glb #ifdef MFC_MPI @@ -290,8 +290,8 @@ contains !! @param var_glb The globally reduced value subroutine s_mpi_allreduce_min(var_loc, var_glb) - real(kind(0d0)), intent(in) :: var_loc - real(kind(0d0)), intent(out) :: var_glb + real(wp), intent(in) :: var_loc + real(wp), intent(out) :: var_glb #ifdef MFC_MPI @@ -312,8 +312,8 @@ contains !! @param var_glb The globally reduced value subroutine s_mpi_allreduce_max(var_loc, var_glb) - real(kind(0d0)), intent(in) :: var_loc - real(kind(0d0)), intent(out) :: var_glb + real(wp), intent(in) :: var_loc + real(wp), intent(out) :: var_glb #ifdef MFC_MPI @@ -333,12 +333,12 @@ contains !! the minimum value, reduced amongst all of the local values. subroutine s_mpi_reduce_min(var_loc) - real(kind(0d0)), intent(inout) :: var_loc + real(wp), intent(inout) :: var_loc #ifdef MFC_MPI ! Temporary storage variable that holds the reduced minimum value - real(kind(0d0)) :: var_glb + real(wp) :: var_glb ! Performing reduction procedure and eventually storing its result ! into the variable that was initially inputted into the subroutine @@ -368,11 +368,11 @@ contains !! belongs. subroutine s_mpi_reduce_maxloc(var_loc) - real(kind(0d0)), dimension(2), intent(inout) :: var_loc + real(wp), dimension(2), intent(inout) :: var_loc #ifdef MFC_MPI - real(kind(0d0)), dimension(2) :: var_glb !< + real(wp), dimension(2) :: var_glb !< !! Temporary storage variable that holds the reduced maximum value !! and the rank of the processor with which the value is associated diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index f637232288..6afece1cb0 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -52,16 +52,16 @@ module m_phase_change !> @name Parameters for the first order transition phase change !> @{ integer, parameter :: max_iter = 1e8 !< max # of iterations - real(kind(0d0)), parameter :: pCr = 4.94d7 !< Critical water pressure - real(kind(0d0)), parameter :: TCr = 385.05 + 273.15 !< Critical water temperature - real(kind(0d0)), parameter :: mixM = 1.0d-8 !< threshold for 'mixture cell'. If Y < mixM, phase change does not happen + real(wp), parameter :: pCr = 4.94d7 !< Critical water pressure + real(wp), parameter :: TCr = 385.05 + 273.15 !< Critical water temperature + real(wp), parameter :: mixM = 1.0d-8 !< threshold for 'mixture cell'. If Y < mixM, phase change does not happen integer, parameter :: lp = 1 !< index for the liquid phase of the reacting fluid integer, parameter :: vp = 2 !< index for the vapor phase of the reacting fluid !> @} !> @name Gibbs free energy phase change parameters !> @{ - real(kind(0d0)) :: A, B, C, D + real(wp) :: A, B, C, D !> @} !$acc declare create(max_iter,pCr,TCr,mixM,lp,vp,A,B,C,D) @@ -105,7 +105,7 @@ contains !$acc declare create(pS, pSOV, pSSL, TS, TSOV, TSatOV, TSatSL, TSSL, rhoe, dynE, rhos, rho, rM, m1, m2, MCT, TvF) - real(kind(0d0)), dimension(num_fluids) :: p_infOV, p_infpT, p_infSL, sk, hk, gk, ek, rhok + real(wp), dimension(num_fluids) :: p_infOV, p_infpT, p_infSL, sk, hk, gk, ek, rhok !< Generic loop iterators integer :: i, j, k, l diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90 new file mode 100644 index 0000000000..f9dde6ffbd --- /dev/null +++ b/src/common/m_precision_select.f90 @@ -0,0 +1,23 @@ +!> +!! @file m_precision_select.f90 +!! @brief Contains module m_precision_select + +!> @brief This file contains the definition of floating point used in MFC +module m_precision_select +#ifdef MFC_MPI + use mpi !< Message passing interface (MPI) module +#endif + + implicit none + + integer, parameter :: single_precision = selected_real_kind(6, 37) + integer, parameter :: double_precision = selected_real_kind(15, 307) + + integer, parameter :: wp = double_precision +#ifdef MFC_MPI + integer, parameter :: mpi_p = MPI_DOUBLE_PRECISION +#else + integer, parameter :: mpi_p = -100 +#endif + +end module m_precision_select \ No newline at end of file diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 35c1ad9757..5200e20cf6 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -68,14 +68,14 @@ module m_variables_conversion ! Importing the derived type scalar_field from m_derived_types.f90 ! and global variable sys_size, from m_global_variables.f90, as ! the abstract interface does not inherently have access to them - import :: scalar_field, sys_size, num_fluids + import :: scalar_field, sys_size, num_fluids, wp type(scalar_field), dimension(sys_size), intent(in) :: q_vf integer, intent(in) :: i, j, k - real(kind(0d0)), intent(out), target :: rho, gamma, pi_inf, qv - real(kind(0d0)), optional, dimension(2), intent(out) :: Re_K - real(kind(0d0)), optional, intent(out) :: G_K - real(kind(0d0)), optional, dimension(num_fluids), intent(in) :: G + real(wp), intent(out), target :: rho, gamma, pi_inf, qv + real(wp), optional, dimension(2), intent(out) :: Re_K + real(wp), optional, intent(out) :: G_K + real(wp), optional, dimension(num_fluids), intent(in) :: G end subroutine s_convert_xxxxx_to_mixture_variables @@ -86,28 +86,28 @@ module m_variables_conversion !! In simulation, gammas, pi_infs, and qvs are already declared in m_global_variables #ifndef MFC_SIMULATION - real(kind(0d0)), allocatable, public, dimension(:) :: gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps + real(wp), allocatable, public, dimension(:) :: gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps !$acc declare create(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps) #endif #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), Gs) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), Gs) @:CRAY_DECLARE_GLOBAL(integer, dimension(:), bubrs) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :), Res) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :), Res) !$acc declare link(bubrs, Gs, Res) #else - real(kind(0d0)), allocatable, dimension(:) :: Gs + real(wp), allocatable, dimension(:) :: Gs integer, allocatable, dimension(:) :: bubrs - real(kind(0d0)), allocatable, dimension(:, :) :: Res + real(wp), allocatable, dimension(:, :) :: Res !$acc declare create(bubrs, Gs, Res) #endif integer :: is1b, is2b, is3b, is1e, is2e, is3e !$acc declare create(is1b, is2b, is3b, is1e, is2e, is3e) - real(kind(0d0)), allocatable, dimension(:, :, :), public :: rho_sf !< Scalar density function - real(kind(0d0)), allocatable, dimension(:, :, :), public :: gamma_sf !< Scalar sp. heat ratio function - real(kind(0d0)), allocatable, dimension(:, :, :), public :: pi_inf_sf !< Scalar liquid stiffness function - real(kind(0d0)), allocatable, dimension(:, :, :), public :: qv_sf !< Scalar liquid energy reference function + real(wp), allocatable, dimension(:, :, :), public :: rho_sf !< Scalar density function + real(wp), allocatable, dimension(:, :, :), public :: gamma_sf !< Scalar sp. heat ratio function + real(wp), allocatable, dimension(:, :, :), public :: pi_inf_sf !< Scalar liquid stiffness function + real(wp), allocatable, dimension(:, :, :), public :: qv_sf !< Scalar liquid energy reference function procedure(s_convert_xxxxx_to_mixture_variables), & pointer :: s_convert_to_mixture_variables => null() !< @@ -130,18 +130,18 @@ contains subroutine s_compute_pressure(energy, alf, dyn_p, pi_inf, gamma, rho, qv, rhoYks, pres, stress, mom, G) !$acc routine seq - real(kind(0d0)), intent(in) :: energy, alf - real(kind(0d0)), intent(in) :: dyn_p - real(kind(0d0)), intent(in) :: pi_inf, gamma, rho, qv - real(kind(0d0)), intent(out) :: pres - real(kind(0d0)), intent(in), optional :: stress, mom, G + real(wp), intent(in) :: energy, alf + real(wp), intent(in) :: dyn_p + real(wp), intent(in) :: pi_inf, gamma, rho, qv + real(wp), intent(out) :: pres + real(wp), intent(in), optional :: stress, mom, G ! Chemistry integer :: i - real(kind(0d0)), dimension(1:num_species), intent(in) :: rhoYks - real(kind(0d0)) :: E_e - real(kind(0d0)) :: T - real(kind(0d0)), dimension(1:num_species) :: Y_rs + real(wp), dimension(1:num_species), intent(in) :: rhoYks + real(wp) :: E_e + real(wp) :: T + real(wp), dimension(1:num_species) :: Y_rs integer :: s !< Generic loop iterator @@ -219,15 +219,15 @@ contains type(scalar_field), dimension(sys_size), intent(in) :: q_vf integer, intent(in) :: i, j, k - real(kind(0d0)), intent(out), target :: rho - real(kind(0d0)), intent(out), target :: gamma - real(kind(0d0)), intent(out), target :: pi_inf - real(kind(0d0)), intent(out), target :: qv + real(wp), intent(out), target :: rho + real(wp), intent(out), target :: gamma + real(wp), intent(out), target :: pi_inf + real(wp), intent(out), target :: qv - real(kind(0d0)), optional, dimension(2), intent(out) :: Re_K + real(wp), optional, dimension(2), intent(out) :: Re_K - real(kind(0d0)), optional, intent(out) :: G_K - real(kind(0d0)), optional, dimension(num_fluids), intent(in) :: G + real(wp), optional, intent(out) :: G_K + real(wp), optional, dimension(num_fluids), intent(in) :: G ! Transferring the density, the specific heat ratio function and the ! liquid stiffness function, respectively @@ -267,17 +267,17 @@ contains integer, intent(in) :: j, k, l - real(kind(0d0)), intent(out), target :: rho - real(kind(0d0)), intent(out), target :: gamma - real(kind(0d0)), intent(out), target :: pi_inf - real(kind(0d0)), intent(out), target :: qv + real(wp), intent(out), target :: rho + real(wp), intent(out), target :: gamma + real(wp), intent(out), target :: pi_inf + real(wp), intent(out), target :: qv - real(kind(0d0)), optional, dimension(2), intent(out) :: Re_K - real(kind(0d0)), optional, intent(out) :: G_K - real(kind(0d0)), optional, dimension(num_fluids), intent(in) :: G + real(wp), optional, dimension(2), intent(out) :: Re_K + real(wp), optional, intent(out) :: G_K + real(wp), optional, dimension(num_fluids), intent(in) :: G integer :: i, q - real(kind(0d0)), dimension(num_fluids) :: alpha_rho_K, alpha_K + real(wp), dimension(num_fluids) :: alpha_rho_K, alpha_K ! Constraining the partial densities and the volume fractions within ! their physical bounds to make sure that any mixture variables that @@ -391,17 +391,17 @@ contains integer, intent(in) :: k, l, r - real(kind(0d0)), intent(out), target :: rho - real(kind(0d0)), intent(out), target :: gamma - real(kind(0d0)), intent(out), target :: pi_inf - real(kind(0d0)), intent(out), target :: qv + real(wp), intent(out), target :: rho + real(wp), intent(out), target :: gamma + real(wp), intent(out), target :: pi_inf + real(wp), intent(out), target :: qv - real(kind(0d0)), optional, dimension(2), intent(out) :: Re_K + real(wp), optional, dimension(2), intent(out) :: Re_K !! Partial densities and volume fractions - real(kind(0d0)), optional, intent(out) :: G_K - real(kind(0d0)), optional, dimension(num_fluids), intent(in) :: G + real(wp), optional, intent(out) :: G_K + real(wp), optional, dimension(num_fluids), intent(in) :: G - real(kind(0d0)), dimension(num_fluids) :: alpha_rho_K, alpha_K !< + real(wp), dimension(num_fluids) :: alpha_rho_K, alpha_K !< integer :: i, j !< Generic loop iterator @@ -480,19 +480,19 @@ contains !$acc routine seq #endif - real(kind(0d0)), intent(out) :: rho_K, gamma_K, pi_inf_K, qv_K + real(wp), intent(out) :: rho_K, gamma_K, pi_inf_K, qv_K - real(kind(0d0)), dimension(num_fluids), intent(inout) :: alpha_rho_K, alpha_K !< - real(kind(0d0)), dimension(2), intent(out) :: Re_K + real(wp), dimension(num_fluids), intent(inout) :: alpha_rho_K, alpha_K !< + real(wp), dimension(2), intent(out) :: Re_K !! Partial densities and volume fractions - real(kind(0d0)), optional, intent(out) :: G_K - real(kind(0d0)), optional, dimension(num_fluids), intent(in) :: G + real(wp), optional, intent(out) :: G_K + real(wp), optional, dimension(num_fluids), intent(in) :: G integer, intent(in) :: k, l, r integer :: i, j !< Generic loop iterators - real(kind(0d0)) :: alpha_K_sum + real(wp) :: alpha_K_sum #ifdef MFC_SIMULATION ! Constraining the partial densities and the volume fractions within @@ -562,12 +562,12 @@ contains !$acc routine seq #endif - real(kind(0d0)), intent(inout) :: rho_K, gamma_K, pi_inf_K, qv_K + real(wp), intent(inout) :: rho_K, gamma_K, pi_inf_K, qv_K - real(kind(0d0)), dimension(num_fluids), intent(in) :: alpha_K, alpha_rho_K !< + real(wp), dimension(num_fluids), intent(in) :: alpha_K, alpha_rho_K !< !! Partial densities and volume fractions - real(kind(0d0)), dimension(2), intent(out) :: Re_K + real(wp), dimension(2), intent(out) :: Re_K integer, intent(in) :: k, l, r integer :: i, j !< Generic loop iterators @@ -785,10 +785,10 @@ contains !Initialize mv at the quadrature nodes based on the initialized moments and sigma subroutine s_initialize_mv(qK_cons_vf, mv) type(scalar_field), dimension(sys_size), intent(in) :: qK_cons_vf - real(kind(0d0)), dimension(ixb:, iyb:, izb:, 1:, 1:), intent(inout) :: mv + real(wp), dimension(ixb:, iyb:, izb:, 1:, 1:), intent(inout) :: mv integer :: i, j, k, l - real(kind(0d0)) :: mu, sig, nbub_sc + real(wp) :: mu, sig, nbub_sc do l = izb, ize do k = iyb, iye @@ -816,11 +816,11 @@ contains !Initialize pb at the quadrature nodes using isothermal relations (Preston model) subroutine s_initialize_pb(qK_cons_vf, mv, pb) type(scalar_field), dimension(sys_size), intent(in) :: qK_cons_vf - real(kind(0d0)), dimension(ixb:, iyb:, izb:, 1:, 1:), intent(in) :: mv - real(kind(0d0)), dimension(ixb:, iyb:, izb:, 1:, 1:), intent(inout) :: pb + real(wp), dimension(ixb:, iyb:, izb:, 1:, 1:), intent(in) :: mv + real(wp), dimension(ixb:, iyb:, izb:, 1:, 1:), intent(inout) :: pb integer :: i, j, k, l - real(kind(0d0)) :: mu, sig, nbub_sc + real(wp) :: mu, sig, nbub_sc do l = izb, ize do k = iyb, iye @@ -866,27 +866,27 @@ contains type(int_bounds_info), optional, intent(in) :: ix, iy, iz - real(kind(0d0)), dimension(num_fluids) :: alpha_K, alpha_rho_K - real(kind(0d0)), dimension(2) :: Re_K - real(kind(0d0)) :: rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K + real(wp), dimension(num_fluids) :: alpha_K, alpha_rho_K + real(wp), dimension(2) :: Re_K + real(wp) :: rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K #:if MFC_CASE_OPTIMIZATION #ifndef MFC_SIMULATION - real(kind(0d0)), dimension(:), allocatable :: nRtmp + real(wp), dimension(:), allocatable :: nRtmp #else - real(kind(0d0)), dimension(nb) :: nRtmp + real(wp), dimension(nb) :: nRtmp #endif #:else - real(kind(0d0)), dimension(:), allocatable :: nRtmp + real(wp), dimension(:), allocatable :: nRtmp #:endif - real(kind(0d0)) :: rhoYks(1:num_species) + real(wp) :: rhoYks(1:num_species) - real(kind(0d0)) :: vftmp, nR3, nbub_sc, R3tmp + real(wp) :: vftmp, nR3, nbub_sc, R3tmp - real(kind(0d0)) :: G_K + real(wp) :: G_K - real(kind(0d0)) :: pres, Yksum + real(wp) :: pres, Yksum integer :: i, j, k, l, q !< Generic loop iterators @@ -1103,21 +1103,21 @@ contains ! Density, specific heat ratio function, liquid stiffness function ! and dynamic pressure, as defined in the incompressible flow sense, ! respectively - real(kind(0d0)) :: rho - real(kind(0d0)) :: gamma - real(kind(0d0)) :: pi_inf - real(kind(0d0)) :: qv - real(kind(0d0)) :: dyn_pres - real(kind(0d0)) :: nbub, R3, vftmp, R3tmp - real(kind(0d0)), dimension(nb) :: Rtmp - real(kind(0d0)) :: G = 0d0 - real(kind(0d0)), dimension(2) :: Re_K + real(wp) :: rho + real(wp) :: gamma + real(wp) :: pi_inf + real(wp) :: qv + real(wp) :: dyn_pres + real(wp) :: nbub, R3, vftmp, R3tmp + real(wp), dimension(nb) :: Rtmp + real(wp) :: G = 0d0 + real(wp), dimension(2) :: Re_K integer :: i, j, k, l, q !< Generic loop iterators integer :: spec - real(kind(0d0)), dimension(num_species) :: Ys - real(kind(0d0)) :: temperature, e_mix, mix_mol_weight, T + real(wp), dimension(num_species) :: Ys + real(wp) :: temperature, e_mix, mix_mol_weight, T #ifndef MFC_SIMULATION ! Converting the primitive variables to the conservative variables @@ -1276,27 +1276,27 @@ contains is1, is2, is3, s2b, s3b) integer, intent(in) :: s2b, s3b - real(kind(0d0)), dimension(0:, s2b:, s3b:, 1:), intent(in) :: qK_prim_vf - real(kind(0d0)), dimension(0:, s2b:, s3b:, 1:), intent(inout) :: FK_vf - real(kind(0d0)), dimension(0:, s2b:, s3b:, advxb:), intent(inout) :: FK_src_vf + real(wp), dimension(0:, s2b:, s3b:, 1:), intent(in) :: qK_prim_vf + real(wp), dimension(0:, s2b:, s3b:, 1:), intent(inout) :: FK_vf + real(wp), dimension(0:, s2b:, s3b:, advxb:), intent(inout) :: FK_src_vf type(int_bounds_info), intent(in) :: is1, is2, is3 ! Partial densities, density, velocity, pressure, energy, advection ! variables, the specific heat ratio and liquid stiffness functions, ! the shear and volume Reynolds numbers and the Weber numbers - real(kind(0d0)), dimension(num_fluids) :: alpha_rho_K - real(kind(0d0)), dimension(num_fluids) :: alpha_K - real(kind(0d0)) :: rho_K - real(kind(0d0)), dimension(num_dims) :: vel_K - real(kind(0d0)) :: vel_K_sum - real(kind(0d0)) :: pres_K - real(kind(0d0)) :: E_K - real(kind(0d0)) :: gamma_K - real(kind(0d0)) :: pi_inf_K - real(kind(0d0)) :: qv_K - real(kind(0d0)), dimension(2) :: Re_K - real(kind(0d0)) :: G_K + real(wp), dimension(num_fluids) :: alpha_rho_K + real(wp), dimension(num_fluids) :: alpha_K + real(wp) :: rho_K + real(wp), dimension(num_dims) :: vel_K + real(wp) :: vel_K_sum + real(wp) :: pres_K + real(wp) :: E_K + real(wp) :: gamma_K + real(wp) :: pi_inf_K + real(wp) :: qv_K + real(wp), dimension(2) :: Re_K + real(wp) :: G_K integer :: i, j, k, l !< Generic loop iterators @@ -1429,14 +1429,14 @@ contains #else !$acc routine seq #endif - real(kind(0d0)), intent(in) :: pres - real(kind(0d0)), intent(in) :: rho, gamma, pi_inf - real(kind(0d0)), intent(in) :: H - real(kind(0d0)), dimension(num_fluids), intent(in) :: adv - real(kind(0d0)), intent(in) :: vel_sum - real(kind(0d0)), intent(out) :: c - - real(kind(0d0)) :: blkmod1, blkmod2 + real(wp), intent(in) :: pres + real(wp), intent(in) :: rho, gamma, pi_inf + real(wp), intent(in) :: H + real(wp), dimension(num_fluids), intent(in) :: adv + real(wp), intent(in) :: vel_sum + real(wp), intent(out) :: c + + real(wp) :: blkmod1, blkmod2 integer :: q diff --git a/src/post_process/m_data_input.f90 b/src/post_process/m_data_input.f90 index 567816f73b..247cd665b4 100644 --- a/src/post_process/m_data_input.f90 +++ b/src/post_process/m_data_input.f90 @@ -74,7 +74,7 @@ subroutine s_read_serial_data_files(t_step) !! Generic string used to store the location of a particular file character(LEN= & - int(floor(log10(real(sys_size, kind(0d0))))) + 1) :: file_num !< + int(floor(log10(real(sys_size, wp)))) + 1) :: file_num !< !! Used to store the variable position, in character form, of the !! currently manipulated conservative variable file @@ -254,11 +254,11 @@ subroutine s_read_parallel_data_files(t_step) #ifdef MFC_MPI - real(kind(0d0)), allocatable, dimension(:) :: x_cb_glb, y_cb_glb, z_cb_glb + real(wp), allocatable, dimension(:) :: x_cb_glb, y_cb_glb, z_cb_glb integer :: ifile, ierr, data_size integer, dimension(MPI_STATUS_SIZE) :: status - real(kind(0d0)) :: start, finish + real(wp) :: start, finish integer(KIND=MPI_OFFSET_KIND) :: disp integer(KIND=MPI_OFFSET_KIND) :: m_MOK, n_MOK, p_MOK integer(KIND=MPI_OFFSET_KIND) :: WP_MOK, var_MOK, str_MOK diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 7aa7e87391..0f131591e8 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -41,9 +41,9 @@ module m_data_output ! database file(s). Note that for 1D simulations, q_root_sf is employed to ! gather the flow variable(s) from all sub-domains on to the root process. ! If the run is not parallel, but serial, then q_root_sf is equal to q_sf. - real(kind(0d0)), allocatable, dimension(:, :, :), public :: q_sf - real(kind(0d0)), allocatable, dimension(:, :, :) :: q_root_sf - real(kind(0d0)), allocatable, dimension(:, :, :) :: cyl_q_sf + real(wp), allocatable, dimension(:, :, :), public :: q_sf + real(wp), allocatable, dimension(:, :, :) :: q_root_sf + real(wp), allocatable, dimension(:, :, :) :: cyl_q_sf ! Single precision storage for flow variables real(kind(0.0)), allocatable, dimension(:, :, :), public :: q_sf_s real(kind(0.0)), allocatable, dimension(:, :, :) :: q_root_sf_s @@ -53,8 +53,8 @@ module m_data_output ! minimum and maximum values of the grid and flow variable(s), respectively. ! The purpose of bookkeeping this information is to boost the visualization ! of the Silo-HDF5 database file(s) in VisIt. - real(kind(0d0)), allocatable, dimension(:, :) :: spatial_extents - real(kind(0d0)), allocatable, dimension(:, :) :: data_extents + real(wp), allocatable, dimension(:, :) :: spatial_extents + real(wp), allocatable, dimension(:, :) :: data_extents ! The size of the ghost zone layer at beginning of each coordinate direction ! (lo) and at end of each coordinate direction (hi). Adding this information @@ -763,7 +763,7 @@ contains ! Generic loop iterator integer :: i, j, k - real(kind(0d0)) :: start, finish + real(wp) :: start, finish ! Silo-HDF5 Database Format ======================================== diff --git a/src/post_process/m_derived_variables.fpp b/src/post_process/m_derived_variables.fpp index e08973bd21..f8b371fe4b 100644 --- a/src/post_process/m_derived_variables.fpp +++ b/src/post_process/m_derived_variables.fpp @@ -33,7 +33,7 @@ module m_derived_variables s_compute_speed_of_sound, & s_finalize_derived_variables_module - real(kind(0d0)), allocatable, dimension(:, :, :) :: gm_rho_sf !< + real(wp), allocatable, dimension(:, :, :) :: gm_rho_sf !< !! Gradient magnitude (gm) of the density for each cell of the computational !! sub-domain. This variable is employed in the calculation of the numerical !! Schlieren function. @@ -43,9 +43,9 @@ module m_derived_variables !! active coordinate directions, the centered family of the finite-difference !! schemes is used. !> @{ - real(kind(0d0)), allocatable, dimension(:, :), public :: fd_coeff_x - real(kind(0d0)), allocatable, dimension(:, :), public :: fd_coeff_y - real(kind(0d0)), allocatable, dimension(:, :), public :: fd_coeff_z + real(wp), allocatable, dimension(:, :), public :: fd_coeff_x + real(wp), allocatable, dimension(:, :), public :: fd_coeff_y + real(wp), allocatable, dimension(:, :), public :: fd_coeff_z !> @} integer, private :: flg !< @@ -119,7 +119,7 @@ contains !! @param q_sf Specific heat ratio subroutine s_derive_specific_heat_ratio(q_sf) - real(kind(0d0)), & + real(wp), & dimension(-offset_x%beg:m + offset_x%end, & -offset_y%beg:n + offset_y%end, & -offset_z%beg:p + offset_z%end), & @@ -146,7 +146,7 @@ contains !! @param q_sf Liquid stiffness subroutine s_derive_liquid_stiffness(q_sf) - real(kind(0d0)), & + real(wp), & dimension(-offset_x%beg:m + offset_x%end, & -offset_y%beg:n + offset_y%end, & -offset_z%beg:p + offset_z%end), & @@ -179,7 +179,7 @@ contains dimension(sys_size), & intent(in) :: q_prim_vf - real(kind(0d0)), & + real(wp), & dimension(-offset_x%beg:m + offset_x%end, & -offset_y%beg:n + offset_y%end, & -offset_z%beg:p + offset_z%end), & @@ -188,7 +188,7 @@ contains integer :: i, j, k !< Generic loop iterators ! Fluid bulk modulus for alternate sound speed - real(kind(0d0)) :: blkmod1, blkmod2 + real(wp) :: blkmod1, blkmod2 ! Computing speed of sound values from those of pressure, density, ! specific heat ratio function and the liquid stiffness function @@ -236,12 +236,12 @@ contains type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf - real(kind(0d0)), dimension(-offset_x%beg:m + offset_x%end, & + real(wp), dimension(-offset_x%beg:m + offset_x%end, & -offset_y%beg:n + offset_y%end, & -offset_z%beg:p + offset_z%end), & intent(inout) :: q_sf - real(kind(0d0)) :: top, bottom, slope !< Flux limiter calcs + real(wp) :: top, bottom, slope !< Flux limiter calcs integer :: j, k, l !< Generic loop iterators do l = -offset_z%beg, p + offset_z%end @@ -327,9 +327,9 @@ contains subroutine s_solve_linear_system(A, b, sol, ndim) integer, intent(in) :: ndim - real(kind(0d0)), dimension(ndim, ndim), intent(inout) :: A - real(kind(0d0)), dimension(ndim), intent(inout) :: b - real(kind(0d0)), dimension(ndim), intent(out) :: sol + real(wp), dimension(ndim, ndim), intent(inout) :: A + real(wp), dimension(ndim), intent(inout) :: b + real(wp), dimension(ndim), intent(out) :: sol integer, dimension(ndim) :: ipiv @@ -385,7 +385,7 @@ contains dimension(sys_size), & intent(in) :: q_prim_vf - real(kind(0d0)), & + real(wp), & dimension(-offset_x%beg:m + offset_x%end, & -offset_y%beg:n + offset_y%end, & -offset_z%beg:p + offset_z%end), & @@ -484,16 +484,16 @@ contains dimension(sys_size), & intent(in) :: q_prim_vf - real(kind(0d0)), & + real(wp), & dimension(-offset_x%beg:m + offset_x%end, & -offset_y%beg:n + offset_y%end, & -offset_z%beg:p + offset_z%end), & intent(inout) :: q_sf - real(kind(0d0)), & + real(wp), & dimension(1:3, 1:3) :: q_jacobian_sf, S, S2, O, O2 - real(kind(0d0)) :: trS, trS2, trO2, Q, IIS + real(wp) :: trS, trS2, trO2, Q, IIS integer :: j, k, l, r, jj, kk !< Generic loop iterators do l = -offset_z%beg, p + offset_z%end @@ -572,22 +572,22 @@ contains dimension(sys_size), & intent(in) :: q_cons_vf - real(kind(0d0)), & + real(wp), & dimension(-offset_x%beg:m + offset_x%end, & -offset_y%beg:n + offset_y%end, & -offset_z%beg:p + offset_z%end), & intent(inout) :: q_sf - real(kind(0d0)) :: drho_dx, drho_dy, drho_dz !< + real(wp) :: drho_dx, drho_dy, drho_dz !< !! Spatial derivatives of the density in the x-, y- and z-directions - real(kind(0d0)), dimension(2) :: gm_rho_max !< + real(wp), dimension(2) :: gm_rho_max !< !! Maximum value of the gradient magnitude (gm) of the density field !! in entire computational domain and not just the local sub-domain. !! The first position in the variable contains the maximum value and !! the second contains the rank of the processor on which it occurred. - real(kind(0d0)) :: alpha_unadv !< Unadvected volume fraction + real(wp) :: alpha_unadv !< Unadvected volume fraction integer :: i, j, k, l !< Generic loop iterators @@ -648,7 +648,7 @@ contains ! Determining the local maximum of the gradient magnitude of density ! and bookkeeping the result, along with rank of the local processor - gm_rho_max = (/maxval(gm_rho_sf), real(proc_rank, kind(0d0))/) + gm_rho_max = (/maxval(gm_rho_sf), real(proc_rank, wp)/) ! Comparing the local maximum gradient magnitude of the density on ! this processor to the those computed on the remaining processors. diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 312759ab2d..b98053eca2 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -58,18 +58,18 @@ module m_global_parameters !> @name Cell-boundary locations in the x-, y- and z-coordinate directions !> @{ - real(kind(0d0)), allocatable, dimension(:) :: x_cb, x_root_cb, y_cb, z_cb + real(wp), allocatable, dimension(:) :: x_cb, x_root_cb, y_cb, z_cb real(kind(0.0)), allocatable, dimension(:) :: x_cb_s, y_cb_s, z_cb_s !> @} !> @name Cell-center locations in the x-, y- and z-coordinate directions !> @{ - real(kind(0d0)), allocatable, dimension(:) :: x_cc, x_root_cc, y_cc, z_cc + real(wp), allocatable, dimension(:) :: x_cc, x_root_cc, y_cc, z_cc !> @} !> Cell-width distributions in the x-, y- and z-coordinate directions !> @{ - real(kind(0d0)), allocatable, dimension(:) :: dx, dy, dz + real(wp), allocatable, dimension(:) :: dx, dy, dz !> @} integer :: buff_size !< @@ -84,9 +84,9 @@ module m_global_parameters !> @name IO options for adaptive time-stepping !> @{ logical :: cfl_adap_dt, cfl_const_dt, cfl_dt - real(kind(0d0)) :: t_save - real(kind(0d0)) :: t_stop - real(kind(0d0)) :: cfl_target + real(wp) :: t_save + real(wp) :: t_stop + real(wp) :: cfl_target integer :: n_save integer :: n_start !> @} @@ -167,7 +167,7 @@ module m_global_parameters ! ========================================================================== - real(kind(0d0)), allocatable, dimension(:) :: adv !< Advection variables + real(wp), allocatable, dimension(:) :: adv !< Advection variables ! Formatted Database File(s) Structure Parameters ========================== @@ -216,7 +216,7 @@ module m_global_parameters logical :: chem_wrt_T !> @} - real(kind(0d0)), dimension(num_fluids_max) :: schlieren_alpha !< + real(wp), dimension(num_fluids_max) :: schlieren_alpha !< !! Amplitude coefficients of the numerical Schlieren function that are used !! to adjust the intensity of numerical Schlieren renderings for individual !! fluids. This enables waves and interfaces of varying strengths and in all @@ -236,35 +236,35 @@ module m_global_parameters !> @name Reference parameters for Tait EOS !> @{ - real(kind(0d0)) :: rhoref, pref + real(wp) :: rhoref, pref !> @} !> @name Bubble modeling variables and parameters !> @{ integer :: nb - real(kind(0d0)) :: R0ref - real(kind(0d0)) :: Ca, Web, Re_inv - real(kind(0d0)), dimension(:), allocatable :: weight, R0, V0 + real(wp) :: R0ref + real(wp) :: Ca, Web, Re_inv + real(wp), dimension(:), allocatable :: weight, R0, V0 logical :: bubbles logical :: qbmm logical :: polytropic logical :: polydisperse logical :: adv_n integer :: thermal !< 1 = adiabatic, 2 = isotherm, 3 = transfer - real(kind(0d0)) :: R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, G, pv, M_n, M_v - real(kind(0d0)), dimension(:), allocatable :: k_n, k_v, pb0, mass_n0, mass_v0, Pe_T - real(kind(0d0)), dimension(:), allocatable :: Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN - real(kind(0d0)) :: mul0, ss, gamma_v, mu_v - real(kind(0d0)) :: gamma_m, gamma_n, mu_n - real(kind(0d0)) :: poly_sigma - real(kind(0d0)) :: sigR + real(wp) :: R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, G, pv, M_n, M_v + real(wp), dimension(:), allocatable :: k_n, k_v, pb0, mass_n0, mass_v0, Pe_T + real(wp), dimension(:), allocatable :: Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN + real(wp) :: mul0, ss, gamma_v, mu_v + real(wp) :: gamma_m, gamma_n, mu_n + real(wp) :: poly_sigma + real(wp) :: sigR integer :: nmom !> @} !> @name surface tension coefficient !> @{ - real(kind(0d0)) :: sigma + real(wp) :: sigma !> #} !> @name Index variables used for m_variables_conversion diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp index 825f61b490..d859245e10 100644 --- a/src/post_process/m_mpi_proxy.fpp +++ b/src/post_process/m_mpi_proxy.fpp @@ -29,8 +29,8 @@ module m_mpi_proxy !! processors. Note that these variables are structured as vectors rather !! than arrays. !> @{ - real(kind(0d0)), allocatable, dimension(:) :: q_cons_buffer_in - real(kind(0d0)), allocatable, dimension(:) :: q_cons_buffer_out + real(wp), allocatable, dimension(:) :: q_cons_buffer_in + real(wp), allocatable, dimension(:) :: q_cons_buffer_out !> @} !> @name Receive counts and displacement vector variables, respectively, used in @@ -212,10 +212,10 @@ contains ! Temporary # of processors in x-, y- and z-coordinate directions ! used during the processor factorization optimization procedure - real(kind(0d0)) :: tmp_num_procs_x, tmp_num_procs_y, tmp_num_procs_z + real(wp) :: tmp_num_procs_x, tmp_num_procs_y, tmp_num_procs_z ! Processor factorization (fct) minimization parameter - real(kind(0d0)) :: fct_min + real(wp) :: fct_min ! Cartesian processor topology communicator integer :: MPI_COMM_CART @@ -1414,7 +1414,7 @@ contains !! the second dimension corresponds to the processor rank. subroutine s_mpi_gather_spatial_extents(spatial_extents) - real(kind(0d0)), dimension(1:, 0:), intent(inout) :: spatial_extents + real(wp), dimension(1:, 0:), intent(inout) :: spatial_extents #ifdef MFC_MPI @@ -1569,9 +1569,9 @@ contains !! to each processor's rank. subroutine s_mpi_gather_data_extents(q_sf, data_extents) - real(kind(0d0)), dimension(:, :, :), intent(in) :: q_sf + real(wp), dimension(:, :, :), intent(in) :: q_sf - real(kind(0d0)), & + real(wp), & dimension(1:2, 0:num_procs - 1), & intent(inout) :: data_extents @@ -1599,11 +1599,11 @@ contains !! @param q_root_sf Flow variable defined on the entire computational domain subroutine s_mpi_defragment_1d_flow_variable(q_sf, q_root_sf) - real(kind(0d0)), & + real(wp), & dimension(0:m, 0:0, 0:0), & intent(in) :: q_sf - real(kind(0d0)), & + real(wp), & dimension(0:m_root, 0:0, 0:0), & intent(inout) :: q_root_sf diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 78b42a7bff..352cbef1dd 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -188,7 +188,7 @@ subroutine s_save_data(t_step, varname, pres, c, H) integer, intent(inout) :: t_step character(LEN=name_len), intent(inout) :: varname - real(kind(0d0)), intent(inout) :: pres, c, H + real(wp), intent(inout) :: pres, c, H integer :: i, j, k, l diff --git a/src/post_process/p_main.fpp b/src/post_process/p_main.fpp index e48bb80114..15ebe93c7c 100644 --- a/src/post_process/p_main.fpp +++ b/src/post_process/p_main.fpp @@ -26,9 +26,9 @@ program p_main !! Generic storage for the name(s) of the flow variable(s) that will be added !! to the formatted database file(s) - real(kind(0d0)) :: pres - real(kind(0d0)) :: c - real(kind(0d0)) :: H + real(wp) :: pres + real(wp) :: c + real(wp) :: H call s_initialize_mpi_domain() diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp index 7d6ee9602b..edf1e307e2 100644 --- a/src/pre_process/include/2dHardcodedIC.fpp +++ b/src/pre_process/include/2dHardcodedIC.fpp @@ -1,9 +1,9 @@ #:def Hardcoded2DVariables() - real(kind(0d0)) :: eps - real(kind(0d0)) :: r, rmax, gam, umax, p0 + real(wp) :: eps + real(wp) :: r, rmax, gam, umax, p0 - real(kind(0d0)) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph + real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph eps = 1e-9 diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp index 3d9a4e2f1d..4448297ec5 100644 --- a/src/pre_process/include/3dHardcodedIC.fpp +++ b/src/pre_process/include/3dHardcodedIC.fpp @@ -1,9 +1,9 @@ #:def Hardcoded3DVariables() ! Place any declaration of intermediate variables here - real(kind(0d0)) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph + real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph - real(kind(0d0)) :: eps + real(wp) :: eps eps = 1e-9 #:enddef diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp index 5aa19e6a3b..31dbca0e99 100644 --- a/src/pre_process/m_assign_variables.fpp +++ b/src/pre_process/m_assign_variables.fpp @@ -49,11 +49,11 @@ module m_assign_variables subroutine s_assign_patch_xxxxx_primitive_variables(patch_id, j, k, l, & eta, q_prim_vf, patch_id_fp) - import :: scalar_field, sys_size, n, m, p + import :: scalar_field, sys_size, n, m, p, wp integer, intent(in) :: patch_id integer, intent(in) :: j, k, l - real(kind(0d0)), intent(in) :: eta + real(wp), intent(in) :: eta type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -111,18 +111,18 @@ contains integer, intent(in) :: patch_id integer, intent(in) :: j, k, l - real(kind(0d0)), intent(in) :: eta + real(wp), intent(in) :: eta type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - real(kind(0d0)) :: rho !< density - real(kind(0d0)), dimension(int(E_idx - mom_idx%beg)) :: vel !< velocity - real(kind(0d0)) :: pres !< pressure - real(kind(0d0)) :: gamma !< specific heat ratio function - real(kind(0d0)) :: x_centroid, y_centroid - real(kind(0d0)) :: epsilon, beta - real(kind(0d0)) :: Ys(1:num_species) - real(kind(0d0)) :: mean_molecular_weight + real(wp) :: rho !< density + real(wp), dimension(int(E_idx - mom_idx%beg)) :: vel !< velocity + real(wp) :: pres !< pressure + real(wp) :: gamma !< specific heat ratio function + real(wp) :: x_centroid, y_centroid + real(wp) :: epsilon, beta + real(wp) :: Ys(1:num_species) + real(wp) :: mean_molecular_weight integer :: smooth_patch_id integer :: i !< generic loop operator @@ -168,7 +168,7 @@ contains ! Species Concentrations #:if chemistry block - real(kind(0d0)) :: sum, term + real(wp) :: sum, term ! Accumulating the species concentrations sum = 0d0 @@ -212,8 +212,8 @@ contains type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer :: i - real(kind(0d0)) :: pres_mag, loc, n_tait, B_tait, p0 - real(kind(0d0)) :: R3bar, n0, ratio, nH, vfH, velH, rhoH, deno + real(wp) :: pres_mag, loc, n_tait, B_tait, p0 + real(wp) :: R3bar, n0, ratio, nH, vfH, velH, rhoH, deno p0 = 101325 pres_mag = 1d-1 @@ -296,34 +296,34 @@ contains integer, intent(in) :: patch_id integer, intent(in) :: j, k, l - real(kind(0d0)), intent(in) :: eta + real(wp), intent(in) :: eta integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf ! Density, the specific heat ratio function and the liquid stiffness ! function, respectively, obtained from the combination of primitive ! variables of the current and smoothing patches - real(kind(0d0)) :: rho !< density - real(kind(0d0)) :: gamma - real(kind(0d0)) :: lit_gamma !< specific heat ratio - real(kind(0d0)) :: pi_inf !< stiffness from SEOS - real(kind(0d0)) :: qv !< reference energy from SEOS - real(kind(0d0)) :: orig_rho - real(kind(0d0)) :: orig_gamma - real(kind(0d0)) :: orig_pi_inf - real(kind(0d0)) :: orig_qv - real(kind(0d0)) :: muR, muV - real(kind(0d0)) :: R3bar - - real(kind(0d0)), dimension(int(E_idx - mom_idx%beg)) :: vel !< velocity - real(kind(0d0)) :: pres !< pressure - real(kind(0d0)) :: x_centroid, y_centroid - real(kind(0d0)) :: epsilon, beta - - real(kind(0d0)) :: Ys(1:num_species) - real(kind(0d0)) :: mean_molecular_weight - - real(kind(0d0)), dimension(sys_size) :: orig_prim_vf !< + real(wp) :: rho !< density + real(wp) :: gamma + real(wp) :: lit_gamma !< specific heat ratio + real(wp) :: pi_inf !< stiffness from SEOS + real(wp) :: qv !< reference energy from SEOS + real(wp) :: orig_rho + real(wp) :: orig_gamma + real(wp) :: orig_pi_inf + real(wp) :: orig_qv + real(wp) :: muR, muV + real(wp) :: R3bar + + real(wp), dimension(int(E_idx - mom_idx%beg)) :: vel !< velocity + real(wp) :: pres !< pressure + real(wp) :: x_centroid, y_centroid + real(wp) :: epsilon, beta + + real(wp) :: Ys(1:num_species) + real(wp) :: mean_molecular_weight + + real(wp), dimension(sys_size) :: orig_prim_vf !< !! Vector to hold original values of cell for smoothing purposes integer :: i !< Generic loop iterator @@ -545,7 +545,7 @@ contains ! Species Concentrations #:if chemistry block - real(kind(0d0)) :: sum, term + real(wp) :: sum, term ! Accumulating the species concentrations sum = 0d0 diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp index e17773787f..fd0972ccc2 100644 --- a/src/pre_process/m_data_output.fpp +++ b/src/pre_process/m_data_output.fpp @@ -90,7 +90,7 @@ contains character(LEN=3) :: status character(LEN= & - int(floor(log10(real(sys_size, kind(0d0))))) + 1) :: file_num !< Used to store + int(floor(log10(real(sys_size, wp)))) + 1) :: file_num !< Used to store !! the number, in character form, of the currently !! manipulated conservative variable data file @@ -100,16 +100,16 @@ contains integer :: i, j, k, l, r, c !< Generic loop iterator integer :: t_step - real(kind(0d0)), dimension(nb) :: nRtmp !< Temporary bubble concentration - real(kind(0d0)) :: nbub !< Temporary bubble number density - real(kind(0d0)) :: gamma, lit_gamma, pi_inf, qv !< Temporary EOS params - real(kind(0d0)) :: rho !< Temporary density - real(kind(0d0)) :: pres !< Temporary pressure + real(wp), dimension(nb) :: nRtmp !< Temporary bubble concentration + real(wp) :: nbub !< Temporary bubble number density + real(wp) :: gamma, lit_gamma, pi_inf, qv !< Temporary EOS params + real(wp) :: rho !< Temporary density + real(wp) :: pres !< Temporary pressure - real(kind(0d0)) :: nR3 - real(kind(0d0)) :: ntmp + real(wp) :: nR3 + real(wp) :: ntmp - real(kind(0d0)) :: rhoYks(1:num_species) !< Temporary species mass fractions + real(wp) :: rhoYks(1:num_species) !< Temporary species mass fractions t_step = 0 diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index 6f15347bd2..e73c0c6d90 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -53,13 +53,13 @@ module m_global_parameters logical :: cyl_coord integer :: grid_geometry !< Cylindrical coordinates (either axisymmetric or full 3D) - real(kind(0d0)), allocatable, dimension(:) :: x_cc, y_cc, z_cc !< + real(wp), allocatable, dimension(:) :: x_cc, y_cc, z_cc !< !! Locations of cell-centers (cc) in x-, y- and z-directions, respectively - real(kind(0d0)), allocatable, dimension(:) :: x_cb, y_cb, z_cb !< + real(wp), allocatable, dimension(:) :: x_cb, y_cb, z_cb !< !! Locations of cell-boundaries (cb) in x-, y- and z-directions, respectively - real(kind(0d0)) :: dx, dy, dz !< + real(wp) :: dx, dy, dz !< !! Minimum cell-widths in the x-, y- and z-coordinate directions type(bounds_info) :: x_domain, y_domain, z_domain !< @@ -72,10 +72,10 @@ module m_global_parameters ! directions. The "a" parameters are a measure of the rate at which the grid ! is stretched while the remaining parameters are indicative of the location ! on the grid at which the stretching begins. - real(kind(0d0)) :: a_x, a_y, a_z + real(wp) :: a_x, a_y, a_z integer :: loops_x, loops_y, loops_z - real(kind(0d0)) :: x_a, y_a, z_a - real(kind(0d0)) :: x_b, y_b, z_b + real(wp) :: x_a, y_a, z_a + real(wp) :: x_b, y_b, z_b ! ========================================================================== @@ -83,8 +83,8 @@ module m_global_parameters integer :: model_eqns !< Multicomponent flow model logical :: relax !< activate phase change integer :: relax_model !< Relax Model - real(kind(0d0)) :: palpha_eps !< trigger parameter for the p relaxation procedure, phase change model - real(kind(0d0)) :: ptgalpha_eps !< trigger parameter for the pTg relaxation procedure, phase change model + real(wp) :: palpha_eps !< trigger parameter for the p relaxation procedure, phase change model + real(wp) :: ptgalpha_eps !< trigger parameter for the pTg relaxation procedure, phase change model integer :: num_fluids !< Number of different fluids present in the flow logical :: mpp_lim !< Alpha limiter integer :: sys_size !< Number of unknowns in the system of equations @@ -116,19 +116,19 @@ module m_global_parameters integer :: precision !< Precision of output files logical :: mixlayer_vel_profile !< Set hyperbolic tangent streamwise velocity profile - real(kind(0d0)) :: mixlayer_vel_coef !< Coefficient for the hyperbolic tangent streamwise velocity profile - real(kind(0d0)) :: mixlayer_domain !< Domain for the hyperbolic tangent streamwise velocity profile + real(wp) :: mixlayer_vel_coef !< Coefficient for the hyperbolic tangent streamwise velocity profile + real(wp) :: mixlayer_domain !< Domain for the hyperbolic tangent streamwise velocity profile logical :: mixlayer_perturb !< Superimpose instability waves to surrounding fluid flow - real(kind(0d0)) :: pi_fac !< Factor for artificial pi_inf + real(wp) :: pi_fac !< Factor for artificial pi_inf ! Perturb density of surrounding air so as to break symmetry of grid logical :: perturb_flow integer :: perturb_flow_fluid !< Fluid to be perturbed with perturb_flow flag - real(kind(0d0)) :: perturb_flow_mag !< Magnitude of perturbation with perturb_flow flag + real(wp) :: perturb_flow_mag !< Magnitude of perturbation with perturb_flow flag logical :: perturb_sph integer :: perturb_sph_fluid !< Fluid to be perturbed with perturb_sph flag - real(kind(0d0)), dimension(num_fluids_max) :: fluid_rho + real(wp), dimension(num_fluids_max) :: fluid_rho integer, allocatable, dimension(:) :: proc_coords !< !! Processor coordinates in MPI_CART_COMM @@ -169,18 +169,18 @@ module m_global_parameters ! ========================================================================== - real(kind(0d0)) :: rhoref, pref !< Reference parameters for Tait EOS + real(wp) :: rhoref, pref !< Reference parameters for Tait EOS !> @name Bubble modeling !> @{ integer :: nb - real(kind(0d0)) :: R0ref - real(kind(0d0)) :: Ca, Web, Re_inv - real(kind(0d0)), dimension(:), allocatable :: weight, R0, V0 + real(wp) :: R0ref + real(wp) :: Ca, Web, Re_inv + real(wp), dimension(:), allocatable :: weight, R0, V0 logical :: bubbles logical :: qbmm !< Quadrature moment method integer :: nmom !< Number of carried moments - real(kind(0d0)) :: sigR, sigV, rhoRV !< standard deviations in R/V + real(wp) :: sigR, sigV, rhoRV !< standard deviations in R/V logical :: adv_n !< Solve the number density equation and compute alpha from number density !> @} @@ -206,19 +206,19 @@ module m_global_parameters logical :: polytropic logical :: polydisperse integer :: thermal !1 = adiabatic, 2 = isotherm, 3 = transfer - real(kind(0d0)) :: R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v - real(kind(0d0)), dimension(:), allocatable :: k_n, k_v, pb0, mass_n0, mass_v0, Pe_T - real(kind(0d0)), dimension(:), allocatable :: Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN - real(kind(0d0)) :: mul0, ss, gamma_v, mu_v - real(kind(0d0)) :: gamma_m, gamma_n, mu_n - real(kind(0d0)) :: poly_sigma + real(wp) :: R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v + real(wp), dimension(:), allocatable :: k_n, k_v, pb0, mass_n0, mass_v0, Pe_T + real(wp), dimension(:), allocatable :: Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN + real(wp) :: mul0, ss, gamma_v, mu_v + real(wp) :: gamma_m, gamma_n, mu_n + real(wp) :: poly_sigma integer :: dist_type !1 = binormal, 2 = lognormal-normal integer :: R0_type !1 = simpson !> @} !> @name Surface Tension Modeling !> @{ - real(kind(0d0)) :: sigma + real(wp) :: sigma !> @} !> @name Index variables used for m_variables_conversion diff --git a/src/pre_process/m_grid.f90 b/src/pre_process/m_grid.f90 index 84fdb14f42..7958fe9efa 100644 --- a/src/pre_process/m_grid.f90 +++ b/src/pre_process/m_grid.f90 @@ -58,14 +58,14 @@ subroutine s_generate_serial_grid ! Generic loop iterator integer :: i, j !< generic loop operators - real(kind(0d0)) :: length !< domain lengths + real(wp) :: length !< domain lengths ! Grid Generation in the x-direction =============================== - dx = (x_domain%end - x_domain%beg)/real(m + 1, kind(0d0)) + dx = (x_domain%end - x_domain%beg)/real(m + 1, wp) do i = 0, m - x_cc(i) = x_domain%beg + 5d-1*dx*real(2*i + 1, kind(0d0)) - x_cb(i - 1) = x_domain%beg + dx*real(i, kind(0d0)) + x_cc(i) = x_domain%beg + 5d-1*dx*real(2*i + 1, wp) + x_cb(i - 1) = x_domain%beg + dx*real(i, wp) end do x_cb(m) = x_domain%end @@ -102,23 +102,23 @@ subroutine s_generate_serial_grid if (grid_geometry == 2 .and. y_domain%beg == 0.0d0) then !IF (grid_geometry == 2) THEN - dy = (y_domain%end - y_domain%beg)/real(2*n + 1, kind(0d0)) + dy = (y_domain%end - y_domain%beg)/real(2*n + 1, wp) y_cc(0) = y_domain%beg + 5d-1*dy y_cb(-1) = y_domain%beg do i = 1, n - y_cc(i) = y_domain%beg + 2d0*dy*real(i, kind(0d0)) - y_cb(i - 1) = y_domain%beg + dy*real(2*i - 1, kind(0d0)) + y_cc(i) = y_domain%beg + 2d0*dy*real(i, wp) + y_cb(i - 1) = y_domain%beg + dy*real(2*i - 1, wp) end do else - dy = (y_domain%end - y_domain%beg)/real(n + 1, kind(0d0)) + dy = (y_domain%end - y_domain%beg)/real(n + 1, wp) do i = 0, n - y_cc(i) = y_domain%beg + 5d-1*dy*real(2*i + 1, kind(0d0)) - y_cb(i - 1) = y_domain%beg + dy*real(i, kind(0d0)) + y_cc(i) = y_domain%beg + 5d-1*dy*real(2*i + 1, wp) + y_cb(i - 1) = y_domain%beg + dy*real(i, wp) end do end if @@ -154,11 +154,11 @@ subroutine s_generate_serial_grid ! Grid Generation in the z-direction =============================== if (p == 0) return - dz = (z_domain%end - z_domain%beg)/real(p + 1, kind(0d0)) + dz = (z_domain%end - z_domain%beg)/real(p + 1, wp) do i = 0, p - z_cc(i) = z_domain%beg + 5d-1*dz*real(2*i + 1, kind(0d0)) - z_cb(i - 1) = z_domain%beg + dz*real(i, kind(0d0)) + z_cc(i) = z_domain%beg + 5d-1*dz*real(2*i + 1, wp) + z_cb(i - 1) = z_domain%beg + dz*real(i, wp) end do z_cb(p) = z_domain%end @@ -200,10 +200,10 @@ subroutine s_generate_parallel_grid #ifdef MFC_MPI - real(kind(0d0)) :: length !< domain lengths + real(wp) :: length !< domain lengths ! Locations of cell boundaries - real(kind(0d0)), allocatable, dimension(:) :: x_cb_glb, y_cb_glb, z_cb_glb !< + real(wp), allocatable, dimension(:) :: x_cb_glb, y_cb_glb, z_cb_glb !< !! Locations of cell boundaries character(LEN=path_len + name_len) :: file_loc !< @@ -219,9 +219,9 @@ subroutine s_generate_parallel_grid allocate (z_cb_glb(-1:p_glb)) ! Grid generation in the x-direction - dx = (x_domain%end - x_domain%beg)/real(m_glb + 1, kind(0d0)) + dx = (x_domain%end - x_domain%beg)/real(m_glb + 1, wp) do i = 0, m_glb - x_cb_glb(i - 1) = x_domain%beg + dx*real(i, kind(0d0)) + x_cb_glb(i - 1) = x_domain%beg + dx*real(i, wp) end do x_cb_glb(m_glb) = x_domain%end if (stretch_x) then @@ -249,15 +249,15 @@ subroutine s_generate_parallel_grid if (n_glb > 0) then if (grid_geometry == 2 .and. y_domain%beg == 0.0d0) then - dy = (y_domain%end - y_domain%beg)/real(2*n_glb + 1, kind(0d0)) + dy = (y_domain%end - y_domain%beg)/real(2*n_glb + 1, wp) y_cb_glb(-1) = y_domain%beg do i = 1, n_glb - y_cb_glb(i - 1) = y_domain%beg + dy*real(2*i - 1, kind(0d0)) + y_cb_glb(i - 1) = y_domain%beg + dy*real(2*i - 1, wp) end do else - dy = (y_domain%end - y_domain%beg)/real(n_glb + 1, kind(0d0)) + dy = (y_domain%end - y_domain%beg)/real(n_glb + 1, wp) do i = 0, n_glb - y_cb_glb(i - 1) = y_domain%beg + dy*real(i, kind(0d0)) + y_cb_glb(i - 1) = y_domain%beg + dy*real(i, wp) end do end if y_cb_glb(n_glb) = y_domain%end @@ -284,9 +284,9 @@ subroutine s_generate_parallel_grid ! Grid generation in the z-direction if (p_glb > 0) then - dz = (z_domain%end - z_domain%beg)/real(p_glb + 1, kind(0d0)) + dz = (z_domain%end - z_domain%beg)/real(p_glb + 1, wp) do i = 0, p_glb - z_cb_glb(i - 1) = z_domain%beg + dz*real(i, kind(0d0)) + z_cb_glb(i - 1) = z_domain%beg + dz*real(i, wp) end do z_cb_glb(p_glb) = z_domain%end if (stretch_z) then diff --git a/src/pre_process/m_model.fpp b/src/pre_process/m_model.fpp index eb54ffb3d3..f4a7fa5dd8 100644 --- a/src/pre_process/m_model.fpp +++ b/src/pre_process/m_model.fpp @@ -454,12 +454,12 @@ contains t_vec3, intent(in) :: spacing integer, intent(in) :: spc - real(kind(0d0)) :: fraction + real(wp) :: fraction type(t_ray) :: ray integer :: i, j, nInOrOut, nHits - real(kind(0d0)), dimension(1:spc, 1:3) :: ray_origins, ray_dirs + real(wp), dimension(1:spc, 1:3) :: ray_origins, ray_dirs do i = 1, spc call random_number(ray_origins(i, :)) @@ -501,8 +501,8 @@ contains logical :: intersects - real(kind(0d0)) :: v0v1(3), v0v2(3), N(3), P(3), C(3), edge(3), vp(3) - real(kind(0d0)) :: area2, d, t, NdotRayDirection + real(wp) :: v0v1(3), v0v2(3), N(3), P(3), C(3), edge(3), vp(3) + real(wp) :: area2, d, t, NdotRayDirection intersects = .false. diff --git a/src/pre_process/m_mpi_proxy.fpp b/src/pre_process/m_mpi_proxy.fpp index 09c20034e7..5c7060655b 100644 --- a/src/pre_process/m_mpi_proxy.fpp +++ b/src/pre_process/m_mpi_proxy.fpp @@ -130,10 +130,10 @@ contains ! Temporary # of processors in x-, y- and z-coordinate directions ! used during the processor factorization optimization procedure - real(kind(0d0)) :: tmp_num_procs_x, tmp_num_procs_y, tmp_num_procs_z + real(wp) :: tmp_num_procs_x, tmp_num_procs_y, tmp_num_procs_z ! Processor factorization (fct) minimization parameter - real(kind(0d0)) :: fct_min + real(wp) :: fct_min ! Cartesian processor topology communicator integer :: MPI_COMM_CART @@ -305,7 +305,7 @@ contains ! Preliminary uniform cell-width spacing if (old_grid .neqv. .true.) then - dz = (z_domain%end - z_domain%beg)/real(p + 1, kind(0d0)) + dz = (z_domain%end - z_domain%beg)/real(p + 1, wp) end if ! Optimal number of cells per processor @@ -420,7 +420,7 @@ contains ! Preliminary uniform cell-width spacing if (old_grid .neqv. .true.) then - dy = (y_domain%end - y_domain%beg)/real(n + 1, kind(0d0)) + dy = (y_domain%end - y_domain%beg)/real(n + 1, wp) end if ! Optimal number of cells per processor @@ -489,7 +489,7 @@ contains ! Preliminary uniform cell-width spacing if (old_grid .neqv. .true.) then - dx = (x_domain%end - x_domain%beg)/real(m + 1, kind(0d0)) + dx = (x_domain%end - x_domain%beg)/real(m + 1, wp) end if ! Optimal number of cells per processor diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index 5baf28cc89..b2b26cecd2 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -54,24 +54,24 @@ module m_patches s_sweep_plane, & s_model - real(kind(0d0)) :: x_centroid, y_centroid, z_centroid - real(kind(0d0)) :: length_x, length_y, length_z + real(wp) :: x_centroid, y_centroid, z_centroid + real(wp) :: length_x, length_y, length_z integer :: smooth_patch_id - real(kind(0d0)) :: smooth_coeff !< + real(wp) :: smooth_coeff !< !! These variables are analogous in both meaning and use to the similarly !! named components in the ic_patch_parameters type (see m_derived_types.f90 !! for additional details). They are employed as a means to more concisely !! perform the actions necessary to lay out a particular patch on the grid. - real(kind(0d0)) :: eta !< + real(wp) :: eta !< !! In the case that smoothing of patch boundaries is enabled and the boundary !! between two adjacent patches is to be smeared out, this variable's purpose !! is to act as a pseudo volume fraction to indicate the contribution of each !! patch toward the composition of a cell's fluid state. - real(kind(0d0)) :: cart_y, cart_z - real(kind(0d0)) :: sph_phi !< + real(wp) :: cart_y, cart_z + real(wp) :: sph_phi !< !! Variables to be used to hold cell locations in Cartesian coordinates if !! 3D simulation is using cylindrical coordinates @@ -99,7 +99,7 @@ contains integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf - real(kind(0d0)) :: pi_inf, gamma, lit_gamma + real(wp) :: pi_inf, gamma, lit_gamma integer :: i, j, k !< Generic loop operators @@ -158,8 +158,8 @@ contains type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< Generic loop iterators - real(kind(0d0)) :: th, thickness, nturns, mya - real(kind(0d0)) :: spiral_x_min, spiral_x_max, spiral_y_min, spiral_y_max + real(wp) :: th, thickness, nturns, mya + real(wp) :: spiral_x_min, spiral_x_max, spiral_y_min, spiral_y_max ! Transferring the circular patch's radius, centroid, smearing patch ! identity and smearing coefficient information @@ -224,7 +224,7 @@ contains type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf logical, intent(in) :: ib - real(kind(0d0)) :: radius + real(wp) :: radius integer :: i, j, k !< Generic loop iterators @@ -304,7 +304,7 @@ contains type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf logical, intent(in) :: ib - real(kind(0d0)) :: x0, y0, f, x_act, y_act, ca, pa, ma, ta, theta, xa, ya, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c + real(wp) :: x0, y0, f, x_act, y_act, ca, pa, ma, ta, theta, xa, ya, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c integer :: i, j, k, l integer :: Np1, Np2 @@ -466,7 +466,7 @@ contains type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf logical, intent(in) :: ib - real(kind(0d0)) :: x0, y0, z0, lz, z_max, z_min, f, x_act, y_act, ca, pa, ma, ta, theta, xa, ya, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c + real(wp) :: x0, y0, z0, lz, z_max, z_min, f, x_act, y_act, ca, pa, ma, ta, theta, xa, ya, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c integer :: i, j, k, l integer :: Np1, Np2 @@ -640,7 +640,7 @@ contains ! Generic loop iterators integer :: i, j, k - real(kind(0d0)) :: radius, myr, thickness + real(wp) :: radius, myr, thickness ! Transferring the circular patch's radius, centroid, smearing patch ! identity and smearing coefficient information @@ -698,7 +698,7 @@ contains ! Generic loop iterators integer :: i, j, k - real(kind(0d0)) :: radius, myr, thickness + real(wp) :: radius, myr, thickness ! Transferring the circular patch's radius, centroid, smearing patch ! identity and smearing coefficient information @@ -764,7 +764,7 @@ contains type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< Generic loop operators - real(kind(0d0)) :: a, b + real(wp) :: a, b ! Transferring the elliptical patch's radii, centroid, smearing ! patch identity, and smearing coefficient information @@ -832,7 +832,7 @@ contains ! Generic loop iterators integer :: i, j, k - real(kind(0d0)) :: a, b, c + real(wp) :: a, b, c ! Transferring the ellipsoidal patch's radii, centroid, smearing ! patch identity, and smearing coefficient information @@ -917,7 +917,7 @@ contains logical, intent(in) :: ib !< True if this patch is an immersed boundary integer :: i, j, k !< generic loop iterators - real(kind(0d0)) :: pi_inf, gamma, lit_gamma !< Equation of state parameters + real(wp) :: pi_inf, gamma, lit_gamma !< Equation of state parameters pi_inf = fluid_pp(1)%pi_inf gamma = fluid_pp(1)%gamma @@ -1027,7 +1027,7 @@ contains type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< Generic loop operators - real(kind(0d0)) :: a, b, c + real(wp) :: a, b, c ! Transferring the centroid information of the line to be swept x_centroid = patch_icpp(patch_id)%x_centroid @@ -1092,8 +1092,8 @@ contains type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< generic loop iterators - real(kind(0d0)) :: pi_inf, gamma, lit_gamma !< equation of state parameters - real(kind(0d0)) :: L0, U0 !< Taylor Green Vortex parameters + real(wp) :: pi_inf, gamma, lit_gamma !< equation of state parameters + real(wp) :: L0, U0 !< Taylor Green Vortex parameters pi_inf = fluid_pp(1)%pi_inf gamma = fluid_pp(1)%gamma @@ -1171,7 +1171,7 @@ contains ! Generic loop iterators integer :: i, j, k ! Placeholders for the cell boundary values - real(kind(0d0)) :: a, b, c, d, pi_inf, gamma, lit_gamma + real(wp) :: a, b, c, d, pi_inf, gamma, lit_gamma @:Hardcoded1DVariables() @@ -1231,7 +1231,7 @@ contains ! Generic loop iterators integer :: i, j, k ! Placeholders for the cell boundary values - real(kind(0d0)) :: fac, a, b, c, d, pi_inf, gamma, lit_gamma + real(wp) :: fac, a, b, c, d, pi_inf, gamma, lit_gamma pi_inf = fluid_pp(1)%pi_inf gamma = fluid_pp(1)%gamma @@ -1283,9 +1283,9 @@ contains type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< generic loop iterators - real(kind(0d0)) :: a, b, c, d !< placeholderrs for the cell boundary values - real(kind(0d0)) :: pi_inf, gamma, lit_gamma !< equation of state parameters - real(kind(0d0)) :: l, U0 !< Taylor Green Vortex parameters + real(wp) :: a, b, c, d !< placeholderrs for the cell boundary values + real(wp) :: pi_inf, gamma, lit_gamma !< equation of state parameters + real(wp) :: l, U0 !< Taylor Green Vortex parameters @:Hardcoded2DVariables() @@ -1352,7 +1352,7 @@ contains type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< generic loop iterators - real(kind(0d0)) :: pi_inf, gamma, lit_gamma !< equation of state parameters + real(wp) :: pi_inf, gamma, lit_gamma !< equation of state parameters @:Hardcoded3DVariables() @@ -1436,9 +1436,9 @@ contains type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< generic loop iterators - real(kind(0d0)) :: radius, epsilon, beta - complex(kind(0d0)) :: cmplx_i = (0d0, 1d0) - complex(kind(0d0)) :: H + real(wp) :: radius, epsilon, beta + complex(wp) :: cmplx_i = (0d0, 1d0) + complex(wp) :: H ! Transferring the patch's centroid and radius information x_centroid = patch_icpp(patch_id)%x_centroid @@ -1543,7 +1543,7 @@ contains end if end if - q_prim_vf(adv_idx%beg)%sf(i, j, k) = 1d0 - abs(real(H, kind(0d0))) + q_prim_vf(adv_idx%beg)%sf(i, j, k) = 1d0 - abs(real(H, wp)) end if @@ -1571,9 +1571,9 @@ contains ! Generic loop iterators integer :: i, j, k !< generic loop iterators - real(kind(0d0)) :: radius + real(wp) :: radius - real(kind(0d0)) :: radius_pressure, pressure_bubble, pressure_inf !< + real(wp) :: radius_pressure, pressure_bubble, pressure_inf !< !! Variables to initialize the pressure field that corresponds to the !! bubble-collapse test case found in Tiwari et al. (2013) @@ -1757,7 +1757,7 @@ contains logical, intent(in) :: ib !< True if this patch is an immersed boundary integer :: i, j, k !< Generic loop iterators - real(kind(0d0)) :: radius + real(wp) :: radius ! Transferring the cylindrical patch's centroid, length, radius, ! smoothing patch identity and smoothing coefficient information @@ -1912,7 +1912,7 @@ contains type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< Generic loop iterators - real(kind(0d0)) :: a, b, c, d + real(wp) :: a, b, c, d ! Transferring the centroid information of the plane to be swept x_centroid = patch_icpp(patch_id)%x_centroid @@ -1995,7 +1995,7 @@ contains t_vec3 :: point - real(kind(0d0)) :: grid_mm(1:3, 1:2) + real(wp) :: grid_mm(1:3, 1:2) integer :: cell_num integer :: ncells @@ -2091,7 +2091,7 @@ contains subroutine s_convert_cylindrical_to_cartesian_coord(cyl_y, cyl_z) !$acc routine seq - real(kind(0d0)), intent(in) :: cyl_y, cyl_z + real(wp), intent(in) :: cyl_y, cyl_z cart_y = cyl_y*sin(cyl_z) cart_z = cyl_y*cos(cyl_z) @@ -2114,7 +2114,7 @@ contains subroutine s_convert_cylindrical_to_spherical_coord(cyl_x, cyl_y) !$acc routine seq - real(kind(0d0)), intent(IN) :: cyl_x, cyl_y + real(wp), intent(IN) :: cyl_x, cyl_y sph_phi = atan(cyl_y/cyl_x) @@ -2126,9 +2126,9 @@ contains !! @param a Starting position function f_r(myth, offset, a) !$acc routine seq - real(kind(0d0)), intent(in) :: myth, offset, a - real(kind(0d0)) :: b - real(kind(0d0)) :: f_r + real(wp), intent(in) :: myth, offset, a + real(wp) :: b + real(wp) :: f_r !r(th) = a + b*th diff --git a/src/pre_process/m_perturbation.fpp b/src/pre_process/m_perturbation.fpp index 0247043dcf..8524d20a29 100644 --- a/src/pre_process/m_perturbation.fpp +++ b/src/pre_process/m_perturbation.fpp @@ -54,9 +54,9 @@ contains type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf integer :: i, j, k, l !< generic loop operators - real(kind(0d0)) :: perturb_alpha - real(kind(0d0)) :: alpha_unadv - real(kind(0d0)) :: rand_real + real(wp) :: perturb_alpha + real(wp) :: alpha_unadv + real(wp) :: rand_real call random_seed() do k = 0, p @@ -86,8 +86,8 @@ contains type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf integer :: i, j, k, l !< generic loop iterators - real(kind(0d0)) :: perturb_alpha - real(kind(0d0)) :: rand_real + real(wp) :: perturb_alpha + real(wp) :: rand_real call random_seed() ! Perturb partial density or velocity of surrounding flow by some random small amount of noise @@ -116,8 +116,8 @@ contains !! (2,2), (2,-2), (1,1), (1,-1) areadded on top of 2D waves. subroutine s_superposition_instability_wave(q_prim_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf - real(kind(0d0)), dimension(mixlayer_nvar, 0:m, 0:n, 0:p) :: wave, wave1, wave2, wave_tmp - real(kind(0d0)) :: uratio, Ldomain + real(wp), dimension(mixlayer_nvar, 0:m, 0:n, 0:p) :: wave, wave1, wave2, wave_tmp + real(wp) :: uratio, Ldomain integer :: i, j, k, q uratio = 1d0/patch_icpp(1)%vel(1) @@ -178,10 +178,10 @@ contains !> This subroutine computes equilibrium bubble radius of the perturbed pressure field subroutine s_compute_equilibrium_state(fP, fR0, fR) - real(kind(0d0)), intent(in) :: fP, fR0 - real(kind(0d0)), intent(inout) :: fR - real(kind(0d0)) :: f0, f1 - real(kind(0d0)) :: gam_b + real(wp), intent(in) :: fP, fR0 + real(wp), intent(inout) :: fR + real(wp) :: f0, f1 + real(wp) :: gam_b integer :: ii, jj gam_b = 1d0 + 1d0/fluid_pp(num_fluids + 1)%gamma @@ -224,14 +224,14 @@ contains !! Euler equations with parallel mean flow assumption !! (See Sandham 1989 PhD thesis for details). subroutine s_instability_wave(alpha, beta, wave, shift) - real(kind(0d0)), intent(in) :: alpha, beta !< spatial wavenumbers - real(kind(0d0)), dimension(mixlayer_nvar, 0:m, 0:n, 0:p), intent(inout) :: wave !< instability wave - real(kind(0d0)) :: shift !< phase shift - real(kind(0d0)), dimension(0:nbp - 1) :: u_mean !< mean density and velocity profiles - real(kind(0d0)) :: rho_mean, p_mean !< mean density and pressure - real(kind(0d0)), dimension(0:nbp - 1, 0:nbp - 1) :: d !< differential operator in y dir - real(kind(0d0)) :: gam, pi_inf, mach, c1, adv - real(kind(0d0)) :: xratio, uratio + real(wp), intent(in) :: alpha, beta !< spatial wavenumbers + real(wp), dimension(mixlayer_nvar, 0:m, 0:n, 0:p), intent(inout) :: wave !< instability wave + real(wp) :: shift !< phase shift + real(wp), dimension(0:nbp - 1) :: u_mean !< mean density and velocity profiles + real(wp) :: rho_mean, p_mean !< mean density and pressure + real(wp), dimension(0:nbp - 1, 0:nbp - 1) :: d !< differential operator in y dir + real(wp) :: gam, pi_inf, mach, c1, adv + real(wp) :: xratio, uratio integer :: i, j !< generic loop iterators xratio = mixlayer_vel_coef @@ -276,21 +276,21 @@ contains !! generate instability waves for the given set of spatial !! wave numbers and phase shift. subroutine s_solve_linear_system(alpha, beta, u_mean, rho_mean, p_mean, d, gam, pi_inf, mach, wave, shift) - real(kind(0d0)), intent(in) :: alpha, beta !< spatial wavenumbers - real(kind(0d0)), dimension(0:nbp - 1), intent(in) :: u_mean !< mean velocity profiles - real(kind(0d0)), intent(in) :: rho_mean, p_mean !< mean density and pressure - real(kind(0d0)), dimension(0:nbp - 1, 0:nbp - 1), intent(in) :: d !< differential operator in y dir - real(kind(0d0)), intent(in) :: gam, pi_inf, mach, shift - real(kind(0d0)), dimension(mixlayer_nvar, 0:m, 0:n, 0:p), intent(inout) :: wave - - real(kind(0d0)), dimension(0:nbp - 1) :: drho_mean, du_mean !< y-derivatives of mean profiles - real(kind(0d0)), dimension(0:mixlayer_nvar*nbp - 1, 0:mixlayer_nvar*nbp - 1) :: ar, ai !< matrices for eigenvalue problem - real(kind(0d0)), dimension(0:mixlayer_nvar*nbp - 1, 0:mixlayer_nvar*nbp - 1) :: br, bi, ci !< matrices for eigenvalue problem - real(kind(0d0)), dimension(0:mixlayer_nvar*n - n_bc_skip - 1, 0:mixlayer_nvar*n - n_bc_skip - 1) :: hr, hi !< matrices for eigenvalue problem - - real(kind(0d0)), dimension(0:mixlayer_nvar*n - n_bc_skip - 1, 0:mixlayer_nvar*n - n_bc_skip - 1) :: zr, zi !< eigenvectors - real(kind(0d0)), dimension(0:mixlayer_nvar*n - n_bc_skip - 1) :: wr, wi !< eigenvalues - real(kind(0d0)), dimension(0:mixlayer_nvar*n - n_bc_skip - 1) :: fv1, fv2, fv3 !< temporary memory + real(wp), intent(in) :: alpha, beta !< spatial wavenumbers + real(wp), dimension(0:nbp - 1), intent(in) :: u_mean !< mean velocity profiles + real(wp), intent(in) :: rho_mean, p_mean !< mean density and pressure + real(wp), dimension(0:nbp - 1, 0:nbp - 1), intent(in) :: d !< differential operator in y dir + real(wp), intent(in) :: gam, pi_inf, mach, shift + real(wp), dimension(mixlayer_nvar, 0:m, 0:n, 0:p), intent(inout) :: wave + + real(wp), dimension(0:nbp - 1) :: drho_mean, du_mean !< y-derivatives of mean profiles + real(wp), dimension(0:mixlayer_nvar*nbp - 1, 0:mixlayer_nvar*nbp - 1) :: ar, ai !< matrices for eigenvalue problem + real(wp), dimension(0:mixlayer_nvar*nbp - 1, 0:mixlayer_nvar*nbp - 1) :: br, bi, ci !< matrices for eigenvalue problem + real(wp), dimension(0:mixlayer_nvar*n - n_bc_skip - 1, 0:mixlayer_nvar*n - n_bc_skip - 1) :: hr, hi !< matrices for eigenvalue problem + + real(wp), dimension(0:mixlayer_nvar*n - n_bc_skip - 1, 0:mixlayer_nvar*n - n_bc_skip - 1) :: zr, zi !< eigenvectors + real(wp), dimension(0:mixlayer_nvar*n - n_bc_skip - 1) :: wr, wi !< eigenvalues + real(wp), dimension(0:mixlayer_nvar*n - n_bc_skip - 1) :: fv1, fv2, fv3 !< temporary memory integer :: ierr integer :: i, j, k, l !< generic loop iterators @@ -353,12 +353,12 @@ contains !> This subroutine applies non-reflecting subsonic buffer boundary condition !! to the linear system of equations (i.e. matrix A). subroutine s_instability_nonreflecting_subsonic_buffer_bc(ar, ai, hr, hi, rho_mean, mach) - real(kind(0d0)), dimension(0:mixlayer_nvar*nbp - 1, 0:mixlayer_nvar*nbp - 1), intent(inout) :: ar, ai !< matrices for eigenvalue problem - real(kind(0d0)), dimension(0:mixlayer_nvar*n - n_bc_skip - 1, 0:mixlayer_nvar*n - n_bc_skip - 1), intent(out) :: hr, hi !< matrices for eigenvalue problem - real(kind(0d0)), intent(in) :: rho_mean !< mean density profiles - real(kind(0d0)), intent(in) :: mach - real(kind(0d0)), dimension(0:mixlayer_nvar*n - 1, 0:mixlayer_nvar*n - 1) :: fr, fi !< matrices for eigenvalue problem - real(kind(0d0)), dimension(0:mixlayer_nvar*n - n_bc_skip - 1, 0:mixlayer_nvar*n - 1) :: gr, gi !< matrices for eigenvalue problem + real(wp), dimension(0:mixlayer_nvar*nbp - 1, 0:mixlayer_nvar*nbp - 1), intent(inout) :: ar, ai !< matrices for eigenvalue problem + real(wp), dimension(0:mixlayer_nvar*n - n_bc_skip - 1, 0:mixlayer_nvar*n - n_bc_skip - 1), intent(out) :: hr, hi !< matrices for eigenvalue problem + real(wp), intent(in) :: rho_mean !< mean density profiles + real(wp), intent(in) :: mach + real(wp), dimension(0:mixlayer_nvar*n - 1, 0:mixlayer_nvar*n - 1) :: fr, fi !< matrices for eigenvalue problem + real(wp), dimension(0:mixlayer_nvar*n - n_bc_skip - 1, 0:mixlayer_nvar*n - 1) :: gr, gi !< matrices for eigenvalue problem integer :: i, j, k, l, ii, jj ! Condition 1: v = 0 at BC - no action required here @@ -489,17 +489,17 @@ contains !! eigenvalue and corresponding eigenvector among the !! given set of eigenvalues and eigenvectors. subroutine s_generate_wave(wr, wi, zr, zi, rho_mean, mach, alpha, beta, wave, shift) - real(kind(0d0)), dimension(0:mixlayer_nvar*n - n_bc_skip - 1), intent(in) :: wr, wi !< eigenvalues - real(kind(0d0)), dimension(0:mixlayer_nvar*n - n_bc_skip - 1, 0:mixlayer_nvar*n - n_bc_skip - 1), intent(in) :: zr, zi !< eigenvectors - real(kind(0d0)), intent(in) :: rho_mean - real(kind(0d0)), dimension(mixlayer_nvar, 0:m, 0:n, 0:p), intent(inout) :: wave - real(kind(0d0)), intent(in) :: alpha, beta, mach, shift - real(kind(0d0)), dimension(0:mixlayer_nvar*n - n_bc_skip - 1) :: vr, vi, vnr, vni !< most unstable eigenvector - real(kind(0d0)), dimension(0:mixlayer_nvar*nbp - 1) :: xbr, xbi !< eigenvectors - real(kind(0d0)), dimension(0:mixlayer_nvar*(nbp - 1) - 1) :: xcr, xci !< eigenvectors - real(kind(0d0)) :: ang, norm - real(kind(0d0)) :: tr, ti, cr, ci !< temporary memory - real(kind(0d0)) :: xratio + real(wp), dimension(0:mixlayer_nvar*n - n_bc_skip - 1), intent(in) :: wr, wi !< eigenvalues + real(wp), dimension(0:mixlayer_nvar*n - n_bc_skip - 1, 0:mixlayer_nvar*n - n_bc_skip - 1), intent(in) :: zr, zi !< eigenvectors + real(wp), intent(in) :: rho_mean + real(wp), dimension(mixlayer_nvar, 0:m, 0:n, 0:p), intent(inout) :: wave + real(wp), intent(in) :: alpha, beta, mach, shift + real(wp), dimension(0:mixlayer_nvar*n - n_bc_skip - 1) :: vr, vi, vnr, vni !< most unstable eigenvector + real(wp), dimension(0:mixlayer_nvar*nbp - 1) :: xbr, xbi !< eigenvectors + real(wp), dimension(0:mixlayer_nvar*(nbp - 1) - 1) :: xcr, xci !< eigenvectors + real(wp) :: ang, norm + real(wp) :: tr, ti, cr, ci !< temporary memory + real(wp) :: xratio integer idx integer i, j, k diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index 7712db0a0f..d08ea409dc 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -419,7 +419,7 @@ contains ! Generic string used to store the address of a particular file character(LEN= & - int(floor(log10(real(sys_size, kind(0d0))))) + 1) :: file_num !< + int(floor(log10(real(sys_size, wp)))) + 1) :: file_num !< !! Used to store the variable position, in character form, of the !! currently manipulated conservative variable file @@ -543,7 +543,7 @@ contains #ifdef MFC_MPI - real(kind(0d0)), allocatable, dimension(:) :: x_cb_glb, y_cb_glb, z_cb_glb + real(wp), allocatable, dimension(:) :: x_cb_glb, y_cb_glb, z_cb_glb integer :: ifile, ierr, data_size integer, dimension(MPI_STATUS_SIZE) :: status @@ -828,9 +828,9 @@ contains subroutine s_apply_initial_condition(start, finish, proc_time, time_avg, time_final, file_exists) - real(kind(0d0)), intent(inout) :: start, finish - real(kind(0d0)), dimension(:), intent(inout) :: proc_time - real(kind(0d0)), intent(inout) :: time_avg, time_final + real(wp), intent(inout) :: start, finish + real(wp), dimension(:), intent(inout) :: proc_time + real(wp), intent(inout) :: time_avg, time_final logical, intent(inout) :: file_exists ! Setting up the grid and the initial condition. If the grid is read in from @@ -865,8 +865,8 @@ contains subroutine s_save_data(proc_time, time_avg, time_final, file_exists) - real(kind(0d0)), dimension(:), intent(inout) :: proc_time - real(kind(0d0)), intent(inout) :: time_avg, time_final + real(wp), dimension(:), intent(inout) :: proc_time + real(wp), intent(inout) :: time_avg, time_final logical, intent(inout) :: file_exists call s_mpi_barrier() diff --git a/src/pre_process/p_main.f90 b/src/pre_process/p_main.f90 index 544c0311a7..0bda585c0c 100644 --- a/src/pre_process/p_main.f90 +++ b/src/pre_process/p_main.f90 @@ -18,8 +18,8 @@ program p_main integer :: i logical :: file_exists - real(kind(0d0)) :: start, finish, time_avg, time_final - real(kind(0d0)), allocatable, dimension(:) :: proc_time + real(wp) :: start, finish, time_avg, time_final + real(wp), allocatable, dimension(:) :: proc_time call random_seed() diff --git a/src/simulation/m_acoustic_src.fpp b/src/simulation/m_acoustic_src.fpp index 02ee735091..406400390b 100644 --- a/src/simulation/m_acoustic_src.fpp +++ b/src/simulation/m_acoustic_src.fpp @@ -30,25 +30,25 @@ module m_acoustic_src @:CRAY_DECLARE_GLOBAL(logical, dimension(:), dipole) !$acc declare link(dipole) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :), loc_acoustic) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :), loc_acoustic) !$acc declare link(loc_acoustic) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), mag, length, height, wavelength, frequency, gauss_sigma_dist, gauss_sigma_time, npulse, dir, delay) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), mag, length, height, wavelength, frequency, gauss_sigma_dist, gauss_sigma_time, npulse, dir, delay) !$acc declare link(mag, length, height, wavelength, frequency, gauss_sigma_dist, gauss_sigma_time, npulse, dir, delay) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), foc_length, aperture) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), foc_length, aperture) !$acc declare link(foc_length, aperture) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), element_spacing_angle, element_polygon_ratio, rotate_angle) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), element_spacing_angle, element_polygon_ratio, rotate_angle) !$acc declare link(element_spacing_angle, element_polygon_ratio, rotate_angle) @:CRAY_DECLARE_GLOBAL(integer, dimension(:), num_elements, element_on) !$acc declare link(num_elements, element_on) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), mass_src, e_src) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), mass_src, e_src) !$acc declare link(mass_src, e_src) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), mom_src) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), mom_src) !$acc declare link(mom_src) @:CRAY_DECLARE_GLOBAL(integer, dimension(:), source_spatials_num_points) @@ -64,16 +64,16 @@ module m_acoustic_src logical, allocatable, dimension(:) :: dipole !$acc declare create(dipole) - real(kind(0d0)), allocatable, target, dimension(:, :) :: loc_acoustic + real(wp), allocatable, target, dimension(:, :) :: loc_acoustic !$acc declare create(loc_acoustic) - real(kind(0d0)), allocatable, dimension(:) :: mag, length, height, wavelength, frequency, gauss_sigma_dist, gauss_sigma_time, npulse, dir, delay + real(wp), allocatable, dimension(:) :: mag, length, height, wavelength, frequency, gauss_sigma_dist, gauss_sigma_time, npulse, dir, delay !$acc declare create(mag, length, height, wavelength, frequency, gauss_sigma_dist, gauss_sigma_time, npulse, dir, delay) - real(kind(0d0)), allocatable, dimension(:) :: foc_length, aperture + real(wp), allocatable, dimension(:) :: foc_length, aperture !$acc declare create(foc_length, aperture) - real(kind(0d0)), allocatable, dimension(:) :: element_spacing_angle, element_polygon_ratio, rotate_angle + real(wp), allocatable, dimension(:) :: element_spacing_angle, element_polygon_ratio, rotate_angle !$acc declare create(element_spacing_angle, element_polygon_ratio, rotate_angle) integer, allocatable, dimension(:) :: num_elements, element_on @@ -81,8 +81,8 @@ module m_acoustic_src !> @name Acoustic source terms !> @{ - real(kind(0d0)), allocatable, dimension(:, :, :) :: mass_src, e_src - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: mom_src + real(wp), allocatable, dimension(:, :, :) :: mass_src, e_src + real(wp), allocatable, dimension(:, :, :, :) :: mom_src !> @} !$acc declare create(mass_src, e_src, mom_src) @@ -167,12 +167,12 @@ contains integer, intent(in) :: t_step - real(kind(0d0)) :: myalpha(num_fluids), myalpha_rho(num_fluids) - real(kind(0d0)) :: myRho, B_tait - real(kind(0d0)) :: sim_time, c, small_gamma - real(kind(0d0)) :: frequency_local, gauss_sigma_time_local - real(kind(0d0)) :: mass_src_diff, mom_src_diff - real(kind(0d0)) :: source_temporal + real(wp) :: myalpha(num_fluids), myalpha_rho(num_fluids) + real(wp) :: myRho, B_tait + real(wp) :: sim_time, c, small_gamma + real(wp) :: frequency_local, gauss_sigma_time_local + real(wp) :: mass_src_diff, mom_src_diff + real(wp) :: source_temporal integer :: i, j, k, l, q !< generic loop variables integer :: ai !< acoustic source index @@ -337,13 +337,13 @@ contains subroutine s_source_temporal(sim_time, c, ai, term_index, frequency_local, gauss_sigma_time_local, source) !$acc routine seq integer, intent(in) :: ai, term_index - real(kind(0d0)), intent(in) :: sim_time, c - real(kind(0d0)), intent(in) :: frequency_local, gauss_sigma_time_local - real(kind(0d0)), intent(out) :: source + real(wp), intent(in) :: sim_time, c + real(wp), intent(in) :: frequency_local, gauss_sigma_time_local + real(wp), intent(out) :: source - real(kind(0d0)) :: omega ! angular frequency - real(kind(0d0)) :: sine_wave ! sine function for square wave - real(kind(0d0)) :: foc_length_factor ! Scale amplitude with radius for spherical support + real(wp) :: omega ! angular frequency + real(wp) :: sine_wave ! sine function for square wave + real(wp) :: foc_length_factor ! Scale amplitude with radius for spherical support ! i.e. Spherical support -> 1/r scaling; Cylindrical support -> 1/sqrt(r) [empirical correction: ^-0.5 -> ^-0.85] integer, parameter :: mass_label = 1 @@ -396,8 +396,8 @@ contains integer :: j, k, l, ai integer :: count integer :: dim - real(kind(0d0)) :: source_spatial, angle, xyz_to_r_ratios(3) - real(kind(0d0)), parameter :: threshold = 1d-10 + real(wp) :: source_spatial, angle, xyz_to_r_ratios(3) + real(wp), parameter :: threshold = 1d-10 if (n == 0) then dim = 1 @@ -493,10 +493,10 @@ contains !! @param xyz_to_r_ratios Ratios of the [xyz]-component of the source term to the magnitude (for 3D) subroutine s_source_spatial(j, k, l, loc, ai, source, angle, xyz_to_r_ratios) integer, intent(in) :: j, k, l, ai - real(kind(0d0)), dimension(3), intent(in) :: loc - real(kind(0d0)), intent(out) :: source, angle, xyz_to_r_ratios(3) + real(wp), dimension(3), intent(in) :: loc + real(wp), intent(out) :: source, angle, xyz_to_r_ratios(3) - real(kind(0d0)) :: sig, r(3) + real(wp) :: sig, r(3) ! Calculate sig spatial support width if (n == 0) then @@ -529,10 +529,10 @@ contains !! @param source Source term amplitude subroutine s_source_spatial_planar(ai, sig, r, source) integer, intent(in) :: ai - real(kind(0d0)), intent(in) :: sig, r(3) - real(kind(0d0)), intent(out) :: source + real(wp), intent(in) :: sig, r(3) + real(wp), intent(out) :: source - real(kind(0d0)) :: dist + real(wp) :: dist source = 0d0 @@ -559,10 +559,10 @@ contains !! @param xyz_to_r_ratios Ratios of the [xyz]-component of the source term to the magnitude (for 3D) subroutine s_source_spatial_transducer(ai, sig, r, source, angle, xyz_to_r_ratios) integer, intent(in) :: ai - real(kind(0d0)), intent(in) :: sig, r(3) - real(kind(0d0)), intent(out) :: source, angle, xyz_to_r_ratios(3) + real(wp), intent(in) :: sig, r(3) + real(wp), intent(out) :: source, angle, xyz_to_r_ratios(3) - real(kind(0d0)) :: current_angle, angle_half_aperture, dist, norm + real(wp) :: current_angle, angle_half_aperture, dist, norm source = 0d0 ! If not affected by transducer angle = 0d0 @@ -604,14 +604,14 @@ contains !! @param xyz_to_r_ratios Ratios of the [xyz]-component of the source term to the magnitude (for 3D) subroutine s_source_spatial_transducer_array(ai, sig, r, source, angle, xyz_to_r_ratios) integer, intent(in) :: ai - real(kind(0d0)), intent(in) :: sig, r(3) - real(kind(0d0)), intent(out) :: source, angle, xyz_to_r_ratios(3) + real(wp), intent(in) :: sig, r(3) + real(wp), intent(out) :: source, angle, xyz_to_r_ratios(3) integer :: elem, elem_min, elem_max - real(kind(0d0)) :: current_angle, angle_half_aperture, angle_per_elem, dist - real(kind(0d0)) :: angle_min, angle_max, norm - real(kind(0d0)) :: poly_side_length, aperture_element_3D, angle_elem - real(kind(0d0)) :: x2, y2, z2, x3, y3, z3, C, f, half_apert, dist_interp_to_elem_center + real(wp) :: current_angle, angle_half_aperture, angle_per_elem, dist + real(wp) :: angle_min, angle_max, norm + real(wp) :: poly_side_length, aperture_element_3D, angle_elem + real(wp) :: x2, y2, z2, x3, y3, z3, C, f, half_apert, dist_interp_to_elem_center if (element_on(ai) == 0) then ! Full transducer elem_min = 1 @@ -649,7 +649,7 @@ contains half_apert = aperture(ai)/2d0 do elem = elem_min, elem_max - angle_elem = 2d0*pi*real(elem, kind(0d0))/real(num_elements(ai), kind(0d0)) + rotate_angle(ai) + angle_elem = 2d0*pi*real(elem, wp)/real(num_elements(ai), wp) + rotate_angle(ai) ! Point 2 is the elem center x2 = f - dsqrt(f**2 - half_apert**2) @@ -688,8 +688,8 @@ contains !$acc routine seq logical, intent(in) :: freq_conv_flag integer, intent(in) :: ai - real(kind(0d0)), intent(in) :: c - real(kind(0d0)) :: f_frequency_local + real(wp), intent(in) :: c + real(wp) :: f_frequency_local if (freq_conv_flag) then f_frequency_local = c/wavelength(ai) @@ -707,8 +707,8 @@ contains !$acc routine seq logical, intent(in) :: gauss_conv_flag integer, intent(in) :: ai - real(kind(0d0)), intent(in) :: c - real(kind(0d0)) :: f_gauss_sigma_time_local + real(wp), intent(in) :: c + real(wp) :: f_gauss_sigma_time_local if (gauss_conv_flag) then f_gauss_sigma_time_local = gauss_sigma_dist(ai)/c diff --git a/src/simulation/m_body_forces.fpp b/src/simulation/m_body_forces.fpp index 490f0f45bb..f7b2962bee 100644 --- a/src/simulation/m_body_forces.fpp +++ b/src/simulation/m_body_forces.fpp @@ -25,10 +25,10 @@ module m_body_forces s_finalize_body_forces_module #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), rhoM) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), rhoM) !$acc declare link(rhoM) #else - real(kind(0d0)), allocatable, dimension(:, :, :) :: rhoM + real(wp), allocatable, dimension(:, :, :) :: rhoM !$acc declare create(rhoM) #endif @@ -63,7 +63,7 @@ contains !> This subroutine computes the acceleration at time t subroutine s_compute_acceleration(t) - real(kind(0d0)), intent(in) :: t + real(wp), intent(in) :: t if (m > 0) then accel_bf(1) = g_x + k_x*sin(w_x*t - p_x) diff --git a/src/simulation/m_boundary_conditions.fpp b/src/simulation/m_boundary_conditions.fpp index 266be8ed00..698d5c63ef 100644 --- a/src/simulation/m_boundary_conditions.fpp +++ b/src/simulation/m_boundary_conditions.fpp @@ -30,7 +30,7 @@ contains subroutine s_populate_variables_buffers(q_prim_vf, pb, mv) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv + real(wp), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv integer :: bc_loc, bc_dir @@ -217,7 +217,7 @@ contains subroutine s_ghost_cell_extrapolation(q_prim_vf, pb, mv, bc_dir, bc_loc) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv + real(wp), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: bc_dir, bc_loc integer :: j, k, l, q, i @@ -328,7 +328,7 @@ contains subroutine s_symmetry(q_prim_vf, pb, mv, bc_dir, bc_loc) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv + real(wp), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: bc_dir, bc_loc integer :: j, k, l, q, i @@ -610,7 +610,7 @@ contains subroutine s_periodic(q_prim_vf, pb, mv, bc_dir, bc_loc) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv + real(wp), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: bc_dir, bc_loc integer :: j, k, l, q, i @@ -830,7 +830,7 @@ contains subroutine s_axis(q_prim_vf, pb, mv, bc_dir, bc_loc) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv + real(wp), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: bc_dir, bc_loc integer :: j, k, l, q, i @@ -903,7 +903,7 @@ contains subroutine s_slip_wall(q_prim_vf, pb, mv, bc_dir, bc_loc) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv + real(wp), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: bc_dir, bc_loc integer :: j, k, l, q, i @@ -1045,7 +1045,7 @@ contains subroutine s_no_slip_wall(q_prim_vf, pb, mv, bc_dir, bc_loc) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv + real(wp), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: bc_dir, bc_loc integer :: j, k, l, q, i @@ -1222,7 +1222,7 @@ contains subroutine s_qbmm_extrapolation(pb, mv, bc_dir, bc_loc) - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv + real(wp), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: bc_dir, bc_loc integer :: j, k, l, q, i diff --git a/src/simulation/m_bubbles.fpp b/src/simulation/m_bubbles.fpp index 21f7aaf58c..92cc0c47d1 100644 --- a/src/simulation/m_bubbles.fpp +++ b/src/simulation/m_bubbles.fpp @@ -30,10 +30,10 @@ module m_bubbles !> @name Bubble dynamic source terms !> @{ - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), bub_adv_src) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), bub_adv_src) !$acc declare link(bub_adv_src) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), bub_r_src, bub_v_src, bub_p_src, bub_m_src) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), bub_r_src, bub_v_src, bub_p_src, bub_m_src) !$acc declare link(bub_r_src, bub_v_src, bub_p_src, bub_m_src) type(scalar_field) :: divu !< matrix for div(u) @@ -42,8 +42,8 @@ module m_bubbles @:CRAY_DECLARE_GLOBAL(integer, dimension(:), rs, vs, ms, ps) !$acc declare link(rs, vs, ms, ps) #else - real(kind(0d0)), allocatable, dimension(:, :, :) :: bub_adv_src - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: bub_r_src, bub_v_src, bub_p_src, bub_m_src + real(wp), allocatable, dimension(:, :, :) :: bub_adv_src + real(wp), allocatable, dimension(:, :, :, :) :: bub_r_src, bub_v_src, bub_p_src, bub_m_src !$acc declare create(bub_adv_src, bub_r_src, bub_v_src, bub_p_src, bub_m_src) type(scalar_field) :: divu !< matrix for div(u) @@ -104,8 +104,8 @@ contains !! @param q_cons_vf is the conservative variable subroutine s_comp_alpha_from_n(q_cons_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf - real(kind(0d0)) :: nR3bar - integer(kind(0d0)) :: i, j, k, l + real(wp) :: nR3bar + integer(wp) :: i, j, k, l !$acc parallel loop collapse(3) gang vector default(present) do l = 0, p @@ -189,26 +189,26 @@ contains integer, intent(in) :: t_step type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf - real(kind(0d0)) :: rddot - real(kind(0d0)) :: pb, mv, vflux, pbdot - real(kind(0d0)) :: n_tait, B_tait + real(wp) :: rddot + real(wp) :: pb, mv, vflux, pbdot + real(wp) :: n_tait, B_tait - real(kind(0d0)), dimension(nb) :: Rtmp, Vtmp - real(kind(0d0)) :: myR, myV, alf, myP, myRho, R2Vav, R3 - real(kind(0d0)), dimension(num_fluids) :: myalpha, myalpha_rho - real(kind(0d0)) :: start, finish + real(wp), dimension(nb) :: Rtmp, Vtmp + real(wp) :: myR, myV, alf, myP, myRho, R2Vav, R3 + real(wp), dimension(num_fluids) :: myalpha, myalpha_rho + real(wp) :: start, finish - real(kind(0d0)) :: nbub !< Bubble number density + real(wp) :: nbub !< Bubble number density - real(kind(0d0)), dimension(2) :: Re !< Reynolds number + real(wp), dimension(2) :: Re !< Reynolds number integer :: i, j, k, l, q, ii !< Loop variables integer :: ndirs !< Number of coordinate directions - real(kind(0d0)) :: err1, err2, err3, err4, err5 !< Error estimates for adaptive time stepping - real(kind(0d0)) :: t_new !< Updated time step size - real(kind(0d0)) :: h !< Time step size - real(kind(0d0)), dimension(4) :: myR_tmp1, myV_tmp1, myR_tmp2, myV_tmp2 !< Bubble radius, radial velocity, and radial acceleration for the inner loop + real(wp) :: err1, err2, err3, err4, err5 !< Error estimates for adaptive time stepping + real(wp) :: t_new !< Updated time step size + real(wp) :: h !< Time step size + real(wp), dimension(4) :: myR_tmp1, myV_tmp1, myR_tmp2, myV_tmp2 !< Bubble radius, radial velocity, and radial acceleration for the inner loop !$acc parallel loop collapse(3) gang vector default(present) do l = 0, p @@ -457,13 +457,13 @@ contains subroutine s_initialize_adap_dt(fRho, fP, fR, fV, fR0, fpb, fpbdot, alf, & fntait, fBtait, f_bub_adv_src, f_divu, h) !$acc routine seq - real(kind(0d0)), intent(IN) :: fRho, fP, fR, fV, fR0, fpb, fpbdot, alf - real(kind(0d0)), intent(IN) :: fntait, fBtait, f_bub_adv_src, f_divu - real(kind(0d0)), intent(out) :: h + real(wp), intent(IN) :: fRho, fP, fR, fV, fR0, fpb, fpbdot, alf + real(wp), intent(IN) :: fntait, fBtait, f_bub_adv_src, f_divu + real(wp), intent(out) :: h - real(kind(0d0)) :: h0, h1, h_min !< Time step size - real(kind(0d0)) :: d0, d1, d2 !< norms - real(kind(0d0)), dimension(2) :: myR_tmp, myV_tmp, myA_tmp !< Bubble radius, radial velocity, and radial acceleration + real(wp) :: h0, h1, h_min !< Time step size + real(wp) :: d0, d1, d2 !< norms + real(wp), dimension(2) :: myR_tmp, myV_tmp, myA_tmp !< Bubble radius, radial velocity, and radial acceleration ! Determine the starting time step ! Evaluate f(x0,y0) @@ -526,12 +526,12 @@ contains fntait, fBtait, f_bub_adv_src, f_divu, h, & myR_tmp, myV_tmp, err) !$acc routine seq - real(kind(0d0)), intent(IN) :: fRho, fP, fR, fV, fR0, fpb, fpbdot, alf - real(kind(0d0)), intent(IN) :: fntait, fBtait, f_bub_adv_src, f_divu, h - real(kind(0d0)), dimension(4), intent(OUT) :: myR_tmp, myV_tmp - real(kind(0d0)), dimension(4) :: myA_tmp - real(kind(0d0)), intent(OUT) :: err - real(kind(0d0)) :: err_R, err_V + real(wp), intent(IN) :: fRho, fP, fR, fV, fR0, fpb, fpbdot, alf + real(wp), intent(IN) :: fntait, fBtait, f_bub_adv_src, f_divu, h + real(wp), dimension(4), intent(OUT) :: myR_tmp, myV_tmp + real(wp), dimension(4) :: myA_tmp + real(wp), intent(OUT) :: err + real(wp) :: err_R, err_V ! Stage 0 myR_tmp(1) = fR @@ -577,9 +577,9 @@ contains !! @param fpb Internal bubble pressure function f_cpbw(fR0, fR, fV, fpb) !$acc routine seq - real(kind(0d0)), intent(in) :: fR0, fR, fV, fpb + real(wp), intent(in) :: fR0, fR, fV, fpb - real(kind(0d0)) :: f_cpbw + real(wp) :: f_cpbw if (polytropic) then f_cpbw = (Ca + 2.d0/Web/fR0)*((fR0/fR)**(3.d0*gam)) - Ca - 4.d0*Re_inv*fV/fR - 2.d0/(fR*Web) @@ -596,10 +596,10 @@ contains !! @param fBtait Tait EOS parameter function f_H(fCpbw, fCpinf, fntait, fBtait) !$acc routine seq - real(kind(0d0)), intent(in) :: fCpbw, fCpinf, fntait, fBtait + real(wp), intent(in) :: fCpbw, fCpinf, fntait, fBtait - real(kind(0d0)) :: tmp1, tmp2, tmp3 - real(kind(0d0)) :: f_H + real(wp) :: tmp1, tmp2, tmp3 + real(wp) :: f_H tmp1 = (fntait - 1.d0)/fntait tmp2 = (fCpbw/(1.d0 + fBtait) + 1.d0)**tmp1 @@ -616,10 +616,10 @@ contains !! @param fH Bubble enthalpy function f_cgas(fCpinf, fntait, fBtait, fH) !$acc routine seq - real(kind(0d0)), intent(in) :: fCpinf, fntait, fBtait, fH + real(wp), intent(in) :: fCpinf, fntait, fBtait, fH - real(kind(0d0)) :: tmp - real(kind(0d0)) :: f_cgas + real(wp) :: tmp + real(wp) :: f_cgas ! get sound speed for Gilmore equations "C" -> c_gas tmp = (fCpinf/(1.d0 + fBtait) + 1.d0)**((fntait - 1.d0)/fntait) @@ -639,10 +639,10 @@ contains !! @param divu Divergence of velocity function f_cpinfdot(fRho, fP, falf, fntait, fBtait, advsrc, divu) !$acc routine seq - real(kind(0d0)), intent(in) :: fRho, fP, falf, fntait, fBtait, advsrc, divu + real(wp), intent(in) :: fRho, fP, falf, fntait, fBtait, advsrc, divu - real(kind(0d0)) :: c2_liquid - real(kind(0d0)) :: f_cpinfdot + real(wp) :: c2_liquid + real(wp) :: f_cpinfdot ! get sound speed squared for liquid (only needed for pbdot) ! c_l^2 = gam (p+B) / (rho*(1-alf)) @@ -669,11 +669,11 @@ contains !! @param fpbdot Time derivative of the internal bubble pressure function f_Hdot(fCpbw, fCpinf, fCpinf_dot, fntait, fBtait, fR, fV, fR0, fpbdot) !$acc routine seq - real(kind(0d0)), intent(in) :: fCpbw, fCpinf, fCpinf_dot, fntait, fBtait - real(kind(0d0)), intent(in) :: fR, fV, fR0, fpbdot + real(wp), intent(in) :: fCpbw, fCpinf, fCpinf_dot, fntait, fBtait + real(wp), intent(in) :: fR, fV, fR0, fpbdot - real(kind(0d0)) :: tmp1, tmp2 - real(kind(0d0)) :: f_Hdot + real(wp) :: tmp1, tmp2 + real(wp) :: f_Hdot if (polytropic) then tmp1 = (fR0/fR)**(3.d0*gam) @@ -711,11 +711,11 @@ contains !! @param f_divu Divergence of velocity function f_rddot(fRho, fP, fR, fV, fR0, fpb, fpbdot, alf, fntait, fBtait, f_bub_adv_src, f_divu) !$acc routine seq - real(kind(0d0)), intent(in) :: fRho, fP, fR, fV, fR0, fpb, fpbdot, alf - real(kind(0d0)), intent(in) :: fntait, fBtait, f_bub_adv_src, f_divu + real(wp), intent(in) :: fRho, fP, fR, fV, fR0, fpb, fpbdot, alf + real(wp), intent(in) :: fntait, fBtait, f_bub_adv_src, f_divu - real(kind(0d0)) :: fCpbw, fCpinf, fCpinf_dot, fH, fHdot, c_gas, c_liquid - real(kind(0d0)) :: f_rddot + real(wp) :: fCpbw, fCpinf, fCpinf_dot, fH, fHdot, c_gas, c_liquid + real(wp) :: f_rddot if (bubble_model == 1) then ! Gilmore bubbles @@ -749,9 +749,9 @@ contains !! @param fCpbw Boundary wall pressure function f_rddot_RP(fCp, fRho, fR, fV, fR0, fCpbw) !$acc routine seq - real(kind(0d0)), intent(in) :: fCp, fRho, fR, fV, fR0, fCpbw + real(wp), intent(in) :: fCp, fRho, fR, fV, fR0, fCpbw - real(kind(0d0)) :: f_rddot_RP + real(wp) :: f_rddot_RP !! rddot = (1/r) ( -3/2 rdot^2 + ((r0/r)^3\gamma - Cp)/rho ) !! rddot = (1/r) ( -3/2 rdot^2 + (tmp1 - Cp)/rho ) @@ -772,11 +772,11 @@ contains !! @param fBtait Tait EOS parameter function f_rddot_G(fCpbw, fR, fV, fH, fHdot, fcgas, fntait, fBtait) !$acc routine seq - real(kind(0d0)), intent(in) :: fCpbw, fR, fV, fH, fHdot - real(kind(0d0)), intent(in) :: fcgas, fntait, fBtait + real(wp), intent(in) :: fCpbw, fR, fV, fH, fHdot + real(wp), intent(in) :: fcgas, fntait, fBtait - real(kind(0d0)) :: tmp1, tmp2, tmp3 - real(kind(0d0)) :: f_rddot_G + real(wp) :: tmp1, tmp2, tmp3 + real(wp) :: f_rddot_G tmp1 = fV/fcgas tmp2 = 1.d0 + 4.d0*Re_inv/fcgas/fR*(fCpbw/(1.d0 + fBtait) + 1.d0) & @@ -795,9 +795,9 @@ contains !! @param fpb Internal bubble pressure function f_cpbw_KM(fR0, fR, fV, fpb) !$acc routine seq - real(kind(0d0)), intent(in) :: fR0, fR, fV, fpb + real(wp), intent(in) :: fR0, fR, fV, fpb - real(kind(0d0)) :: f_cpbw_KM + real(wp) :: f_cpbw_KM if (polytropic) then f_cpbw_KM = Ca*((fR0/fR)**(3.d0*gam)) - Ca + 1d0 @@ -823,11 +823,11 @@ contains !! @param fC Current sound speed function f_rddot_KM(fpbdot, fCp, fCpbw, fRho, fR, fV, fR0, fC) !$acc routine seq - real(kind(0d0)), intent(in) :: fpbdot, fCp, fCpbw - real(kind(0d0)), intent(in) :: fRho, fR, fV, fR0, fC + real(wp), intent(in) :: fpbdot, fCp, fCpbw + real(wp), intent(in) :: fRho, fR, fV, fR0, fC - real(kind(0d0)) :: tmp1, tmp2, cdot_star - real(kind(0d0)) :: f_rddot_KM + real(wp) :: tmp1, tmp2, cdot_star + real(wp) :: f_rddot_KM if (polytropic) then cdot_star = -3d0*gam*Ca*((fR0/fR)**(3d0*gam))*fV/fR diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index 5b95b6d92f..a5dcdbbb53 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -40,14 +40,14 @@ module m_cbc !! q_prim_vf in the coordinate direction normal to the domain boundary along !! which the CBC is applied. #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), q_prim_rsx_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), q_prim_rsy_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), q_prim_rsz_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), q_prim_rsx_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), q_prim_rsy_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), q_prim_rsz_vf) !$acc declare link(q_prim_rsx_vf, q_prim_rsy_vf, q_prim_rsz_vf) #else - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: q_prim_rsx_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: q_prim_rsy_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: q_prim_rsz_vf + real(wp), allocatable, dimension(:, :, :, :) :: q_prim_rsx_vf + real(wp), allocatable, dimension(:, :, :, :) :: q_prim_rsy_vf + real(wp), allocatable, dimension(:, :, :, :) :: q_prim_rsz_vf #endif #ifdef CRAY_ACC_WAR @@ -60,65 +60,65 @@ module m_cbc !! cell-average primitive variables, q_prims_rs_vf, and not a Riemann solver. #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), F_rsx_vf, F_src_rsx_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), F_rsy_vf, F_src_rsy_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), F_rsz_vf, F_src_rsz_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), F_rsx_vf, F_src_rsx_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), F_rsy_vf, F_src_rsy_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), F_rsz_vf, F_src_rsz_vf) !$acc declare link(F_rsx_vf, F_src_rsx_vf, F_rsy_vf, F_src_rsy_vf, F_rsz_vf, F_src_rsz_vf) #else - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: F_rsx_vf, F_src_rsx_vf !< - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: F_rsy_vf, F_src_rsy_vf !< - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: F_rsz_vf, F_src_rsz_vf !< + real(wp), allocatable, dimension(:, :, :, :) :: F_rsx_vf, F_src_rsx_vf !< + real(wp), allocatable, dimension(:, :, :, :) :: F_rsy_vf, F_src_rsy_vf !< + real(wp), allocatable, dimension(:, :, :, :) :: F_rsz_vf, F_src_rsz_vf !< #endif #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsx_vf, flux_src_rsx_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsy_vf, flux_src_rsy_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsz_vf, flux_src_rsz_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), flux_rsx_vf, flux_src_rsx_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), flux_rsy_vf, flux_src_rsy_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), flux_rsz_vf, flux_src_rsz_vf) !$acc declare link(flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf) #else - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsx_vf, flux_src_rsx_vf !< - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsy_vf, flux_src_rsy_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsz_vf, flux_src_rsz_vf + real(wp), allocatable, dimension(:, :, :, :) :: flux_rsx_vf, flux_src_rsx_vf !< + real(wp), allocatable, dimension(:, :, :, :) :: flux_rsy_vf, flux_src_rsy_vf + real(wp), allocatable, dimension(:, :, :, :) :: flux_rsz_vf, flux_src_rsz_vf #endif - real(kind(0d0)) :: c !< Cell averaged speed of sound - real(kind(0d0)), dimension(2) :: Re !< Cell averaged Reynolds numbers + real(wp) :: c !< Cell averaged speed of sound + real(wp), dimension(2) :: Re !< Cell averaged Reynolds numbers !$acc declare create(c, Re) - real(kind(0d0)) :: dpres_ds !< Spatial derivatives in s-dir of pressure + real(wp) :: dpres_ds !< Spatial derivatives in s-dir of pressure !$acc declare create(dpres_ds) #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), ds) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), ds) !$acc declare link(ds) #else - real(kind(0d0)), allocatable, dimension(:) :: ds !< Cell-width distribution in the s-direction + real(wp), allocatable, dimension(:) :: ds !< Cell-width distribution in the s-direction #endif ! CBC Coefficients ========================================================= #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :), fd_coef_x) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :), fd_coef_y) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :), fd_coef_z) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :), fd_coef_x) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :), fd_coef_y) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :), fd_coef_z) !$acc declare link(fd_coef_x, fd_coef_y, fd_coef_z) #else - real(kind(0d0)), allocatable, dimension(:, :) :: fd_coef_x !< Finite diff. coefficients x-dir - real(kind(0d0)), allocatable, dimension(:, :) :: fd_coef_y !< Finite diff. coefficients y-dir - real(kind(0d0)), allocatable, dimension(:, :) :: fd_coef_z !< Finite diff. coefficients z-dir + real(wp), allocatable, dimension(:, :) :: fd_coef_x !< Finite diff. coefficients x-dir + real(wp), allocatable, dimension(:, :) :: fd_coef_y !< Finite diff. coefficients y-dir + real(wp), allocatable, dimension(:, :) :: fd_coef_z !< Finite diff. coefficients z-dir #endif !! The first dimension identifies the location of a coefficient in the FD !! formula, while the last dimension denotes the location of the CBC. ! Bug with NVHPC when using nullified pointers in a declare create - ! real(kind(0d0)), pointer, dimension(:, :) :: fd_coef => null() + ! real(wp), pointer, dimension(:, :) :: fd_coef => null() #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), pi_coef_x) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), pi_coef_y) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), pi_coef_z) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), pi_coef_x) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), pi_coef_y) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), pi_coef_z) !$acc declare link(pi_coef_x, pi_coef_y, pi_coef_z) #else - real(kind(0d0)), allocatable, dimension(:, :, :) :: pi_coef_x !< Polynomial interpolant coefficients in x-dir - real(kind(0d0)), allocatable, dimension(:, :, :) :: pi_coef_y !< Polynomial interpolant coefficients in y-dir - real(kind(0d0)), allocatable, dimension(:, :, :) :: pi_coef_z !< Polynomial interpolant coefficients in z-dir + real(wp), allocatable, dimension(:, :, :) :: pi_coef_x !< Polynomial interpolant coefficients in x-dir + real(wp), allocatable, dimension(:, :, :) :: pi_coef_y !< Polynomial interpolant coefficients in y-dir + real(wp), allocatable, dimension(:, :, :) :: pi_coef_z !< Polynomial interpolant coefficients in z-dir #endif !! The first dimension of the array identifies the polynomial, the !! second dimension identifies the position of its coefficients and the last @@ -440,7 +440,7 @@ contains integer, intent(in) :: cbc_dir_in, cbc_loc_in ! Cell-boundary locations in the s-direction - real(kind(0d0)), dimension(0:buff_size + 1) :: s_cb + real(wp), dimension(0:buff_size + 1) :: s_cb ! Generic loop iterator integer :: i @@ -632,35 +632,35 @@ contains ! First-order time derivatives of the partial densities, density, ! velocity, pressure, advection variables, and the specific heat ! ratio and liquid stiffness functions - real(kind(0d0)), dimension(num_fluids) :: dalpha_rho_dt - real(kind(0d0)) :: drho_dt - real(kind(0d0)), dimension(num_dims) :: dvel_dt - real(kind(0d0)) :: dpres_dt - real(kind(0d0)), dimension(num_fluids) :: dadv_dt - real(kind(0d0)) :: dgamma_dt - real(kind(0d0)) :: dpi_inf_dt - real(kind(0d0)) :: dqv_dt - real(kind(0d0)), dimension(contxe) :: alpha_rho, dalpha_rho_ds, mf - real(kind(0d0)), dimension(2) :: Re_cbc - real(kind(0d0)), dimension(num_dims) :: vel, dvel_ds - real(kind(0d0)), dimension(num_fluids) :: adv, dadv_ds - real(kind(0d0)), dimension(sys_size) :: L - real(kind(0d0)), dimension(3) :: lambda - - real(kind(0d0)) :: rho !< Cell averaged density - real(kind(0d0)) :: pres !< Cell averaged pressure - real(kind(0d0)) :: E !< Cell averaged energy - real(kind(0d0)) :: H !< Cell averaged enthalpy - real(kind(0d0)) :: gamma !< Cell averaged specific heat ratio - real(kind(0d0)) :: pi_inf !< Cell averaged liquid stiffness - real(kind(0d0)) :: qv !< Cell averaged fluid reference energy - real(kind(0d0)) :: c - - real(kind(0d0)) :: vel_K_sum, vel_dv_dt_sum + real(wp), dimension(num_fluids) :: dalpha_rho_dt + real(wp) :: drho_dt + real(wp), dimension(num_dims) :: dvel_dt + real(wp) :: dpres_dt + real(wp), dimension(num_fluids) :: dadv_dt + real(wp) :: dgamma_dt + real(wp) :: dpi_inf_dt + real(wp) :: dqv_dt + real(wp), dimension(contxe) :: alpha_rho, dalpha_rho_ds, mf + real(wp), dimension(2) :: Re_cbc + real(wp), dimension(num_dims) :: vel, dvel_ds + real(wp), dimension(num_fluids) :: adv, dadv_ds + real(wp), dimension(sys_size) :: L + real(wp), dimension(3) :: lambda + + real(wp) :: rho !< Cell averaged density + real(wp) :: pres !< Cell averaged pressure + real(wp) :: E !< Cell averaged energy + real(wp) :: H !< Cell averaged enthalpy + real(wp) :: gamma !< Cell averaged specific heat ratio + real(wp) :: pi_inf !< Cell averaged liquid stiffness + real(wp) :: qv !< Cell averaged fluid reference energy + real(wp) :: c + + real(wp) :: vel_K_sum, vel_dv_dt_sum integer :: i, j, k, r, q !< Generic loop iterators - real(kind(0d0)) :: blkmod1, blkmod2 !< Fluid bulk modulus for Wood mixture sound speed + real(wp) :: blkmod1, blkmod2 !< Fluid bulk modulus for Wood mixture sound speed ! Reshaping of inputted data and association of the FD and PI ! coefficients, or CBC coefficients, respectively, hinging on @@ -1073,7 +1073,7 @@ contains do j = 0, buff_size q_prim_rsx_vf(j, k, r, momxb) = & q_prim_vf(momxb)%sf(dj*(m - 2*j) + j, k, r)* & - sign(1d0, -real(cbc_loc, kind(0d0))) + sign(1d0, -real(cbc_loc, wp)) end do end do end do @@ -1085,7 +1085,7 @@ contains do j = -1, buff_size flux_rsx_vf(j, k, r, i) = & flux_vf(i)%sf(dj*((m - 1) - 2*j) + j, k, r)* & - sign(1d0, -real(cbc_loc, kind(0d0))) + sign(1d0, -real(cbc_loc, wp)) end do end do end do @@ -1120,7 +1120,7 @@ contains do j = -1, buff_size flux_src_rsx_vf(j, k, r, advxb) = & flux_src_vf(advxb)%sf(dj*((m - 1) - 2*j) + j, k, r)* & - sign(1d0, -real(cbc_loc, kind(0d0))) + sign(1d0, -real(cbc_loc, wp)) end do end do end do @@ -1149,7 +1149,7 @@ contains do j = 0, buff_size q_prim_rsy_vf(j, k, r, momxb + 1) = & q_prim_vf(momxb + 1)%sf(k, dj*(n - 2*j) + j, r)* & - sign(1d0, -real(cbc_loc, kind(0d0))) + sign(1d0, -real(cbc_loc, wp)) end do end do end do @@ -1161,7 +1161,7 @@ contains do j = -1, buff_size flux_rsy_vf(j, k, r, i) = & flux_vf(i)%sf(k, dj*((n - 1) - 2*j) + j, r)* & - sign(1d0, -real(cbc_loc, kind(0d0))) + sign(1d0, -real(cbc_loc, wp)) end do end do end do @@ -1196,7 +1196,7 @@ contains do j = -1, buff_size flux_src_rsy_vf(j, k, r, advxb) = & flux_src_vf(advxb)%sf(k, dj*((n - 1) - 2*j) + j, r)* & - sign(1d0, -real(cbc_loc, kind(0d0))) + sign(1d0, -real(cbc_loc, wp)) end do end do end do @@ -1225,7 +1225,7 @@ contains do j = 0, buff_size q_prim_rsz_vf(j, k, r, momxe) = & q_prim_vf(momxe)%sf(r, k, dj*(p - 2*j) + j)* & - sign(1d0, -real(cbc_loc, kind(0d0))) + sign(1d0, -real(cbc_loc, wp)) end do end do end do @@ -1237,7 +1237,7 @@ contains do j = -1, buff_size flux_rsz_vf(j, k, r, i) = & flux_vf(i)%sf(r, k, dj*((p - 1) - 2*j) + j)* & - sign(1d0, -real(cbc_loc, kind(0d0))) + sign(1d0, -real(cbc_loc, wp)) end do end do end do @@ -1272,7 +1272,7 @@ contains do j = -1, buff_size flux_src_rsz_vf(j, k, r, advxb) = & flux_src_vf(advxb)%sf(r, k, dj*((p - 1) - 2*j) + j)* & - sign(1d0, -real(cbc_loc, kind(0d0))) + sign(1d0, -real(cbc_loc, wp)) end do end do end do @@ -1322,7 +1322,7 @@ contains do j = -1, buff_size flux_vf(i)%sf(dj*((m - 1) - 2*j) + j, k, r) = & flux_rsx_vf(j, k, r, i)* & - sign(1d0, -real(cbc_loc, kind(0d0))) + sign(1d0, -real(cbc_loc, wp)) end do end do end do @@ -1356,7 +1356,7 @@ contains do j = -1, buff_size flux_src_vf(advxb)%sf(dj*((m - 1) - 2*j) + j, k, r) = & flux_src_rsx_vf(j, k, r, advxb)* & - sign(1d0, -real(cbc_loc, kind(0d0))) + sign(1d0, -real(cbc_loc, wp)) end do end do end do @@ -1373,7 +1373,7 @@ contains do j = -1, buff_size flux_vf(i)%sf(k, dj*((n - 1) - 2*j) + j, r) = & flux_rsy_vf(j, k, r, i)* & - sign(1d0, -real(cbc_loc, kind(0d0))) + sign(1d0, -real(cbc_loc, wp)) end do end do end do @@ -1408,7 +1408,7 @@ contains do j = -1, buff_size flux_src_vf(advxb)%sf(k, dj*((n - 1) - 2*j) + j, r) = & flux_src_rsy_vf(j, k, r, advxb)* & - sign(1d0, -real(cbc_loc, kind(0d0))) + sign(1d0, -real(cbc_loc, wp)) end do end do end do @@ -1426,7 +1426,7 @@ contains do j = -1, buff_size flux_vf(i)%sf(r, k, dj*((p - 1) - 2*j) + j) = & flux_rsz_vf(j, k, r, i)* & - sign(1d0, -real(cbc_loc, kind(0d0))) + sign(1d0, -real(cbc_loc, wp)) end do end do end do @@ -1461,7 +1461,7 @@ contains do j = -1, buff_size flux_src_vf(advxb)%sf(r, k, dj*((p - 1) - 2*j) + j) = & flux_src_rsz_vf(j, k, r, advxb)* & - sign(1d0, -real(cbc_loc, kind(0d0))) + sign(1d0, -real(cbc_loc, wp)) end do end do end do diff --git a/src/simulation/m_chemistry.fpp b/src/simulation/m_chemistry.fpp index d1d9b67d6c..45982b1b29 100644 --- a/src/simulation/m_chemistry.fpp +++ b/src/simulation/m_chemistry.fpp @@ -99,16 +99,16 @@ contains integer :: x, y, z integer :: eqn - real(kind(0d0)) :: T + real(wp) :: T integer :: o - real(kind(0d0)) :: dyn_pres - real(kind(0d0)) :: E + real(wp) :: dyn_pres + real(wp) :: E - real(kind(0d0)) :: rho + real(wp) :: rho real(kind(1.d0)), dimension(num_species) :: Ys real(kind(1.d0)), dimension(num_species) :: omega - real(kind(0d0)), dimension(num_species) :: enthalpies - real(kind(0d0)) :: cp_mix + real(wp), dimension(num_species) :: enthalpies + real(wp) :: cp_mix #:if chemistry diff --git a/src/simulation/m_compute_cbc.fpp b/src/simulation/m_compute_cbc.fpp index c4b369945e..738b02d075 100644 --- a/src/simulation/m_compute_cbc.fpp +++ b/src/simulation/m_compute_cbc.fpp @@ -33,13 +33,13 @@ contains #else !$acc routine seq #endif - real(kind(0d0)), dimension(3), intent(in) :: lambda - real(kind(0d0)), dimension(sys_size), intent(inout) :: L - real(kind(0d0)), intent(in) :: rho, c - real(kind(0d0)), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds - real(kind(0d0)), intent(in) :: dpres_ds - real(kind(0d0)), dimension(num_dims), intent(in) :: dvel_ds - real(kind(0d0)), dimension(num_fluids), intent(in) :: dadv_ds + real(wp), dimension(3), intent(in) :: lambda + real(wp), dimension(sys_size), intent(inout) :: L + real(wp), intent(in) :: rho, c + real(wp), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds + real(wp), intent(in) :: dpres_ds + real(wp), dimension(num_dims), intent(in) :: dvel_ds + real(wp), dimension(num_fluids), intent(in) :: dadv_ds integer :: i @@ -63,13 +63,13 @@ contains #else !$acc routine seq #endif - real(kind(0d0)), dimension(3), intent(in) :: lambda - real(kind(0d0)), dimension(sys_size), intent(inout) :: L - real(kind(0d0)), intent(in) :: rho, c - real(kind(0d0)), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds - real(kind(0d0)), intent(in) :: dpres_ds - real(kind(0d0)), dimension(num_dims), intent(in) :: dvel_ds - real(kind(0d0)), dimension(num_fluids), intent(in) :: dadv_ds + real(wp), dimension(3), intent(in) :: lambda + real(wp), dimension(sys_size), intent(inout) :: L + real(wp), intent(in) :: rho, c + real(wp), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds + real(wp), intent(in) :: dpres_ds + real(wp), dimension(num_dims), intent(in) :: dvel_ds + real(wp), dimension(num_fluids), intent(in) :: dadv_ds integer :: i !< Generic loop iterator @@ -105,13 +105,13 @@ contains #else !$acc routine seq #endif - real(kind(0d0)), dimension(3), intent(in) :: lambda - real(kind(0d0)), dimension(sys_size), intent(inout) :: L - real(kind(0d0)), intent(in) :: rho, c - real(kind(0d0)), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds - real(kind(0d0)), intent(in) :: dpres_ds - real(kind(0d0)), dimension(num_dims), intent(in) :: dvel_ds - real(kind(0d0)), dimension(num_fluids), intent(in) :: dadv_ds + real(wp), dimension(3), intent(in) :: lambda + real(wp), dimension(sys_size), intent(inout) :: L + real(wp), intent(in) :: rho, c + real(wp), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds + real(wp), intent(in) :: dpres_ds + real(wp), dimension(num_dims), intent(in) :: dvel_ds + real(wp), dimension(num_fluids), intent(in) :: dadv_ds integer :: i @@ -133,13 +133,13 @@ contains #else !$acc routine seq #endif - real(kind(0d0)), dimension(3), intent(in) :: lambda - real(kind(0d0)), dimension(sys_size), intent(inout) :: L - real(kind(0d0)), intent(in) :: rho, c - real(kind(0d0)), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds - real(kind(0d0)), intent(in) :: dpres_ds - real(kind(0d0)), dimension(num_dims), intent(in) :: dvel_ds - real(kind(0d0)), dimension(num_fluids), intent(in) :: dadv_ds + real(wp), dimension(3), intent(in) :: lambda + real(wp), dimension(sys_size), intent(inout) :: L + real(wp), intent(in) :: rho, c + real(wp), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds + real(wp), intent(in) :: dpres_ds + real(wp), dimension(num_dims), intent(in) :: dvel_ds + real(wp), dimension(num_fluids), intent(in) :: dadv_ds integer :: i !> Generic loop iterator @@ -175,13 +175,13 @@ contains #else !$acc routine seq #endif - real(kind(0d0)), dimension(3), intent(in) :: lambda - real(kind(0d0)), dimension(sys_size), intent(inout) :: L - real(kind(0d0)), intent(in) :: rho, c - real(kind(0d0)), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds - real(kind(0d0)), intent(in) :: dpres_ds - real(kind(0d0)), dimension(num_dims), intent(in) :: dvel_ds - real(kind(0d0)), dimension(num_fluids), intent(in) :: dadv_ds + real(wp), dimension(3), intent(in) :: lambda + real(wp), dimension(sys_size), intent(inout) :: L + real(wp), intent(in) :: rho, c + real(wp), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds + real(wp), intent(in) :: dpres_ds + real(wp), dimension(num_dims), intent(in) :: dvel_ds + real(wp), dimension(num_fluids), intent(in) :: dadv_ds integer :: i !> Generic loop iterator @@ -213,13 +213,13 @@ contains #else !$acc routine seq #endif - real(kind(0d0)), dimension(3), intent(in) :: lambda - real(kind(0d0)), dimension(sys_size), intent(inout) :: L - real(kind(0d0)), intent(in) :: rho, c - real(kind(0d0)), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds - real(kind(0d0)), intent(in) :: dpres_ds - real(kind(0d0)), dimension(num_dims), intent(in) :: dvel_ds - real(kind(0d0)), dimension(num_fluids), intent(in) :: dadv_ds + real(wp), dimension(3), intent(in) :: lambda + real(wp), dimension(sys_size), intent(inout) :: L + real(wp), intent(in) :: rho, c + real(wp), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds + real(wp), intent(in) :: dpres_ds + real(wp), dimension(num_dims), intent(in) :: dvel_ds + real(wp), dimension(num_fluids), intent(in) :: dadv_ds integer :: i !> Generic loop iterator @@ -252,13 +252,13 @@ contains #else !$acc routine seq #endif - real(kind(0d0)), dimension(3), intent(in) :: lambda - real(kind(0d0)), dimension(sys_size), intent(inout) :: L - real(kind(0d0)), intent(in) :: rho, c - real(kind(0d0)), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds - real(kind(0d0)), intent(in) :: dpres_ds - real(kind(0d0)), dimension(num_dims), intent(in) :: dvel_ds - real(kind(0d0)), dimension(num_fluids), intent(in) :: dadv_ds + real(wp), dimension(3), intent(in) :: lambda + real(wp), dimension(sys_size), intent(inout) :: L + real(wp), intent(in) :: rho, c + real(wp), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds + real(wp), intent(in) :: dpres_ds + real(wp), dimension(num_dims), intent(in) :: dvel_ds + real(wp), dimension(num_fluids), intent(in) :: dadv_ds integer :: i do i = 1, advxe @@ -277,13 +277,13 @@ contains #else !$acc routine seq #endif - real(kind(0d0)), dimension(3), intent(in) :: lambda - real(kind(0d0)), dimension(sys_size), intent(inout) :: L - real(kind(0d0)), intent(in) :: rho, c - real(kind(0d0)), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds - real(kind(0d0)), intent(in) :: dpres_ds - real(kind(0d0)), dimension(num_dims), intent(in) :: dvel_ds - real(kind(0d0)), dimension(num_fluids), intent(in) :: dadv_ds + real(wp), dimension(3), intent(in) :: lambda + real(wp), dimension(sys_size), intent(inout) :: L + real(wp), intent(in) :: rho, c + real(wp), dimension(num_fluids), intent(in) :: mf, dalpha_rho_ds + real(wp), intent(in) :: dpres_ds + real(wp), dimension(num_dims), intent(in) :: dvel_ds + real(wp), dimension(num_fluids), intent(in) :: dadv_ds integer :: i !< Generic loop iterator diff --git a/src/simulation/m_compute_levelset.fpp b/src/simulation/m_compute_levelset.fpp index 60bf389761..49e0caf5e1 100644 --- a/src/simulation/m_compute_levelset.fpp +++ b/src/simulation/m_compute_levelset.fpp @@ -26,9 +26,9 @@ module m_compute_levelset s_compute_rectangle_levelset, & s_compute_sphere_levelset - real(kind(0d0)) :: x_centroid, y_centroid, z_centroid - real(kind(0d0)) :: length_x, length_y, length_z - real(kind(0d0)) :: radius + real(wp) :: x_centroid, y_centroid, z_centroid + real(wp) :: length_x, length_y, length_z + real(wp) :: radius type(bounds_info) :: x_boundary, y_boundary, z_boundary !< !! These variables combine the centroid and length parameters associated with @@ -41,13 +41,13 @@ contains !> Initialize IBM module subroutine s_compute_circle_levelset(levelset, levelset_norm, ib_patch_id) - real(kind(0d0)), dimension(0:m, 0:n, 0:p, num_ibs), intent(inout) :: levelset - real(kind(0d0)), dimension(0:m, 0:n, 0:p, num_ibs, 3), intent(inout) :: levelset_norm + real(wp), dimension(0:m, 0:n, 0:p, num_ibs), intent(inout) :: levelset + real(wp), dimension(0:m, 0:n, 0:p, num_ibs, 3), intent(inout) :: levelset_norm integer, intent(in) :: ib_patch_id - real(kind(0d0)) :: radius, dist - real(kind(0d0)) :: x_centroid, y_centroid - real(kind(0d0)), dimension(3) :: dist_vec + real(wp) :: radius, dist + real(wp) :: x_centroid, y_centroid + real(wp), dimension(3) :: dist_vec integer :: i, j !< Loop index variables @@ -77,14 +77,14 @@ contains subroutine s_compute_airfoil_levelset(levelset, levelset_norm, ib_patch_id) - real(kind(0d0)), dimension(0:m, 0:n, 0:p, num_ibs), intent(inout) :: levelset - real(kind(0d0)), dimension(0:m, 0:n, 0:p, num_ibs, 3), intent(inout) :: levelset_norm + real(wp), dimension(0:m, 0:n, 0:p, num_ibs), intent(inout) :: levelset + real(wp), dimension(0:m, 0:n, 0:p, num_ibs, 3), intent(inout) :: levelset_norm integer, intent(in) :: ib_patch_id - real(kind(0d0)) :: radius, dist, global_dist + real(wp) :: radius, dist, global_dist integer :: global_id - real(kind(0d0)) :: x_centroid, y_centroid, x_act, y_act, theta - real(kind(0d0)), dimension(3) :: dist_vec + real(wp) :: x_centroid, y_centroid, x_act, y_act, theta + real(wp), dimension(3) :: dist_vec integer :: i, j, k !< Loop index variables @@ -160,14 +160,14 @@ contains subroutine s_compute_3D_airfoil_levelset(levelset, levelset_norm, ib_patch_id) - real(kind(0d0)), dimension(0:m, 0:n, 0:p, num_ibs), intent(inout) :: levelset - real(kind(0d0)), dimension(0:m, 0:n, 0:p, num_ibs, 3), intent(inout) :: levelset_norm + real(wp), dimension(0:m, 0:n, 0:p, num_ibs), intent(inout) :: levelset + real(wp), dimension(0:m, 0:n, 0:p, num_ibs, 3), intent(inout) :: levelset_norm integer, intent(in) :: ib_patch_id - real(kind(0d0)) :: radius, dist, dist_surf, dist_side, global_dist + real(wp) :: radius, dist, dist_surf, dist_side, global_dist integer :: global_id - real(kind(0d0)) :: x_centroid, y_centroid, z_centroid, lz, z_max, z_min, x_act, y_act, theta - real(kind(0d0)), dimension(3) :: dist_vec + real(wp) :: x_centroid, y_centroid, z_centroid, lz, z_max, z_min, x_act, y_act, theta + real(wp), dimension(3) :: dist_vec integer :: i, j, k, l !< Loop index variables @@ -262,13 +262,13 @@ contains !> Initialize IBM module subroutine s_compute_rectangle_levelset(levelset, levelset_norm, ib_patch_id) - real(kind(0d0)), dimension(0:m, 0:n, 0:p, num_ibs), intent(inout) :: levelset - real(kind(0d0)), dimension(0:m, 0:n, 0:p, num_ibs, 3), intent(inout) :: levelset_norm + real(wp), dimension(0:m, 0:n, 0:p, num_ibs), intent(inout) :: levelset + real(wp), dimension(0:m, 0:n, 0:p, num_ibs, 3), intent(inout) :: levelset_norm integer, intent(in) :: ib_patch_id - real(kind(0d0)) :: top_right(2), bottom_left(2) - real(kind(0d0)) :: x, y, min_dist - real(kind(0d0)) :: side_dists(4) + real(wp) :: top_right(2), bottom_left(2) + real(wp) :: x, y, min_dist + real(wp) :: side_dists(4) integer :: i, j, k !< Loop index variables @@ -347,13 +347,13 @@ contains subroutine s_compute_sphere_levelset(levelset, levelset_norm, ib_patch_id) - real(kind(0d0)), dimension(0:m, 0:n, 0:p, num_ibs), intent(inout) :: levelset - real(kind(0d0)), dimension(0:m, 0:n, 0:p, num_ibs, 3), intent(inout) :: levelset_norm + real(wp), dimension(0:m, 0:n, 0:p, num_ibs), intent(inout) :: levelset + real(wp), dimension(0:m, 0:n, 0:p, num_ibs, 3), intent(inout) :: levelset_norm integer, intent(in) :: ib_patch_id - real(kind(0d0)) :: radius, dist - real(kind(0d0)) :: x_centroid, y_centroid, z_centroid - real(kind(0d0)), dimension(3) :: dist_vec + real(wp) :: radius, dist + real(wp) :: x_centroid, y_centroid, z_centroid + real(wp), dimension(3) :: dist_vec integer :: i, j, k !< Loop index variables @@ -384,15 +384,15 @@ contains subroutine s_compute_cylinder_levelset(levelset, levelset_norm, ib_patch_id) - real(kind(0d0)), dimension(0:m, 0:n, 0:p, num_ibs), intent(inout) :: levelset - real(kind(0d0)), dimension(0:m, 0:n, 0:p, num_ibs, 3), intent(inout) :: levelset_norm + real(wp), dimension(0:m, 0:n, 0:p, num_ibs), intent(inout) :: levelset + real(wp), dimension(0:m, 0:n, 0:p, num_ibs, 3), intent(inout) :: levelset_norm integer, intent(in) :: ib_patch_id - real(kind(0d0)) :: radius, dist - real(kind(0d0)) :: x_centroid, y_centroid, z_centroid - real(kind(0d0)) :: length_x, length_y, length_z - real(kind(0d0)), dimension(3) :: pos_vec, centroid_vec, dist_vec, dist_sides_vec, dist_surface_vec - real(kind(0d0)) :: dist_side, dist_surface, side_pos + real(wp) :: radius, dist + real(wp) :: x_centroid, y_centroid, z_centroid + real(wp) :: length_x, length_y, length_z + real(wp), dimension(3) :: pos_vec, centroid_vec, dist_vec, dist_sides_vec, dist_surface_vec + real(wp) :: dist_side, dist_surface, side_pos type(bounds_info) :: boundary integer :: i, j, k !< Loop index variables diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index b5d33da119..d232367152 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -71,31 +71,31 @@ module m_data_output end subroutine s_write_abstract_data_files end interface ! ======================================================== #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), icfl_sf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), vcfl_sf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), ccfl_sf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), Rc_sf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), icfl_sf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), vcfl_sf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), ccfl_sf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), Rc_sf) !$acc declare link(icfl_sf, vcfl_sf, ccfl_sf, Rc_sf) #else - real(kind(0d0)), allocatable, dimension(:, :, :) :: icfl_sf !< ICFL stability criterion - real(kind(0d0)), allocatable, dimension(:, :, :) :: vcfl_sf !< VCFL stability criterion - real(kind(0d0)), allocatable, dimension(:, :, :) :: ccfl_sf !< CCFL stability criterion - real(kind(0d0)), allocatable, dimension(:, :, :) :: Rc_sf !< Rc stability criterion + real(wp), allocatable, dimension(:, :, :) :: icfl_sf !< ICFL stability criterion + real(wp), allocatable, dimension(:, :, :) :: vcfl_sf !< VCFL stability criterion + real(wp), allocatable, dimension(:, :, :) :: ccfl_sf !< CCFL stability criterion + real(wp), allocatable, dimension(:, :, :) :: Rc_sf !< Rc stability criterion !$acc declare create(icfl_sf, vcfl_sf, ccfl_sf, Rc_sf) #endif - real(kind(0d0)) :: icfl_max_loc, icfl_max_glb !< ICFL stability extrema on local and global grids - real(kind(0d0)) :: vcfl_max_loc, vcfl_max_glb !< VCFL stability extrema on local and global grids - real(kind(0d0)) :: ccfl_max_loc, ccfl_max_glb !< CCFL stability extrema on local and global grids - real(kind(0d0)) :: Rc_min_loc, Rc_min_glb !< Rc stability extrema on local and global grids + real(wp) :: icfl_max_loc, icfl_max_glb !< ICFL stability extrema on local and global grids + real(wp) :: vcfl_max_loc, vcfl_max_glb !< VCFL stability extrema on local and global grids + real(wp) :: ccfl_max_loc, ccfl_max_glb !< CCFL stability extrema on local and global grids + real(wp) :: Rc_min_loc, Rc_min_glb !< Rc stability extrema on local and global grids !$acc declare create(icfl_max_loc, icfl_max_glb, vcfl_max_loc, vcfl_max_glb, ccfl_max_loc, ccfl_max_glb, Rc_min_loc, Rc_min_glb) !> @name ICFL, VCFL, CCFL and Rc stability criteria extrema over all the time-steps !> @{ - real(kind(0d0)) :: icfl_max !< ICFL criterion maximum - real(kind(0d0)) :: vcfl_max !< VCFL criterion maximum - real(kind(0d0)) :: ccfl_max !< CCFL criterion maximum - real(kind(0d0)) :: Rc_min !< Rc criterion maximum + real(wp) :: icfl_max !< ICFL criterion maximum + real(wp) :: vcfl_max !< VCFL criterion maximum + real(wp) :: ccfl_max !< CCFL criterion maximum + real(wp) :: Rc_min !< Rc criterion maximum !> @} procedure(s_write_abstract_data_files), pointer :: s_write_data_files => null() @@ -228,31 +228,31 @@ contains type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer, intent(IN) :: t_step - real(kind(0d0)), dimension(num_fluids) :: alpha_rho !< Cell-avg. partial density - real(kind(0d0)) :: rho !< Cell-avg. density - real(kind(0d0)), dimension(num_dims) :: vel !< Cell-avg. velocity - real(kind(0d0)) :: vel_sum !< Cell-avg. velocity sum - real(kind(0d0)) :: pres !< Cell-avg. pressure - real(kind(0d0)), dimension(num_fluids) :: alpha !< Cell-avg. volume fraction - real(kind(0d0)) :: gamma !< Cell-avg. sp. heat ratio - real(kind(0d0)) :: pi_inf !< Cell-avg. liquid stiffness function - real(kind(0d0)) :: qv !< Cell-avg. fluid reference energy - real(kind(0d0)) :: c !< Cell-avg. sound speed - real(kind(0d0)) :: E !< Cell-avg. energy - real(kind(0d0)) :: H !< Cell-avg. enthalpy - real(kind(0d0)), dimension(2) :: Re !< Cell-avg. Reynolds numbers + real(wp), dimension(num_fluids) :: alpha_rho !< Cell-avg. partial density + real(wp) :: rho !< Cell-avg. density + real(wp), dimension(num_dims) :: vel !< Cell-avg. velocity + real(wp) :: vel_sum !< Cell-avg. velocity sum + real(wp) :: pres !< Cell-avg. pressure + real(wp), dimension(num_fluids) :: alpha !< Cell-avg. volume fraction + real(wp) :: gamma !< Cell-avg. sp. heat ratio + real(wp) :: pi_inf !< Cell-avg. liquid stiffness function + real(wp) :: qv !< Cell-avg. fluid reference energy + real(wp) :: c !< Cell-avg. sound speed + real(wp) :: E !< Cell-avg. energy + real(wp) :: H !< Cell-avg. enthalpy + real(wp), dimension(2) :: Re !< Cell-avg. Reynolds numbers ! ICFL, VCFL, CCFL and Rc stability criteria extrema for the current ! time-step and located on both the local (loc) and the global (glb) ! computational domains - real(kind(0d0)) :: blkmod1, blkmod2 !< + real(wp) :: blkmod1, blkmod2 !< !! Fluid bulk modulus for Woods mixture sound speed integer :: i, j, k, l, q !< Generic loop iterators integer :: Nfq - real(kind(0d0)) :: fltr_dtheta !< + real(wp) :: fltr_dtheta !< !! Modified dtheta accounting for Fourier filtering in azimuthal direction. ! Computing Stability Criteria at Current Time-step ================ @@ -389,12 +389,12 @@ contains integer :: i, j, k, l, ii, r!< Generic loop iterators - real(kind(0d0)), dimension(nb) :: nRtmp !< Temporary bubble concentration - real(kind(0d0)) :: nbub, nR3, vftmp !< Temporary bubble number density - real(kind(0d0)) :: gamma, lit_gamma, pi_inf, qv !< Temporary EOS params - real(kind(0d0)) :: rho !< Temporary density - real(kind(0d0)), dimension(2) :: Re !< Temporary Reynolds number - real(kind(0d0)) :: E_e !< Temp. elastic energy contribution + real(wp), dimension(nb) :: nRtmp !< Temporary bubble concentration + real(wp) :: nbub, nR3, vftmp !< Temporary bubble number density + real(wp) :: gamma, lit_gamma, pi_inf, qv !< Temporary EOS params + real(wp) :: rho !< Temporary density + real(wp), dimension(2) :: Re !< Temporary Reynolds number + real(wp) :: E_e !< Temp. elastic energy contribution ! Creating or overwriting the time-step root directory write (t_step_dir, '(A,I0,A,I0)') trim(case_dir)//'/p_all' @@ -927,65 +927,65 @@ contains integer, intent(in) :: t_step type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf - real(kind(0d0)), dimension(0:m, 0:n, 0:p), intent(in) :: accel_mag + real(wp), dimension(0:m, 0:n, 0:p), intent(in) :: accel_mag - real(kind(0d0)), dimension(-1:m) :: distx - real(kind(0d0)), dimension(-1:n) :: disty - real(kind(0d0)), dimension(-1:p) :: distz + real(wp), dimension(-1:m) :: distx + real(wp), dimension(-1:n) :: disty + real(wp), dimension(-1:p) :: distz ! The cell-averaged partial densities, density, velocity, pressure, ! volume fractions, specific heat ratio function, liquid stiffness ! function, and sound speed. - real(kind(0d0)) :: lit_gamma, nbub - real(kind(0d0)) :: rho - real(kind(0d0)), dimension(num_dims) :: vel - real(kind(0d0)) :: pres - real(kind(0d0)) :: ptilde - real(kind(0d0)) :: ptot - real(kind(0d0)) :: alf - real(kind(0d0)) :: alfgr - real(kind(0d0)), dimension(num_fluids) :: alpha - real(kind(0d0)) :: gamma - real(kind(0d0)) :: pi_inf - real(kind(0d0)) :: qv - real(kind(0d0)) :: c - real(kind(0d0)) :: M00, M10, M01, M20, M11, M02 - real(kind(0d0)) :: varR, varV - real(kind(0d0)), dimension(Nb) :: nR, R, nRdot, Rdot - real(kind(0d0)) :: nR3 - real(kind(0d0)) :: accel - real(kind(0d0)) :: int_pres - real(kind(0d0)) :: max_pres - real(kind(0d0)), dimension(2) :: Re - real(kind(0d0)) :: E_e - real(kind(0d0)), dimension(6) :: tau_e - real(kind(0d0)) :: G - real(kind(0d0)) :: dyn_p + real(wp) :: lit_gamma, nbub + real(wp) :: rho + real(wp), dimension(num_dims) :: vel + real(wp) :: pres + real(wp) :: ptilde + real(wp) :: ptot + real(wp) :: alf + real(wp) :: alfgr + real(wp), dimension(num_fluids) :: alpha + real(wp) :: gamma + real(wp) :: pi_inf + real(wp) :: qv + real(wp) :: c + real(wp) :: M00, M10, M01, M20, M11, M02 + real(wp) :: varR, varV + real(wp), dimension(Nb) :: nR, R, nRdot, Rdot + real(wp) :: nR3 + real(wp) :: accel + real(wp) :: int_pres + real(wp) :: max_pres + real(wp), dimension(2) :: Re + real(wp) :: E_e + real(wp), dimension(6) :: tau_e + real(wp) :: G + real(wp) :: dyn_p integer :: i, j, k, l, s, q, d !< Generic loop iterator - real(kind(0d0)) :: nondim_time !< Non-dimensional time + real(wp) :: nondim_time !< Non-dimensional time - real(kind(0d0)) :: tmp !< + real(wp) :: tmp !< !! Temporary variable to store quantity for mpi_allreduce - real(kind(0d0)) :: blkmod1, blkmod2 !< + real(wp) :: blkmod1, blkmod2 !< !! Fluid bulk modulus for Woods mixture sound speed integer :: npts !< Number of included integral points - real(kind(0d0)) :: rad, thickness !< For integral quantities + real(wp) :: rad, thickness !< For integral quantities logical :: trigger !< For integral quantities - real(kind(0d0)) :: rhoYks(1:num_species) + real(wp) :: rhoYks(1:num_species) ! Non-dimensional time calculation if (time_stepper == 23) then nondim_time = mytime else if (t_step_old /= dflt_int) then - nondim_time = real(t_step + t_step_old, kind(0d0))*dt + nondim_time = real(t_step + t_step_old, wp)*dt else - nondim_time = real(t_step, kind(0d0))*dt !*1.d-5/10.0761131451d0 + nondim_time = real(t_step, wp)*dt !*1.d-5/10.0761131451d0 end if end if @@ -1573,7 +1573,7 @@ contains !! all of the time-steps and the simulation run-time. subroutine s_close_run_time_information_file - real(kind(0d0)) :: run_time !< Run-time of the simulation + real(wp) :: run_time !< Run-time of the simulation ! Writing the footer of and closing the run-time information file write (3, '(A)') '----------------------------------------'// & '----------------------------------------' diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index 1c4e838a56..6159a51d2e 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -39,15 +39,15 @@ module m_derived_variables !! active coordinate directions, the centered family of the finite-difference !! schemes is used. !> @{ - real(kind(0d0)), public, allocatable, dimension(:, :) :: fd_coeff_x - real(kind(0d0)), public, allocatable, dimension(:, :) :: fd_coeff_y - real(kind(0d0)), public, allocatable, dimension(:, :) :: fd_coeff_z + real(wp), public, allocatable, dimension(:, :) :: fd_coeff_x + real(wp), public, allocatable, dimension(:, :) :: fd_coeff_y + real(wp), public, allocatable, dimension(:, :) :: fd_coeff_z !> @} ! @name Variables for computing acceleration !> @{ - real(kind(0d0)), public, allocatable, dimension(:, :, :) :: accel_mag - real(kind(0d0)), public, allocatable, dimension(:, :, :) :: x_accel, y_accel, z_accel + real(wp), public, allocatable, dimension(:, :, :) :: accel_mag + real(wp), public, allocatable, dimension(:, :, :) :: x_accel, y_accel, z_accel !> @} contains @@ -188,7 +188,7 @@ subroutine s_derive_acceleration_component(i, q_prim_vf0, q_prim_vf1, & type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf2 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf3 - real(kind(0d0)), dimension(0:m, 0:n, 0:p), intent(out) :: q_sf + real(wp), dimension(0:m, 0:n, 0:p), intent(out) :: q_sf integer :: j, k, l, r !< Generic loop iterators diff --git a/src/simulation/m_fftw.fpp b/src/simulation/m_fftw.fpp index 58fb51be77..c5013a7e98 100644 --- a/src/simulation/m_fftw.fpp +++ b/src/simulation/m_fftw.fpp @@ -52,14 +52,14 @@ module m_fftw !$acc declare create(real_size, cmplx_size, x_size, batch_size, Nfq) #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), data_real_gpu) - @:CRAY_DECLARE_GLOBAL(complex(kind(0d0)), dimension(:), data_cmplx_gpu) - @:CRAY_DECLARE_GLOBAL(complex(kind(0d0)), dimension(:), data_fltr_cmplx_gpu) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), data_real_gpu) + @:CRAY_DECLARE_GLOBAL(complex(wp), dimension(:), data_cmplx_gpu) + @:CRAY_DECLARE_GLOBAL(complex(wp), dimension(:), data_fltr_cmplx_gpu) !$acc declare link(data_real_gpu, data_cmplx_gpu, data_fltr_cmplx_gpu) #else - real(kind(0d0)), allocatable, target :: data_real_gpu(:) - complex(kind(0d0)), allocatable, target :: data_cmplx_gpu(:) - complex(kind(0d0)), allocatable, target :: data_fltr_cmplx_gpu(:) + real(wp), allocatable, target :: data_real_gpu(:) + complex(wp), allocatable, target :: data_cmplx_gpu(:) + complex(wp), allocatable, target :: data_fltr_cmplx_gpu(:) !$acc declare create(data_real_gpu, data_cmplx_gpu, data_fltr_cmplx_gpu) #endif @@ -205,7 +205,7 @@ contains do k = 1, sys_size do j = 0, m do l = 0, p - data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size)/real(real_size, kind(0d0)) + data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size)/real(real_size, wp) q_cons_vf(k)%sf(j, 0, l) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) end do end do @@ -240,7 +240,7 @@ contains #endif !$acc end host_data - Nfq = min(floor(2d0*real(i, kind(0d0))*pi), cmplx_size) + Nfq = min(floor(2d0*real(i, wp)*pi), cmplx_size) !$acc update device(Nfq) !$acc parallel loop collapse(3) gang vector default(present) @@ -265,7 +265,7 @@ contains do k = 1, sys_size do j = 0, m do l = 0, p - data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size)/real(real_size, kind(0d0)) + data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size)/real(real_size, wp) q_cons_vf(k)%sf(j, i, l) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) end do end do @@ -282,14 +282,14 @@ contains call fftw_execute_dft_r2c(fwd_plan, data_real, data_cmplx) data_fltr_cmplx(1:Nfq) = data_cmplx(1:Nfq) call fftw_execute_dft_c2r(bwd_plan, data_fltr_cmplx, data_real) - data_real(:) = data_real(:)/real(real_size, kind(0d0)) + data_real(:) = data_real(:)/real(real_size, wp) q_cons_vf(k)%sf(j, 0, 0:p) = data_real(1:p + 1) end do end do ! Apply Fourier filter to additional rings do i = 1, fourier_rings - Nfq = min(floor(2d0*real(i, kind(0d0))*pi), cmplx_size) + Nfq = min(floor(2d0*real(i, wp)*pi), cmplx_size) do j = 0, m do k = 1, sys_size data_fltr_cmplx(:) = (0d0, 0d0) @@ -297,7 +297,7 @@ contains call fftw_execute_dft_r2c(fwd_plan, data_real, data_cmplx) data_fltr_cmplx(1:Nfq) = data_cmplx(1:Nfq) call fftw_execute_dft_c2r(bwd_plan, data_fltr_cmplx, data_real) - data_real(:) = data_real(:)/real(real_size, kind(0d0)) + data_real(:) = data_real(:)/real(real_size, wp) q_cons_vf(k)%sf(j, i, 0:p) = data_real(1:p + 1) end do end do diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index fda004d798..41a1ed06dc 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -30,7 +30,7 @@ module m_global_parameters implicit none - real(kind(0d0)) :: time = 0 + real(wp) :: time = 0 ! Logistics ================================================================ integer :: num_procs !< Number of processors @@ -62,18 +62,18 @@ module m_global_parameters !> @name Cell-boundary (CB) locations in the x-, y- and z-directions, respectively !> @{ #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), x_cb, y_cb, z_cb) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), x_cb, y_cb, z_cb) #else - real(kind(0d0)), target, allocatable, dimension(:) :: x_cb, y_cb, z_cb + real(wp), target, allocatable, dimension(:) :: x_cb, y_cb, z_cb #endif !> @} !> @name Cell-center (CC) locations in the x-, y- and z-directions, respectively !> @{ #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), x_cc, y_cc, z_cc) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), x_cc, y_cc, z_cc) #else - real(kind(0d0)), target, allocatable, dimension(:) :: x_cc, y_cc, z_cc + real(wp), target, allocatable, dimension(:) :: x_cc, y_cc, z_cc #endif !> @} !type(bounds_info) :: x_domain, y_domain, z_domain !< @@ -81,13 +81,13 @@ module m_global_parameters !> @name Cell-width distributions in the x-, y- and z-directions, respectively !> @{ #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), dx, dy, dz) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), dx, dy, dz) #else - real(kind(0d0)), target, allocatable, dimension(:) :: dx, dy, dz + real(wp), target, allocatable, dimension(:) :: dx, dy, dz #endif !> @} - real(kind(0d0)) :: dt !< Size of the time-step + real(wp) :: dt !< Size of the time-step #ifdef CRAY_ACC_WAR !$acc declare link(x_cb, y_cb, z_cb, x_cc, y_cc, z_cc, dx, dy, dz) @@ -104,7 +104,7 @@ module m_global_parameters !> @name Starting time, stopping time, and time between backups, simulation time, !! and prescribed cfl respectively !> @{ - real(kind(0d0)) :: t_stop, t_save, cfl_target + real(wp) :: t_stop, t_save, cfl_target integer :: n_start !> @} !$acc declare create(cfl_target) @@ -144,8 +144,8 @@ module m_global_parameters logical :: teno !< TENO (Targeted ENO) #:endif - real(kind(0d0)) :: weno_eps !< Binding for the WENO nonlinear weights - real(kind(0d0)) :: teno_CT !< Smoothness threshold for TENO + real(wp) :: weno_eps !< Binding for the WENO nonlinear weights + real(wp) :: teno_CT !< Smoothness threshold for TENO logical :: mp_weno !< Monotonicity preserving (MP) WENO logical :: weno_avg ! Average left/right cell-boundary states logical :: weno_Re_flux !< WENO reconstruct velocity gradients for viscous stress tensor @@ -165,10 +165,10 @@ 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(kind(0d0)) :: ${param}$_${dir}$ + real(wp) :: ${param}$_${dir}$ #:endfor #:endfor - real(kind(0d0)), dimension(3) :: accel_bf + real(wp), dimension(3) :: accel_bf !$acc declare create(accel_bf) integer :: cpu_start, cpu_end, cpu_rate @@ -181,8 +181,8 @@ module m_global_parameters logical :: relax !< activate phase change integer :: relax_model !< Relaxation model - real(kind(0d0)) :: palpha_eps !< trigger parameter for the p relaxation procedure, phase change model - real(kind(0d0)) :: ptgalpha_eps !< trigger parameter for the pTg relaxation procedure, phase change model + real(wp) :: palpha_eps !< trigger parameter for the p relaxation procedure, phase change model + real(wp) :: ptgalpha_eps !< trigger parameter for the pTg relaxation procedure, phase change model !#ifndef _CRAYFTN !$acc declare create(relax, relax_model, palpha_eps,ptgalpha_eps) @@ -262,7 +262,7 @@ module m_global_parameters ! values or simply, the unaltered left and right, WENO-reconstructed, cell- ! boundary values. !> @{ - real(kind(0d0)) :: wa_flg + real(wp) :: wa_flg !> @{ !$acc declare create(wa_flg) @@ -273,7 +273,7 @@ module m_global_parameters !! the dimensionally split system of equations. !> @{ integer, dimension(3) :: dir_idx - real(kind(0d0)), dimension(3) :: dir_flg + real(wp), dimension(3) :: dir_flg integer, dimension(3) :: dir_idx_tau !!used for hypoelasticity=true !> @} @@ -322,7 +322,7 @@ module m_global_parameters !> @name Reference density and pressure for Tait EOS !> @{ - real(kind(0d0)) :: rhoref, pref + real(wp) :: rhoref, pref !> @} !$acc declare create(rhoref, pref) @@ -351,19 +351,19 @@ module m_global_parameters integer :: nb !< Number of eq. bubble sizes #:endif - real(kind(0d0)) :: R0ref !< Reference bubble size - real(kind(0d0)) :: Ca !< Cavitation number - real(kind(0d0)) :: Web !< Weber number - real(kind(0d0)) :: Re_inv !< Inverse Reynolds number + real(wp) :: R0ref !< Reference bubble size + real(wp) :: Ca !< Cavitation number + real(wp) :: Web !< Weber number + real(wp) :: Re_inv !< Inverse Reynolds number #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), weight) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), R0) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), V0) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), weight) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), R0) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), V0) !$acc declare link(weight, R0, V0) #else - real(kind(0d0)), dimension(:), allocatable :: weight !< Simpson quadrature weights - real(kind(0d0)), dimension(:), allocatable :: R0 !< Bubble sizes - real(kind(0d0)), dimension(:), allocatable :: V0 !< Bubble velocities + real(wp), dimension(:), allocatable :: weight !< Simpson quadrature weights + real(wp), dimension(:), allocatable :: R0 !< Bubble sizes + real(wp), dimension(:), allocatable :: V0 !< Bubble velocities !$acc declare create(weight, R0, V0) #endif logical :: bubbles !< Bubbles on/off @@ -375,13 +375,13 @@ module m_global_parameters integer :: bubble_model !< Gilmore or Keller--Miksis bubble model integer :: thermal !< Thermal behavior. 1 = adiabatic, 2 = isotherm, 3 = transfer #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), ptil) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), ptil) !$acc declare link(ptil) #else - real(kind(0d0)), allocatable, dimension(:, :, :) :: ptil !< Pressure modification + real(wp), allocatable, dimension(:, :, :) :: ptil !< Pressure modification !$acc declare create(ptil) #endif - real(kind(0d0)) :: poly_sigma !< log normal sigma for polydisperse PDF + real(wp) :: poly_sigma !< log normal sigma for polydisperse PDF logical :: qbmm !< Quadrature moment method integer, parameter :: nmom = 6 !< Number of carried moments per R0 location @@ -389,7 +389,7 @@ module m_global_parameters integer :: nmomtot !< Total number of carried moments moments/transport equations integer :: R0_type - real(kind(0d0)) :: pi_fac !< Factor for artificial pi_inf + real(wp) :: pi_fac !< Factor for artificial pi_inf #:if not MFC_CASE_OPTIMIZATION !$acc declare create(nb) @@ -413,20 +413,20 @@ module m_global_parameters !> @name Physical bubble parameters (see Ando 2010, Preston 2007) !> @{ - real(kind(0d0)) :: R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v + real(wp) :: R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v !$acc declare create(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v) #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), k_n, k_v, pb0, mass_n0, mass_v0, Pe_T) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), k_n, k_v, pb0, mass_n0, mass_v0, Pe_T) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN) !$acc declare link( k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN) #else - real(kind(0d0)), dimension(:), allocatable :: k_n, k_v, pb0, mass_n0, mass_v0, Pe_T - real(kind(0d0)), dimension(:), allocatable :: Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN + real(wp), dimension(:), allocatable :: k_n, k_v, pb0, mass_n0, mass_v0, Pe_T + real(wp), dimension(:), allocatable :: Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN !$acc declare create( k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN) #endif - real(kind(0d0)) :: mul0, ss, gamma_v, mu_v - real(kind(0d0)) :: gamma_m, gamma_n, mu_n - real(kind(0d0)) :: gam + real(wp) :: mul0, ss, gamma_v, mu_v + real(wp) :: gamma_m, gamma_n, mu_n + real(wp) :: gam !> @} !$acc declare create(mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam) @@ -441,7 +441,7 @@ module m_global_parameters !> @name Surface tension parameters !> @{ - real(kind(0d0)) :: sigma + real(wp) :: sigma !$acc declare create(sigma) !> @} @@ -457,15 +457,15 @@ module m_global_parameters !$acc declare create(momxb, momxe, advxb, advxe, contxb, contxe, intxb, intxe, bubxb, bubxe, strxb, strxe, chemxb, chemxe, tempxb, tempxe) #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps) !$acc declare link(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps) #else - real(kind(0d0)), allocatable, dimension(:) :: gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps + real(wp), allocatable, dimension(:) :: gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps !$acc declare create(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps) #endif - real(kind(0d0)) :: mytime !< Current simulation time - real(kind(0d0)) :: finaltime !< Final simulation time + real(wp) :: mytime !< Current simulation time + real(wp) :: finaltime !< Final simulation time logical :: weno_flat, riemann_flat, rdma_mpi diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index e3bb7ec08f..96548b6934 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -23,26 +23,26 @@ module m_hypoelastic s_compute_hypoelastic_rhs #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), Gs) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), Gs) !$acc declare link(Gs) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), du_dx, du_dy, du_dz) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), dv_dx, dv_dy, dv_dz) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), dw_dx, dw_dy, dw_dz) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), du_dx, du_dy, du_dz) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), dv_dx, dv_dy, dv_dz) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), dw_dx, dw_dy, dw_dz) !$acc declare link(du_dx,du_dy,du_dz,dv_dx,dv_dy,dv_dz,dw_dx,dw_dy,dw_dz) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), rho_K_field, G_K_field) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), rho_K_field, G_K_field) !$acc declare link(rho_K_field, G_K_field) #else - real(kind(0d0)), allocatable, dimension(:) :: Gs + real(wp), allocatable, dimension(:) :: Gs !$acc declare create(Gs) - real(kind(0d0)), allocatable, dimension(:, :, :) :: du_dx, du_dy, du_dz - real(kind(0d0)), allocatable, dimension(:, :, :) :: dv_dx, dv_dy, dv_dz - real(kind(0d0)), allocatable, dimension(:, :, :) :: dw_dx, dw_dy, dw_dz + real(wp), allocatable, dimension(:, :, :) :: du_dx, du_dy, du_dz + real(wp), allocatable, dimension(:, :, :) :: dv_dx, dv_dy, dv_dz + real(wp), allocatable, dimension(:, :, :) :: dw_dx, dw_dy, dw_dz !$acc declare create(du_dx,du_dy,du_dz,dv_dx,dv_dy,dv_dz,dw_dx,dw_dy,dw_dz) - real(kind(0d0)), allocatable, dimension(:, :, :) :: rho_K_field, G_K_field + real(wp), allocatable, dimension(:, :, :) :: rho_K_field, G_K_field !$acc declare create(rho_K_field, G_K_field) #endif @@ -82,7 +82,7 @@ contains type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf - real(kind(0d0)) :: rho_K, G_K + real(wp) :: rho_K, G_K integer :: i, k, l, q !< Loop variables integer :: ndirs !< Number of coordinate directions diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index a0fa597297..2e1985c501 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -40,8 +40,8 @@ module m_ibm !$acc declare create(ib_markers) #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), levelset) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :, :), levelset_norm) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), levelset) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :, :), levelset_norm) @:CRAY_DECLARE_GLOBAL(type(ghost_point), dimension(:), ghost_points) @:CRAY_DECLARE_GLOBAL(type(ghost_point), dimension(:), inner_points) @@ -49,9 +49,9 @@ module m_ibm #else !! Marker for solid cells. 0 if liquid, the patch id of its IB if solid - real(kind(0d0)), dimension(:, :, :, :), allocatable :: levelset + real(wp), dimension(:, :, :, :), allocatable :: levelset !! Matrix of distance to IB - real(kind(0d0)), dimension(:, :, :, :, :), allocatable :: levelset_norm + real(wp), dimension(:, :, :, :, :), allocatable :: levelset_norm !! Matrix of normal vector to IB type(ghost_point), dimension(:), allocatable :: ghost_points type(ghost_point), dimension(:), allocatable :: inner_points @@ -135,31 +135,31 @@ contains dimension(sys_size), & intent(inout) :: q_prim_vf !< Primitive Variables - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), optional, intent(inout) :: pb, mv + real(wp), dimension(startx:, starty:, startz:, 1:, 1:), optional, intent(inout) :: pb, mv integer :: i, j, k, l, q, r!< Iterator variables integer :: patch_id !< Patch ID of ghost point - real(kind(0d0)) :: rho, gamma, pi_inf, dyn_pres !< Mixture variables - real(kind(0d0)), dimension(2) :: Re_K - real(kind(0d0)) :: G_K - real(kind(0d0)) :: qv_K - real(kind(0d0)), dimension(num_fluids) :: Gs - - real(kind(0d0)) :: pres_IP, coeff - real(kind(0d0)), dimension(3) :: vel_IP, vel_norm_IP - real(kind(0d0)), dimension(num_fluids) :: alpha_rho_IP, alpha_IP - real(kind(0d0)), dimension(nb) :: r_IP, v_IP, pb_IP, mv_IP - real(kind(0d0)), dimension(nb*nmom) :: nmom_IP - real(kind(0d0)), dimension(nb*nnode) :: presb_IP, massv_IP + real(wp) :: rho, gamma, pi_inf, dyn_pres !< Mixture variables + real(wp), dimension(2) :: Re_K + real(wp) :: G_K + real(wp) :: qv_K + real(wp), dimension(num_fluids) :: Gs + + real(wp) :: pres_IP, coeff + real(wp), dimension(3) :: vel_IP, vel_norm_IP + real(wp), dimension(num_fluids) :: alpha_rho_IP, alpha_IP + real(wp), dimension(nb) :: r_IP, v_IP, pb_IP, mv_IP + real(wp), dimension(nb*nmom) :: nmom_IP + real(wp), dimension(nb*nnode) :: presb_IP, massv_IP !! Primitive variables at the image point associated with a ghost point, !! interpolated from surrounding fluid cells. - real(kind(0d0)), dimension(3) :: norm !< Normal vector from GP to IP - real(kind(0d0)), dimension(3) :: physical_loc !< Physical loc of GP - real(kind(0d0)), dimension(3) :: vel_g !< Velocity of GP + real(wp), dimension(3) :: norm !< Normal vector from GP to IP + real(wp), dimension(3) :: physical_loc !< Physical loc of GP + real(wp), dimension(3) :: vel_g !< Velocity of GP - real(kind(0d0)) :: nbub - real(kind(0d0)) :: buf + real(wp) :: nbub + real(wp) :: buf type(ghost_point) :: gp type(ghost_point) :: innerp @@ -340,14 +340,14 @@ contains subroutine s_compute_image_points(ghost_points, levelset, levelset_norm) type(ghost_point), dimension(num_gps), intent(inout) :: ghost_points - real(kind(0d0)), dimension(0:m, 0:n, 0:p, num_ibs), intent(in) :: levelset - real(kind(0d0)), dimension(0:m, 0:n, 0:p, num_ibs, 3), intent(in) :: levelset_norm - - real(kind(0d0)) :: dist - real(kind(0d0)), dimension(3) :: norm - real(kind(0d0)), dimension(3) :: physical_loc - real(kind(0d0)) :: temp_loc - real(kind(0d0)), pointer, dimension(:) :: s_cc => null() + real(wp), dimension(0:m, 0:n, 0:p, num_ibs), intent(in) :: levelset + real(wp), dimension(0:m, 0:n, 0:p, num_ibs, 3), intent(in) :: levelset_norm + + real(wp) :: dist + real(wp), dimension(3) :: norm + real(wp), dimension(3) :: physical_loc + real(wp) :: temp_loc + real(wp), pointer, dimension(:) :: s_cc => null() integer :: bound type(ghost_point) :: gp @@ -645,11 +645,11 @@ contains type(ghost_point), dimension(num_gps), intent(inout) :: ghost_points - real(kind(0d0)), dimension(2, 2, 2) :: dist - real(kind(0d0)), dimension(2, 2, 2) :: alpha - real(kind(0d0)), dimension(2, 2, 2) :: interp_coeffs - real(kind(0d0)) :: buf - real(kind(0d0)), dimension(2, 2, 2) :: eta + real(wp), dimension(2, 2, 2) :: dist + real(wp), dimension(2, 2, 2) :: alpha + real(wp), dimension(2, 2, 2) :: interp_coeffs + real(wp) :: buf + real(wp), dimension(2, 2, 2) :: eta type(ghost_point) :: gp integer :: i, j, k, l, q !< Iterator variables integer :: i1, i2, j1, j2, k1, k2 !< Grid indexes @@ -797,17 +797,17 @@ contains !$acc routine seq type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf !< Primitive Variables type(ghost_point), intent(in) :: gp - real(kind(0d0)), dimension(num_fluids), intent(inout) :: alpha_IP, alpha_rho_IP - real(kind(0d0)), intent(inout) :: pres_IP - real(kind(0d0)), dimension(3), intent(inout) :: vel_IP - real(kind(0d0)), optional, dimension(:), intent(inout) :: r_IP, v_IP, pb_IP, mv_IP - real(kind(0d0)), optional, dimension(:), intent(inout) :: nmom_IP - real(kind(0d0)), optional, dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv - real(kind(0d0)), optional, dimension(:), intent(inout) :: presb_IP, massv_IP + real(wp), dimension(num_fluids), intent(inout) :: alpha_IP, alpha_rho_IP + real(wp), intent(inout) :: pres_IP + real(wp), dimension(3), intent(inout) :: vel_IP + real(wp), optional, dimension(:), intent(inout) :: r_IP, v_IP, pb_IP, mv_IP + real(wp), optional, dimension(:), intent(inout) :: nmom_IP + real(wp), optional, dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv + real(wp), optional, dimension(:), intent(inout) :: presb_IP, massv_IP integer :: i, j, k, l, q !< Iterator variables integer :: i1, i2, j1, j2, k1, k2 !< Iterator variables - real(kind(0d0)) :: coeff + real(wp) :: coeff i1 = gp%ip_grid(1); i2 = i1 + 1 j1 = gp%ip_grid(2); j2 = j1 + 1 @@ -905,8 +905,8 @@ contains !> Subroutine that computes that bubble wall pressure for Gilmore bubbles subroutine s_compute_levelset(levelset, levelset_norm) - real(kind(0d0)), dimension(0:m, 0:n, 0:p, num_ibs), intent(inout) :: levelset - real(kind(0d0)), dimension(0:m, 0:n, 0:p, num_ibs, 3), intent(inout) :: levelset_norm + real(wp), dimension(0:m, 0:n, 0:p, num_ibs), intent(inout) :: levelset + real(wp), dimension(0:m, 0:n, 0:p, num_ibs, 3), intent(inout) :: levelset_norm integer :: i !< Iterator variables integer :: geometry diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index b3d7d53a29..256903c9d4 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -33,32 +33,32 @@ module m_mpi_proxy implicit none #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), q_cons_buff_send) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), q_cons_buff_recv) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), q_cons_buff_send) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), q_cons_buff_recv) @:CRAY_DECLARE_GLOBAL(integer, dimension(:), ib_buff_send) @:CRAY_DECLARE_GLOBAL(integer, dimension(:), ib_buff_recv) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), c_divs_buff_send) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), c_divs_buff_recv) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), c_divs_buff_send) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), c_divs_buff_recv) !$acc declare link(q_cons_buff_recv, q_cons_buff_send) !$acc declare link(ib_buff_send, ib_buff_recv) !$acc declare link(c_divs_buff_send, c_divs_buff_recv) #else - real(kind(0d0)), private, allocatable, dimension(:), target :: q_cons_buff_send !< + real(wp), private, allocatable, dimension(:), target :: q_cons_buff_send !< !! This variable is utilized to pack and send the buffer of the cell-average !! conservative variables, for a single computational domain boundary at the !! time, to the relevant neighboring processor. - real(kind(0d0)), private, allocatable, dimension(:), target :: q_cons_buff_recv !< + real(wp), private, allocatable, dimension(:), target :: q_cons_buff_recv !< !! q_cons_buff_recv is utilized to receive and unpack the buffer of the cell- !! average conservative variables, for a single computational domain boundary !! at the time, from the relevant neighboring processor. - real(kind(0d0)), private, allocatable, dimension(:), target :: c_divs_buff_send !< + real(wp), private, allocatable, dimension(:), target :: c_divs_buff_send !< !! c_divs_buff_send is utilized to send and unpack the buffer of the cell- !! centered color function derivatives, for a single computational domain !! boundary at the time, to the the relevant neighboring processor - real(kind(0d0)), private, allocatable, dimension(:), target :: c_divs_buff_recv + real(wp), private, allocatable, dimension(:), target :: c_divs_buff_recv !! c_divs_buff_recv is utilized to receiver and unpack the buffer of the cell- !! centered color function derivatives, for a single computational domain !! boundary at the time, from the relevant neighboring processor @@ -292,10 +292,10 @@ contains integer :: num_procs_x, num_procs_y, num_procs_z !< !! Optimal number of processors in the x-, y- and z-directions - real(kind(0d0)) :: tmp_num_procs_x, tmp_num_procs_y, tmp_num_procs_z !< + real(wp) :: tmp_num_procs_x, tmp_num_procs_y, tmp_num_procs_z !< !! Non-optimal number of processors in the x-, y- and z-directions - real(kind(0d0)) :: fct_min !< + real(wp) :: fct_min !< !! Processor factorization (fct) minimization parameter integer :: MPI_COMM_CART !< @@ -852,7 +852,7 @@ contains pbc_loc) type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv + real(wp), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, mv integer, intent(in) :: mpi_dir, pbc_loc integer :: i, j, k, l, r, q !< Generic loop iterators @@ -867,7 +867,7 @@ contains integer :: pack_offsets(1:3), unpack_offsets(1:3) integer :: pack_offset, unpack_offset - real(kind(0d0)), pointer :: p_send, p_recv + real(wp), pointer :: p_send, p_recv integer, pointer, dimension(:) :: p_i_send, p_i_recv #ifdef MFC_MPI @@ -2132,7 +2132,7 @@ contains integer :: pack_offsets(1:3), unpack_offsets(1:3) integer :: pack_offset, unpack_offset - real(kind(0d0)), pointer :: p_send, p_recv + real(wp), pointer :: p_send, p_recv #ifdef MFC_MPI diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp index c478495a56..4bc8beb30f 100644 --- a/src/simulation/m_qbmm.fpp +++ b/src/simulation/m_qbmm.fpp @@ -29,10 +29,10 @@ module m_qbmm private; public :: s_initialize_qbmm_module, s_mom_inv, s_coeff, s_compute_qbmm_rhs #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :, :), momrhs) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :, :), momrhs) !$acc declare link(momrhs) #else - real(kind(0d0)), allocatable, dimension(:, :, :, :, :) :: momrhs + real(wp), allocatable, dimension(:, :, :, :, :) :: momrhs !$acc declare create(momrhs) #endif #:if MFC_CASE_OPTIMIZATION @@ -431,12 +431,12 @@ contains type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf, q_prim_vf type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf type(scalar_field), dimension(sys_size), intent(in) :: flux_n_vf - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, rhs_pb - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: mv, rhs_mv + real(wp), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, rhs_pb + real(wp), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: mv, rhs_mv integer :: i, j, k, l, q - real(kind(0d0)) :: nb_q, nb_dot, R, R2, nR, nR2, nR_dot, nR2_dot, var, AX + real(wp) :: nb_q, nb_dot, R, R2, nR, nR2, nR_dot, nR2_dot, var, AX if (idir == 1) then @@ -834,17 +834,17 @@ contains type(scalar_field), dimension(:), intent(inout) :: q_cons_vf, q_prim_vf type(scalar_field), dimension(:), intent(inout) :: momsp type(scalar_field), dimension(0:, 0:, :), intent(inout) :: moms3d - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, rhs_pb - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: mv, rhs_mv + real(wp), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, rhs_pb + real(wp), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: mv, rhs_mv type(int_bounds_info), intent(in) :: ix, iy, iz - real(kind(0d0)), dimension(startx:, starty:, startz:) :: nbub_sc !> Unused Variable not sure what to put as intent + real(wp), dimension(startx:, starty:, startz:) :: nbub_sc !> Unused Variable not sure what to put as intent - real(kind(0d0)), dimension(nmom) :: moms, msum - real(kind(0d0)), dimension(nnode, nb) :: wght, abscX, abscY, wght_pb, wght_mv, wght_ht, ht - real(kind(0d0)), dimension(nterms, 0:2, 0:2) :: mom3d_terms, coeff - real(kind(0d0)) :: pres, rho, nbub, c, alf, R3, momsum, drdt, drdt2, chi_vw, x_vw, rho_mw, k_mw, T_bar, grad_T - real(kind(0d0)) :: start, finish - real(kind(0d0)) :: n_tait, B_tait + real(wp), dimension(nmom) :: moms, msum + real(wp), dimension(nnode, nb) :: wght, abscX, abscY, wght_pb, wght_mv, wght_ht, ht + real(wp), dimension(nterms, 0:2, 0:2) :: mom3d_terms, coeff + real(wp) :: pres, rho, nbub, c, alf, R3, momsum, drdt, drdt2, chi_vw, x_vw, rho_mw, k_mw, T_bar, grad_T + real(wp) :: start, finish + real(wp) :: n_tait, B_tait integer :: j, k, l, q, r, s !< Loop variables integer :: id1, id2, id3 @@ -1051,14 +1051,14 @@ contains #else !$acc routine seq #endif - real(kind(0d0)), dimension(nmom), intent(in) :: momin - real(kind(0d0)), dimension(nnode), intent(inout) :: wght, abscX, abscY + real(wp), dimension(nmom), intent(in) :: momin + real(wp), dimension(nnode), intent(inout) :: wght, abscX, abscY - real(kind(0d0)), dimension(0:2, 0:2) :: moms - real(kind(0d0)), dimension(3) :: M1, M3 - real(kind(0d0)), dimension(2) :: myrho, myrho3, up, up3, Vf - real(kind(0d0)) :: bu, bv, d20, d11, d02, c20, c11, c02 - real(kind(0d0)) :: mu2avg, mu2, vp21, vp22, rho21, rho22 + real(wp), dimension(0:2, 0:2) :: moms + real(wp), dimension(3) :: M1, M3 + real(wp), dimension(2) :: myrho, myrho3, up, up3, Vf + real(wp) :: bu, bv, d20, d11, d02, c20, c11, c02 + real(wp) :: mu2avg, mu2, vp21, vp22, rho21, rho22 moms(0, 0) = momin(1) moms(1, 0) = momin(2) @@ -1118,10 +1118,10 @@ contains #else !$acc routine seq #endif - real(kind(0d0)), dimension(2), intent(inout) :: frho, fup - real(kind(0d0)), dimension(3), intent(in) :: fmom + real(wp), dimension(2), intent(inout) :: frho, fup + real(wp), dimension(3), intent(in) :: fmom - real(kind(0d0)) :: bu, d2, c2 + real(wp) :: bu, d2, c2 bu = fmom(2)/fmom(1) d2 = fmom(3)/fmom(1) diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 2c8b99b5e9..e56bef26fb 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -186,43 +186,43 @@ module m_rhs #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), blkmod1, blkmod2, alpha1, alpha2, Kterm) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, qR_rsx_vf, qR_rsy_vf, qR_rsz_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), dqL_rsx_vf, dqL_rsy_vf, dqL_rsz_vf, dqR_rsx_vf, dqR_rsy_vf, dqR_rsz_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), blkmod1, blkmod2, alpha1, alpha2, Kterm) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, qR_rsx_vf, qR_rsy_vf, qR_rsz_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), dqL_rsx_vf, dqL_rsy_vf, dqL_rsz_vf, dqR_rsx_vf, dqR_rsy_vf, dqR_rsz_vf) !$acc declare link(blkmod1, blkmod2, alpha1, alpha2, Kterm) !$acc declare link(qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, qR_rsx_vf, qR_rsy_vf, qR_rsz_vf) !$acc declare link(dqL_rsx_vf, dqL_rsy_vf, dqL_rsz_vf, dqR_rsx_vf, dqR_rsy_vf, dqR_rsz_vf) #else - real(kind(0d0)), allocatable, dimension(:, :, :) :: blkmod1, blkmod2, alpha1, alpha2, Kterm - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, qR_rsx_vf, qR_rsy_vf, qR_rsz_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: dqL_rsx_vf, dqL_rsy_vf, dqL_rsz_vf, dqR_rsx_vf, dqR_rsy_vf, dqR_rsz_vf + real(wp), allocatable, dimension(:, :, :) :: blkmod1, blkmod2, alpha1, alpha2, Kterm + real(wp), allocatable, dimension(:, :, :, :) :: qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, qR_rsx_vf, qR_rsy_vf, qR_rsz_vf + real(wp), allocatable, dimension(:, :, :, :) :: dqL_rsx_vf, dqL_rsy_vf, dqL_rsz_vf, dqR_rsx_vf, dqR_rsy_vf, dqR_rsz_vf !$acc declare create(blkmod1, blkmod2, alpha1, alpha2, Kterm) !$acc declare create(qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, qR_rsx_vf, qR_rsy_vf, qR_rsz_vf) !$acc declare create(dqL_rsx_vf, dqL_rsy_vf, dqL_rsz_vf, dqR_rsx_vf, dqR_rsy_vf, dqR_rsz_vf) #endif #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), gamma_min, pres_inf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), gamma_min, pres_inf) !$acc declare link(gamma_min, pres_inf) #else - real(kind(0d0)), allocatable, dimension(:) :: gamma_min, pres_inf + real(wp), allocatable, dimension(:) :: gamma_min, pres_inf !$acc declare create(gamma_min, pres_inf) #endif #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :), Res) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :), Res) !$acc declare link(Res) #else - real(kind(0d0)), allocatable, dimension(:, :) :: Res + real(wp), allocatable, dimension(:, :) :: Res !$acc declare create(Res) #endif #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), nbub) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), nbub) !$acc declare link(nbub) #else - real(kind(0d0)), allocatable, dimension(:, :, :) :: nbub !< Bubble number density + real(wp), allocatable, dimension(:, :, :) :: nbub !< Bubble number density !$acc declare create(nbub) #endif @@ -714,32 +714,32 @@ contains type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, rhs_pb - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: mv, rhs_mv + real(wp), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: pb, rhs_pb + real(wp), dimension(startx:, starty:, startz:, 1:, 1:), intent(inout) :: mv, rhs_mv integer, intent(in) :: t_step - real(kind(0d0)), intent(inout) :: time_avg + real(wp), intent(inout) :: time_avg - real(kind(0d0)) :: t_start, t_finish - real(kind(0d0)) :: gp_sum + real(wp) :: t_start, t_finish + real(wp) :: gp_sum - real(kind(0d0)) :: top, bottom !< Numerator and denominator when evaluating flux limiter function - real(kind(0d0)), dimension(num_fluids) :: myalpha_rho, myalpha + real(wp) :: top, bottom !< Numerator and denominator when evaluating flux limiter function + real(wp), dimension(num_fluids) :: myalpha_rho, myalpha - real(kind(0d0)) :: tmp1, tmp2, tmp3, tmp4, & + real(wp) :: tmp1, tmp2, tmp3, tmp4, & c_gas, c_liquid, & Cpbw, Cpinf, Cpinf_dot, & myH, myHdot, rddot, alf_gas - real(kind(0d0)) :: n_tait, B_tait, angle, angle_z + real(wp) :: n_tait, B_tait, angle, angle_z - real(kind(0d0)), dimension(nb) :: Rtmp, Vtmp - real(kind(0d0)) :: myR, myV, alf, myP, myRho, R2Vav - real(kind(0d0)), dimension(0:m, 0:n, 0:p) :: nbub + real(wp), dimension(nb) :: Rtmp, Vtmp + real(wp) :: myR, myV, alf, myP, myRho, R2Vav + real(wp), dimension(0:m, 0:n, 0:p) :: nbub integer :: ndirs - real(kind(0d0)) :: sound - real(kind(0d0)) :: start, finish - real(kind(0d0)) :: s2, const_sos, s1 + real(wp) :: sound + real(wp) :: start, finish + real(wp) :: s2, const_sos, s1 integer :: i, c, j, k, l, q, ii, id !< Generic loop iterators integer :: term_index @@ -1897,19 +1897,19 @@ contains !! function, liquid stiffness function (two variations of the last two !! ones), shear and volume Reynolds numbers and the Weber numbers !> @{ - real(kind(0d0)) :: pres_relax - real(kind(0d0)), dimension(num_fluids) :: pres_K_init - real(kind(0d0)) :: f_pres - real(kind(0d0)) :: df_pres - real(kind(0d0)), dimension(num_fluids) :: rho_K_s - real(kind(0d0)), dimension(num_fluids) :: alpha_rho - real(kind(0d0)), dimension(num_fluids) :: alpha - real(kind(0d0)) :: sum_alpha - real(kind(0d0)) :: rho - real(kind(0d0)) :: dyn_pres - real(kind(0d0)) :: gamma - real(kind(0d0)) :: pi_inf - real(kind(0d0)), dimension(2) :: Re + real(wp) :: pres_relax + real(wp), dimension(num_fluids) :: pres_K_init + real(wp) :: f_pres + real(wp) :: df_pres + real(wp), dimension(num_fluids) :: rho_K_s + real(wp), dimension(num_fluids) :: alpha_rho + real(wp), dimension(num_fluids) :: alpha + real(wp) :: sum_alpha + real(wp) :: rho + real(wp) :: dyn_pres + real(wp) :: gamma + real(wp) :: pi_inf + real(wp), dimension(2) :: Re integer :: i, j, k, l, q, iter !< Generic loop iterators integer :: relax !< Relaxation procedure determination variable @@ -2147,8 +2147,8 @@ contains norm_dir) type(scalar_field), dimension(iv%beg:iv%end), intent(in) :: v_vf - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: vL_x, vL_y, vL_z - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: vR_x, vR_y, vR_z + real(wp), dimension(startx:, starty:, startz:, 1:), intent(inout) :: vL_x, vL_y, vL_z + real(wp), dimension(startx:, starty:, startz:, 1:), intent(inout) :: vR_x, vR_y, vR_z integer, intent(in) :: norm_dir integer :: weno_dir !< Coordinate direction of the WENO reconstruction @@ -2201,8 +2201,8 @@ contains norm_dir) type(scalar_field), dimension(iv%beg:iv%end), intent(in) :: v_vf - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: vL_x, vL_y, vL_z - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: vR_x, vR_y, vR_z + real(wp), dimension(startx:, starty:, startz:, 1:), intent(inout) :: vL_x, vL_y, vL_z + real(wp), dimension(startx:, starty:, startz:, 1:), intent(inout) :: vR_x, vR_y, vR_z integer, intent(in) :: norm_dir integer :: recon_dir !< Coordinate direction of the WENO reconstruction diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 0210882be8..bab2a74155 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -94,9 +94,9 @@ module m_riemann_solvers flux_gsrc_vf, & norm_dir, ix, iy, iz) - import :: scalar_field, int_bounds_info, sys_size, startx, starty, startz + import :: scalar_field, int_bounds_info, sys_size, startx, starty, startz, wp - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf + real(wp), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf @@ -161,15 +161,15 @@ module m_riemann_solvers !! dqK_prim_ds_vf where ds = dx, dy or dz. !> @{ #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsx_vf, flux_src_rsx_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsy_vf, flux_src_rsy_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_rsz_vf, flux_src_rsz_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), flux_rsx_vf, flux_src_rsx_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), flux_rsy_vf, flux_src_rsy_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), flux_rsz_vf, flux_src_rsz_vf) !$acc declare link( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) #else - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsx_vf, flux_src_rsx_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsy_vf, flux_src_rsy_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_rsz_vf, flux_src_rsz_vf + real(wp), allocatable, dimension(:, :, :, :) :: flux_rsx_vf, flux_src_rsx_vf + real(wp), allocatable, dimension(:, :, :, :) :: flux_rsy_vf, flux_src_rsy_vf + real(wp), allocatable, dimension(:, :, :, :) :: flux_rsz_vf, flux_src_rsz_vf !$acc declare create( flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, & !$acc flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf ) #endif @@ -180,14 +180,14 @@ module m_riemann_solvers !! states given in qK_prim_rs_vf. Currently 2D axisymmetric for inviscid only. !> @{ #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_gsrc_rsx_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_gsrc_rsy_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), flux_gsrc_rsz_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), flux_gsrc_rsx_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), flux_gsrc_rsy_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), flux_gsrc_rsz_vf) !$acc declare link( flux_gsrc_rsx_vf, flux_gsrc_rsy_vf, flux_gsrc_rsz_vf ) #else - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_gsrc_rsx_vf !< - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_gsrc_rsy_vf !< - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: flux_gsrc_rsz_vf !< + real(wp), allocatable, dimension(:, :, :, :) :: flux_gsrc_rsx_vf !< + real(wp), allocatable, dimension(:, :, :, :) :: flux_gsrc_rsy_vf !< + real(wp), allocatable, dimension(:, :, :, :) :: flux_gsrc_rsz_vf !< !$acc declare create( flux_gsrc_rsx_vf, flux_gsrc_rsy_vf, flux_gsrc_rsz_vf ) #endif !> @} @@ -195,38 +195,38 @@ module m_riemann_solvers ! The cell-boundary values of the velocity. vel_src_rs_vf is determined as ! part of Riemann problem solution and is used to evaluate the source flux. #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), vel_src_rsx_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), vel_src_rsy_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), vel_src_rsz_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), vel_src_rsx_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), vel_src_rsy_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), vel_src_rsz_vf) !$acc declare link(vel_src_rsx_vf, vel_src_rsy_vf, vel_src_rsz_vf) #else - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: vel_src_rsx_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: vel_src_rsy_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: vel_src_rsz_vf + real(wp), allocatable, dimension(:, :, :, :) :: vel_src_rsx_vf + real(wp), allocatable, dimension(:, :, :, :) :: vel_src_rsy_vf + real(wp), allocatable, dimension(:, :, :, :) :: vel_src_rsz_vf !$acc declare create(vel_src_rsx_vf, vel_src_rsy_vf, vel_src_rsz_vf) #endif #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), mom_sp_rsx_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), mom_sp_rsy_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), mom_sp_rsz_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), mom_sp_rsx_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), mom_sp_rsy_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), mom_sp_rsz_vf) !$acc declare link(mom_sp_rsx_vf, mom_sp_rsy_vf, mom_sp_rsz_vf) #else - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: mom_sp_rsx_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: mom_sp_rsy_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: mom_sp_rsz_vf + real(wp), allocatable, dimension(:, :, :, :) :: mom_sp_rsx_vf + real(wp), allocatable, dimension(:, :, :, :) :: mom_sp_rsy_vf + real(wp), allocatable, dimension(:, :, :, :) :: mom_sp_rsz_vf !$acc declare create(mom_sp_rsx_vf, mom_sp_rsy_vf, mom_sp_rsz_vf) #endif #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), Re_avg_rsx_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), Re_avg_rsy_vf) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), Re_avg_rsz_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), Re_avg_rsx_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), Re_avg_rsy_vf) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), Re_avg_rsz_vf) !$acc declare link(Re_avg_rsx_vf, Re_avg_rsy_vf, Re_avg_rsz_vf) #else - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: Re_avg_rsx_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: Re_avg_rsy_vf - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: Re_avg_rsz_vf + real(wp), allocatable, dimension(:, :, :, :) :: Re_avg_rsx_vf + real(wp), allocatable, dimension(:, :, :, :) :: Re_avg_rsy_vf + real(wp), allocatable, dimension(:, :, :, :) :: Re_avg_rsz_vf !$acc declare link(Re_avg_rsx_vf, Re_avg_rsy_vf, Re_avg_rsz_vf) #endif @@ -249,18 +249,18 @@ module m_riemann_solvers !$acc declare create(is1, is2, is3, isx, isy, isz) #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), Gs) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), Gs) !$acc declare link(Gs) #else - real(kind(0d0)), allocatable, dimension(:) :: Gs + real(wp), allocatable, dimension(:) :: Gs !$acc declare create(Gs) #endif #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :), Res) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :), Res) !$acc declare link(Res) #else - real(kind(0d0)), allocatable, dimension(:, :) :: Res + real(wp), allocatable, dimension(:, :) :: Res !$acc declare create(Res) #endif @@ -279,7 +279,7 @@ contains flux_gsrc_vf, & norm_dir, ix, iy, iz) - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf + real(wp), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf @@ -298,39 +298,39 @@ contains integer, intent(in) :: norm_dir type(int_bounds_info), intent(in) :: ix, iy, iz - real(kind(0d0)), dimension(num_fluids) :: alpha_rho_L, alpha_rho_R - real(kind(0d0)) :: rho_L, rho_R - real(kind(0d0)), dimension(num_dims) :: vel_L, vel_R - real(kind(0d0)) :: pres_L, pres_R - real(kind(0d0)) :: E_L, E_R - real(kind(0d0)) :: H_L, H_R - real(kind(0d0)), dimension(num_fluids) :: alpha_L, alpha_R - real(kind(0d0)) :: Y_L, Y_R - real(kind(0d0)) :: gamma_L, gamma_R - real(kind(0d0)) :: pi_inf_L, pi_inf_R - real(kind(0d0)) :: qv_L, qv_R - real(kind(0d0)) :: c_L, c_R - real(kind(0d0)), dimension(6) :: tau_e_L, tau_e_R - real(kind(0d0)) :: G_L, G_R - real(kind(0d0)), dimension(2) :: Re_L, Re_R - - real(kind(0d0)) :: rho_avg - real(kind(0d0)), dimension(num_dims) :: vel_avg - real(kind(0d0)) :: H_avg - real(kind(0d0)) :: gamma_avg - real(kind(0d0)) :: c_avg - - real(kind(0d0)) :: s_L, s_R, s_M, s_P, s_S - real(kind(0d0)) :: xi_L, xi_R !< Left and right wave speeds functions - real(kind(0d0)) :: xi_M, xi_P - - real(kind(0d0)) :: nbub_L, nbub_R - real(kind(0d0)) :: ptilde_L, ptilde_R - real(kind(0d0)) :: vel_L_rms, vel_R_rms, vel_avg_rms - real(kind(0d0)) :: blkmod1, blkmod2 - real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star - real(kind(0d0)) :: Ms_L, Ms_R, pres_SL, pres_SR - real(kind(0d0)) :: alpha_L_sum, alpha_R_sum + real(wp), dimension(num_fluids) :: alpha_rho_L, alpha_rho_R + real(wp) :: rho_L, rho_R + real(wp), dimension(num_dims) :: vel_L, vel_R + real(wp) :: pres_L, pres_R + real(wp) :: E_L, E_R + real(wp) :: H_L, H_R + real(wp), dimension(num_fluids) :: alpha_L, alpha_R + real(wp) :: Y_L, Y_R + real(wp) :: gamma_L, gamma_R + real(wp) :: pi_inf_L, pi_inf_R + real(wp) :: qv_L, qv_R + real(wp) :: c_L, c_R + real(wp), dimension(6) :: tau_e_L, tau_e_R + real(wp) :: G_L, G_R + real(wp), dimension(2) :: Re_L, Re_R + + real(wp) :: rho_avg + real(wp), dimension(num_dims) :: vel_avg + real(wp) :: H_avg + real(wp) :: gamma_avg + real(wp) :: c_avg + + real(wp) :: s_L, s_R, s_M, s_P, s_S + real(wp) :: xi_L, xi_R !< Left and right wave speeds functions + real(wp) :: xi_M, xi_P + + real(wp) :: nbub_L, nbub_R + real(wp) :: ptilde_L, ptilde_R + real(wp) :: vel_L_rms, vel_R_rms, vel_avg_rms + real(wp) :: blkmod1, blkmod2 + real(wp) :: rho_Star, E_Star, p_Star, p_K_Star + real(wp) :: Ms_L, Ms_R, pres_SL, pres_SR + real(wp) :: alpha_L_sum, alpha_R_sum integer :: i, j, k, l, q !< Generic loop iterators @@ -834,7 +834,7 @@ contains flux_gsrc_vf, & norm_dir, ix, iy, iz) - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf + real(wp), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf type(scalar_field), allocatable, dimension(:), intent(inout) :: qL_prim_vf, qR_prim_vf @@ -853,51 +853,51 @@ contains integer, intent(in) :: norm_dir type(int_bounds_info), intent(in) :: ix, iy, iz - real(kind(0d0)), dimension(num_fluids) :: alpha_rho_L, alpha_rho_R - real(kind(0d0)) :: rho_L, rho_R - real(kind(0d0)), dimension(num_dims) :: vel_L, vel_R - real(kind(0d0)) :: pres_L, pres_R - real(kind(0d0)) :: E_L, E_R - real(kind(0d0)) :: H_L, H_R - real(kind(0d0)), dimension(num_fluids) :: alpha_L, alpha_R - real(kind(0d0)) :: Y_L, Y_R - real(kind(0d0)) :: gamma_L, gamma_R - real(kind(0d0)) :: pi_inf_L, pi_inf_R - real(kind(0d0)) :: qv_L, qv_R - real(kind(0d0)) :: c_L, c_R - real(kind(0d0)), dimension(2) :: Re_L, Re_R - - real(kind(0d0)) :: rho_avg - real(kind(0d0)), dimension(num_dims) :: vel_avg - real(kind(0d0)) :: H_avg - real(kind(0d0)) :: gamma_avg - real(kind(0d0)) :: c_avg - - real(kind(0d0)) :: s_L, s_R, s_M, s_P, s_S - real(kind(0d0)) :: xi_L, xi_R !< Left and right wave speeds functions - real(kind(0d0)) :: xi_M, xi_P - - real(kind(0d0)) :: nbub_L, nbub_R - real(kind(0d0)), dimension(nb) :: R0_L, R0_R - real(kind(0d0)), dimension(nb) :: V0_L, V0_R - real(kind(0d0)), dimension(nb) :: P0_L, P0_R - real(kind(0d0)), dimension(nb) :: pbw_L, pbw_R - real(kind(0d0)), dimension(nb, nmom) :: moms_L, moms_R - real(kind(0d0)) :: ptilde_L, ptilde_R - - real(kind(0d0)) :: alpha_L_sum, alpha_R_sum, nbub_L_denom, nbub_R_denom - - real(kind(0d0)) :: PbwR3Lbar, Pbwr3Rbar - real(kind(0d0)) :: R3Lbar, R3Rbar - real(kind(0d0)) :: R3V2Lbar, R3V2Rbar - - real(kind(0d0)) :: vel_L_rms, vel_R_rms, vel_avg_rms - real(kind(0d0)) :: vel_L_tmp, vel_R_tmp - real(kind(0d0)) :: blkmod1, blkmod2 - real(kind(0d0)) :: rho_Star, E_Star, p_Star, p_K_Star - real(kind(0d0)) :: pres_SL, pres_SR, Ms_L, Ms_R - real(kind(0d0)) :: start, finish - real(kind(0d0)) :: zcoef, pcorr !< low Mach number correction + real(wp), dimension(num_fluids) :: alpha_rho_L, alpha_rho_R + real(wp) :: rho_L, rho_R + real(wp), dimension(num_dims) :: vel_L, vel_R + real(wp) :: pres_L, pres_R + real(wp) :: E_L, E_R + real(wp) :: H_L, H_R + real(wp), dimension(num_fluids) :: alpha_L, alpha_R + real(wp) :: Y_L, Y_R + real(wp) :: gamma_L, gamma_R + real(wp) :: pi_inf_L, pi_inf_R + real(wp) :: qv_L, qv_R + real(wp) :: c_L, c_R + real(wp), dimension(2) :: Re_L, Re_R + + real(wp) :: rho_avg + real(wp), dimension(num_dims) :: vel_avg + real(wp) :: H_avg + real(wp) :: gamma_avg + real(wp) :: c_avg + + real(wp) :: s_L, s_R, s_M, s_P, s_S + real(wp) :: xi_L, xi_R !< Left and right wave speeds functions + real(wp) :: xi_M, xi_P + + real(wp) :: nbub_L, nbub_R + real(wp), dimension(nb) :: R0_L, R0_R + real(wp), dimension(nb) :: V0_L, V0_R + real(wp), dimension(nb) :: P0_L, P0_R + real(wp), dimension(nb) :: pbw_L, pbw_R + real(wp), dimension(nb, nmom) :: moms_L, moms_R + real(wp) :: ptilde_L, ptilde_R + + real(wp) :: alpha_L_sum, alpha_R_sum, nbub_L_denom, nbub_R_denom + + real(wp) :: PbwR3Lbar, Pbwr3Rbar + real(wp) :: R3Lbar, R3Rbar + real(wp) :: R3V2Lbar, R3V2Rbar + + real(wp) :: vel_L_rms, vel_R_rms, vel_avg_rms + real(wp) :: vel_L_tmp, vel_R_tmp + real(wp) :: blkmod1, blkmod2 + real(wp) :: rho_Star, E_Star, p_Star, p_K_Star + real(wp) :: pres_SL, pres_SR, Ms_L, Ms_R + real(wp) :: start, finish + real(wp) :: zcoef, pcorr !< low Mach number correction integer :: i, j, k, l, q !< Generic loop iterators integer :: idx1, idxi @@ -2531,7 +2531,7 @@ contains qR_prim_vf, & norm_dir, ix, iy, iz) - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf + real(wp), dimension(startx:, starty:, startz:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf type(scalar_field), & allocatable, dimension(:), & @@ -3064,13 +3064,13 @@ contains ! Arithmetic mean of the left and right, WENO-reconstructed, cell- ! boundary values of cell-average first-order spatial derivatives ! of velocity - real(kind(0d0)), dimension(num_dims) :: avg_vel - real(kind(0d0)), dimension(num_dims) :: dvel_avg_dx - real(kind(0d0)), dimension(num_dims) :: dvel_avg_dy - real(kind(0d0)), dimension(num_dims) :: dvel_avg_dz + real(wp), dimension(num_dims) :: avg_vel + real(wp), dimension(num_dims) :: dvel_avg_dx + real(wp), dimension(num_dims) :: dvel_avg_dy + real(wp), dimension(num_dims) :: dvel_avg_dz ! Viscous stress tensor - real(kind(0d0)), dimension(num_dims, num_dims) :: tau_Re + real(wp), dimension(num_dims, num_dims) :: tau_Re ! Generic loop iterators integer :: i, j, k, l @@ -3590,11 +3590,11 @@ contains ! Arithmetic mean of the left and right, WENO-reconstructed, cell- ! boundary values of cell-average first-order spatial derivatives ! of velocity - real(kind(0d0)), dimension(num_dims) :: dvel_avg_dx - real(kind(0d0)), dimension(num_dims) :: dvel_avg_dy - real(kind(0d0)), dimension(num_dims) :: dvel_avg_dz + real(wp), dimension(num_dims) :: dvel_avg_dx + real(wp), dimension(num_dims) :: dvel_avg_dy + real(wp), dimension(num_dims) :: dvel_avg_dz - real(kind(0d0)), dimension(num_dims, num_dims) :: tau_Re !< Viscous stress tensor + real(wp), dimension(num_dims, num_dims) :: tau_Re !< Viscous stress tensor integer :: i, j, k, l !< Generic loop iterators diff --git a/src/simulation/m_sim_helpers.f90 b/src/simulation/m_sim_helpers.f90 index eca90a32e7..547ae128ad 100644 --- a/src/simulation/m_sim_helpers.f90 +++ b/src/simulation/m_sim_helpers.f90 @@ -33,11 +33,11 @@ module m_sim_helpers subroutine s_compute_enthalpy(q_prim_vf, pres, rho, gamma, pi_inf, Re, H, alpha, vel, vel_sum, j, k, l) !$acc routine seq type(scalar_field), dimension(sys_size) :: q_prim_vf - real(kind(0d0)), dimension(num_fluids) :: alpha_rho - real(kind(0d0)), dimension(num_fluids) :: alpha - real(kind(0d0)), dimension(num_dims) :: vel - real(kind(0d0)) :: rho, gamma, pi_inf, qv, vel_sum, E, H, pres - real(kind(0d0)), dimension(2) :: Re + real(wp), dimension(num_fluids) :: alpha_rho + real(wp), dimension(num_fluids) :: alpha + real(wp), dimension(num_dims) :: vel + real(wp) :: rho, gamma, pi_inf, qv, vel_sum, E, H, pres + real(wp), dimension(2) :: Re integer :: i, j, k, l do i = 1, num_fluids @@ -80,22 +80,22 @@ end subroutine s_compute_enthalpy !! @param Rc_sf (optional) cell centered Rc subroutine s_compute_stability_from_dt(vel, c, rho, Re_l, j, k, l, icfl_sf, vcfl_sf, Rc_sf) !$acc routine seq - real(kind(0d0)), dimension(num_dims) :: vel - real(kind(0d0)) :: c, icfl_dt, vcfl_dt, rho - real(kind(0d0)), dimension(0:m, 0:n, 0:p) :: icfl_sf - real(kind(0d0)), dimension(0:m, 0:n, 0:p), optional :: vcfl_sf, Rc_sf - real(kind(0d0)) :: fltr_dtheta !< + real(wp), dimension(num_dims) :: vel + real(wp) :: c, icfl_dt, vcfl_dt, rho + real(wp), dimension(0:m, 0:n, 0:p) :: icfl_sf + real(wp), dimension(0:m, 0:n, 0:p), optional :: vcfl_sf, Rc_sf + real(wp) :: fltr_dtheta !< !! Modified dtheta accounting for Fourier filtering in azimuthal direction. integer :: j, k, l integer :: Nfq - real(kind(0d0)), dimension(2) :: Re_l + real(wp), dimension(2) :: Re_l if (grid_geometry == 3) then if (k == 0) then fltr_dtheta = 2d0*pi*y_cb(0)/3d0 elseif (k <= fourier_rings) then - Nfq = min(floor(2d0*real(k, kind(0d0))*pi), (p + 1)/2 + 1) - fltr_dtheta = 2d0*pi*y_cb(k - 1)/real(Nfq, kind(0d0)) + Nfq = min(floor(2d0*real(k, wp)*pi), (p + 1)/2 + 1) + fltr_dtheta = 2d0*pi*y_cb(k - 1)/real(Nfq, wp) else fltr_dtheta = y_cb(k - 1)*dz(l) end if @@ -176,21 +176,21 @@ end subroutine s_compute_stability_from_dt !! @param l z coordinate subroutine s_compute_dt_from_cfl(vel, c, max_dt, rho, Re_l, j, k, l) !$acc routine seq - real(kind(0d0)), dimension(num_dims) :: vel - real(kind(0d0)) :: c, icfl_dt, vcfl_dt, rho - real(kind(0d0)), dimension(0:m, 0:n, 0:p) :: max_dt - real(kind(0d0)) :: fltr_dtheta !< + real(wp), dimension(num_dims) :: vel + real(wp) :: c, icfl_dt, vcfl_dt, rho + real(wp), dimension(0:m, 0:n, 0:p) :: max_dt + real(wp) :: fltr_dtheta !< !! Modified dtheta accounting for Fourier filtering in azimuthal direction. integer :: j, k, l integer :: Nfq - real(kind(0d0)), dimension(2) :: Re_l + real(wp), dimension(2) :: Re_l if (grid_geometry == 3) then if (k == 0) then fltr_dtheta = 2d0*pi*y_cb(0)/3d0 elseif (k <= fourier_rings) then - Nfq = min(floor(2d0*real(k, kind(0d0))*pi), (p + 1)/2 + 1) - fltr_dtheta = 2d0*pi*y_cb(k - 1)/real(Nfq, kind(0d0)) + Nfq = min(floor(2d0*real(k, wp)*pi), (p + 1)/2 + 1) + fltr_dtheta = 2d0*pi*y_cb(k - 1)/real(Nfq, wp) else fltr_dtheta = y_cb(k - 1)*dz(l) end if diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index bee897b58f..460783d520 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -460,7 +460,7 @@ contains #ifdef MFC_MPI - real(kind(0d0)), allocatable, dimension(:) :: x_cb_glb, y_cb_glb, z_cb_glb + real(wp), allocatable, dimension(:) :: x_cb_glb, y_cb_glb, z_cb_glb integer :: ifile, ierr, data_size integer, dimension(MPI_STATUS_SIZE) :: status @@ -1042,17 +1042,17 @@ contains type(scalar_field), dimension(sys_size), intent(inout) :: v_vf - real(kind(0d0)) :: rho - real(kind(0d0)) :: dyn_pres - real(kind(0d0)) :: gamma - real(kind(0d0)) :: pi_inf - real(kind(0d0)) :: qv - real(kind(0d0)), dimension(2) :: Re - real(kind(0d0)) :: pres + real(wp) :: rho + real(wp) :: dyn_pres + real(wp) :: gamma + real(wp) :: pi_inf + real(wp) :: qv + real(wp), dimension(2) :: Re + real(wp) :: pres integer :: i, j, k, l, c - real(kind(0d0)), dimension(num_species) :: rhoYks + real(wp), dimension(num_species) :: rhoYks do j = 0, m do k = 0, n @@ -1089,15 +1089,15 @@ contains subroutine s_perform_time_step(t_step, time_avg, time_final, io_time_avg, io_time_final, proc_time, io_proc_time, file_exists, start, finish, nt) integer, intent(inout) :: t_step - real(kind(0d0)), intent(inout) :: time_avg, time_final - real(kind(0d0)), intent(inout) :: io_time_avg, io_time_final - real(kind(0d0)), dimension(:), intent(inout) :: proc_time - real(kind(0d0)), dimension(:), intent(inout) :: io_proc_time + real(wp), intent(inout) :: time_avg, time_final + real(wp), intent(inout) :: io_time_avg, io_time_final + real(wp), dimension(:), intent(inout) :: proc_time + real(wp), dimension(:), intent(inout) :: io_proc_time logical, intent(inout) :: file_exists - real(kind(0d0)), intent(inout) :: start, finish + real(wp), intent(inout) :: start, finish integer, intent(inout) :: nt - real(kind(0d0)) :: dt_init + real(wp) :: dt_init integer :: i, j, k, l @@ -1175,15 +1175,15 @@ contains subroutine s_save_performance_metrics(t_step, time_avg, time_final, io_time_avg, io_time_final, proc_time, io_proc_time, file_exists, start, finish, nt) integer, intent(inout) :: t_step - real(kind(0d0)), intent(inout) :: time_avg, time_final - real(kind(0d0)), intent(inout) :: io_time_avg, io_time_final - real(kind(0d0)), dimension(:), intent(inout) :: proc_time - real(kind(0d0)), dimension(:), intent(inout) :: io_proc_time + real(wp), intent(inout) :: time_avg, time_final + real(wp), intent(inout) :: io_time_avg, io_time_final + real(wp), dimension(:), intent(inout) :: proc_time + real(wp), dimension(:), intent(inout) :: io_proc_time logical, intent(inout) :: file_exists - real(kind(0d0)), intent(inout) :: start, finish + real(wp), intent(inout) :: start, finish integer, intent(inout) :: nt - real(kind(0d0)) :: grind_time + real(wp) :: grind_time call s_mpi_barrier() @@ -1236,7 +1236,7 @@ contains subroutine s_save_data(t_step, start, finish, io_time_avg, nt) integer, intent(inout) :: t_step - real(kind(0d0)), intent(inout) :: start, finish, io_time_avg + real(wp), intent(inout) :: start, finish, io_time_avg integer, intent(inout) :: nt integer :: i, j, k, l @@ -1389,7 +1389,7 @@ contains subroutine s_initialize_mpi_domain integer :: ierr #ifdef MFC_OpenACC - real(kind(0d0)) :: starttime, endtime + real(wp) :: starttime, endtime integer :: num_devices, local_size, num_nodes, ppn, my_device_num integer :: dev, devNum, local_rank #ifdef MFC_MPI diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp index 2e9ca8fedf..9b9ac45f5c 100644 --- a/src/simulation/m_surface_tension.fpp +++ b/src/simulation/m_surface_tension.fpp @@ -40,12 +40,12 @@ module m_surface_tension #endif #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:,:,:,:), gL_x, gL_y, gL_z, gR_x, gR_y, gR_z) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:,:,:,:), gL_x, gL_y, gL_z, gR_x, gR_y, gR_z) !$acc declare link(gL_x, gL_y, gL_z, gR_x, gR_y, gR_z) #else !> @name cell boundary reconstructed gradient components and magnitude !> @{ - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: gL_x, gR_x, gL_y, gR_y, gL_z, gR_z + real(wp), allocatable, dimension(:, :, :, :) :: gL_x, gR_x, gL_y, gR_y, gL_z, gR_z !> @} !$acc declare create(gL_x, gR_x, gL_y, gR_y, gL_z, gR_z) #endif @@ -92,18 +92,18 @@ contains id, isx, isy, isz) type(scalar_field), dimension(sys_size) :: q_prim_vf !> unused so unsure what intent to give it - real(kind(0d0)), dimension(-1:, 0:, 0:, 1:), intent(in) :: vSrc_rsx_vf - real(kind(0d0)), dimension(-1:, 0:, 0:, 1:), intent(in) :: vSrc_rsy_vf - real(kind(0d0)), dimension(-1:, 0:, 0:, 1:), intent(in) :: vSrc_rsz_vf + real(wp), dimension(-1:, 0:, 0:, 1:), intent(in) :: vSrc_rsx_vf + real(wp), dimension(-1:, 0:, 0:, 1:), intent(in) :: vSrc_rsy_vf + real(wp), dimension(-1:, 0:, 0:, 1:), intent(in) :: vSrc_rsz_vf type(scalar_field), & dimension(sys_size), & intent(inout) :: flux_src_vf integer, intent(in) :: id type(int_bounds_info), intent(in) :: isx, isy, isz - real(kind(0d0)), dimension(num_dims, num_dims) :: Omega - real(kind(0d0)) :: w1L, w1R, w2L, w2R, w3L, w3R, w1, w2, w3 - real(kind(0d0)) :: normWL, normWR, normW + real(wp), dimension(num_dims, num_dims) :: Omega + real(wp) :: w1L, w1R, w2L, w2R, w3L, w3R, w1, w2, w3 + real(wp) :: normWL, normWR, normW if (id == 1) then !$acc parallel loop collapse(3) gang vector default(present) private(Omega, & @@ -324,8 +324,8 @@ contains type(scalar_field), dimension(iv%beg:iv%end), intent(in) :: v_vf - real(kind(0d0)), dimension(startx:, starty:, startz:, iv%beg:), intent(out) :: vL_x, vL_y, vL_z - real(kind(0d0)), dimension(startx:, starty:, startz:, iv%beg:), intent(out) :: vR_x, vR_y, vR_z + real(wp), dimension(startx:, starty:, startz:, iv%beg:), intent(out) :: vL_x, vL_y, vL_z + real(wp), dimension(startx:, starty:, startz:, iv%beg:), intent(out) :: vR_x, vR_y, vR_z integer, intent(in) :: norm_dir integer :: recon_dir !< Coordinate direction of the WENO reconstruction diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 865f3f3646..4bf86eae46 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -57,11 +57,11 @@ module m_time_steppers @:CRAY_DECLARE_GLOBAL(type(vector_field), dimension(:), q_prim_ts) !! Cell-average primitive variables at consecutive TIMESTEPS - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :, :), rhs_pb) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :, :), rhs_pb) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :, :), rhs_mv) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :, :), rhs_mv) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension( :, :, :), max_dt) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension( :, :, :), max_dt) integer, private :: num_ts !< !! Number of time stages in the time-stepping scheme @@ -80,11 +80,11 @@ module m_time_steppers type(vector_field), allocatable, dimension(:) :: q_prim_ts !< !! Cell-average primitive variables at consecutive TIMESTEPS - real(kind(0d0)), allocatable, dimension(:, :, :, :, :) :: rhs_pb + real(wp), allocatable, dimension(:, :, :, :, :) :: rhs_pb - real(kind(0d0)), allocatable, dimension(:, :, :, :, :) :: rhs_mv + real(wp), allocatable, dimension(:, :, :, :, :) :: rhs_mv - real(kind(0d0)), allocatable, dimension(:, :, :) :: max_dt + real(wp), allocatable, dimension(:, :, :) :: max_dt integer, private :: num_ts !< !! Number of time stages in the time-stepping scheme @@ -318,14 +318,14 @@ contains subroutine s_1st_order_tvd_rk(t_step, time_avg) integer, intent(in) :: t_step - real(kind(0d0)), intent(inout) :: time_avg + real(wp), intent(inout) :: time_avg integer :: i, j, k, l, q!< Generic loop iterator - real(kind(0d0)) :: nR3bar - real(kind(0d0)) :: e_mix + real(wp) :: nR3bar + real(wp) :: e_mix - real(kind(0d0)) :: T - real(kind(0d0)), dimension(num_species) :: Ys + real(wp) :: T + real(wp), dimension(num_species) :: Ys ! Stage 1 of 1 ===================================================== @@ -432,11 +432,11 @@ contains subroutine s_2nd_order_tvd_rk(t_step, time_avg) integer, intent(in) :: t_step - real(kind(0d0)), intent(inout) :: time_avg + real(wp), intent(inout) :: time_avg integer :: i, j, k, l, q!< Generic loop iterator - real(kind(0d0)) :: start, finish - real(kind(0d0)) :: nR3bar + real(wp) :: start, finish + real(wp) :: nR3bar ! Stage 1 of 2 ===================================================== @@ -615,12 +615,12 @@ contains subroutine s_3rd_order_tvd_rk(t_step, time_avg) ! -------------------------------- integer, intent(IN) :: t_step - real(kind(0d0)), intent(INOUT) :: time_avg + real(wp), intent(INOUT) :: time_avg integer :: i, j, k, l, q !< Generic loop iterator - real(kind(0d0)) :: ts_error, denom, error_fraction, time_step_factor !< Generic loop iterator - real(kind(0d0)) :: start, finish - real(kind(0d0)) :: nR3bar + real(wp) :: ts_error, denom, error_fraction, time_step_factor !< Generic loop iterator + real(wp) :: start, finish + real(wp) :: nR3bar ! Stage 1 of 3 ===================================================== @@ -879,10 +879,10 @@ contains subroutine s_strang_splitting(t_step, time_avg) integer, intent(in) :: t_step - real(kind(0d0)), intent(inout) :: time_avg + real(wp), intent(inout) :: time_avg integer :: i, j, k, l !< Generic loop iterator - real(kind(0d0)) :: start, finish + real(wp) :: start, finish call cpu_time(start) @@ -934,18 +934,18 @@ contains subroutine s_compute_dt() - real(kind(0d0)) :: rho !< Cell-avg. density - real(kind(0d0)), dimension(num_dims) :: vel !< Cell-avg. velocity - real(kind(0d0)) :: vel_sum !< Cell-avg. velocity sum - real(kind(0d0)) :: pres !< Cell-avg. pressure - real(kind(0d0)), dimension(num_fluids) :: alpha !< Cell-avg. volume fraction - real(kind(0d0)) :: gamma !< Cell-avg. sp. heat ratio - real(kind(0d0)) :: pi_inf !< Cell-avg. liquid stiffness function - real(kind(0d0)) :: c !< Cell-avg. sound speed - real(kind(0d0)) :: H !< Cell-avg. enthalpy - real(kind(0d0)), dimension(2) :: Re !< Cell-avg. Reynolds numbers + real(wp) :: rho !< Cell-avg. density + real(wp), dimension(num_dims) :: vel !< Cell-avg. velocity + real(wp) :: vel_sum !< Cell-avg. velocity sum + real(wp) :: pres !< Cell-avg. pressure + real(wp), dimension(num_fluids) :: alpha !< Cell-avg. volume fraction + real(wp) :: gamma !< Cell-avg. sp. heat ratio + real(wp) :: pi_inf !< Cell-avg. liquid stiffness function + real(wp) :: c !< Cell-avg. sound speed + real(wp) :: H !< Cell-avg. enthalpy + real(wp), dimension(2) :: Re !< Cell-avg. Reynolds numbers type(vector_field) :: gm_alpha_qp - real(kind(0d0)) :: dt_local + real(wp) :: dt_local type(int_bounds_info) :: ix, iy, iz integer :: i, j, k, l, q !< Generic loop iterators @@ -994,7 +994,7 @@ contains type(scalar_field), dimension(1:sys_size), intent(in) :: q_prim_vf type(scalar_field), dimension(1:sys_size), intent(inout) :: rhs_vf - real(kind(0d0)), intent(in) :: ldt !< local dt + real(wp), intent(in) :: ldt !< local dt integer :: i, j, k, l diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp index c8c83f6b4f..004c1d88cb 100644 --- a/src/simulation/m_viscous.fpp +++ b/src/simulation/m_viscous.fpp @@ -29,10 +29,10 @@ module m_viscous !$acc declare create(is1_viscous, is2_viscous, is3_viscous, iv) #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :), Res_viscous) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :), Res_viscous) !$acc declare link(Res_viscous) #else - real(kind(0d0)), allocatable, dimension(:, :) :: Res_viscous + real(wp), allocatable, dimension(:, :) :: Res_viscous !$acc declare create(Re_viscous) #endif @@ -81,11 +81,11 @@ contains type(scalar_field), dimension(1:sys_size), intent(inout) :: tau_Re_vf type(int_bounds_info), intent(in) :: ix, iy, iz - real(kind(0d0)) :: rho_visc, gamma_visc, pi_inf_visc, alpha_visc_sum !< Mixture variables - real(kind(0d0)), dimension(2) :: Re_visc - real(kind(0d0)), dimension(num_fluids) :: alpha_visc, alpha_rho_visc + real(wp) :: rho_visc, gamma_visc, pi_inf_visc, alpha_visc_sum !< Mixture variables + real(wp), dimension(2) :: Re_visc + real(wp), dimension(num_fluids) :: alpha_visc, alpha_rho_visc - real(kind(0d0)), dimension(num_dims, num_dims) :: tau_Re + real(wp), dimension(num_dims, num_dims) :: tau_Re integer :: i, j, k, l, q !< Generic loop iterator @@ -538,7 +538,7 @@ contains dq_prim_dx_qp, dq_prim_dy_qp, dq_prim_dz_qp, & ix, iy, iz) - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), & + real(wp), dimension(startx:, starty:, startz:, 1:), & intent(inout) :: qL_prim_rsx_vf, qR_prim_rsx_vf, & qL_prim_rsy_vf, qR_prim_rsy_vf, & qL_prim_rsz_vf, qR_prim_rsz_vf @@ -987,7 +987,7 @@ contains type(scalar_field), dimension(iv%beg:iv%end), intent(in) :: v_vf type(scalar_field), dimension(iv%beg:iv%end), intent(inout) :: vL_prim_vf, vR_prim_vf - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: vL_x, vL_y, vL_z, vR_x, vR_y, vR_z + real(wp), dimension(startx:, starty:, startz:, 1:), intent(inout) :: vL_x, vL_y, vL_z, vR_x, vR_y, vR_z integer, intent(in) :: norm_dir type(int_bounds_info), intent(in) :: ix, iy, iz @@ -1085,7 +1085,7 @@ contains norm_dir, vL_prim_vf, vR_prim_vf, ix, iy, iz) type(scalar_field), dimension(iv%beg:iv%end), intent(in) :: v_vf - real(kind(0d0)), dimension(startx:, starty:, startz:, iv%beg:), intent(inout) :: vL_x, vL_y, vL_z, vR_x, vR_y, vR_z + real(wp), dimension(startx:, starty:, startz:, iv%beg:), intent(inout) :: vL_x, vL_y, vL_z, vR_x, vR_y, vR_z type(scalar_field), dimension(iv%beg:iv%end), intent(inout) :: vL_prim_vf, vR_prim_vf type(int_bounds_info), intent(in) :: ix, iy, iz @@ -1208,7 +1208,7 @@ contains integer, intent(in) :: norm_dir type(int_bounds_info), intent(in) :: ix, iy, iz, iv_in integer, intent(in) :: dim, buff_size_in - real(kind(0d0)), dimension(-buff_size_in:dim + buff_size_in), intent(in) :: dL + real(wp), dimension(-buff_size_in:dim + buff_size_in), intent(in) :: dL integer :: i, j, k, l !< Generic loop iterators diff --git a/src/simulation/m_weno.fpp b/src/simulation/m_weno.fpp index 6a05b9d9c3..9417186fdc 100644 --- a/src/simulation/m_weno.fpp +++ b/src/simulation/m_weno.fpp @@ -45,10 +45,10 @@ module m_weno !> @{ #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :, :), v_rs_ws_x, v_rs_ws_y, v_rs_ws_z) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :, :), v_rs_ws_x, v_rs_ws_y, v_rs_ws_z) !$acc declare link(v_rs_ws_x, v_rs_ws_y, v_rs_ws_z) #else - real(kind(0d0)), allocatable, dimension(:, :, :, :) :: v_rs_ws_x, v_rs_ws_y, v_rs_ws_z + real(wp), allocatable, dimension(:, :, :, :) :: v_rs_ws_x, v_rs_ws_y, v_rs_ws_z #endif !> @} @@ -61,27 +61,27 @@ module m_weno !! dimension denotes the cell-location in the relevant coordinate direction. !> @{ #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), poly_coef_cbL_x) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), poly_coef_cbL_y) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), poly_coef_cbL_z) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), poly_coef_cbL_x) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), poly_coef_cbL_y) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), poly_coef_cbL_z) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), poly_coef_cbR_x) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), poly_coef_cbR_y) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), poly_coef_cbR_z) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), poly_coef_cbR_x) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), poly_coef_cbR_y) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), poly_coef_cbR_z) !$acc declare link(poly_coef_cbL_x, poly_coef_cbL_y, poly_coef_cbL_z) !$acc declare link(poly_coef_cbR_x, poly_coef_cbR_y, poly_coef_cbR_z) #else - real(kind(0d0)), target, allocatable, dimension(:, :, :) :: poly_coef_cbL_x - real(kind(0d0)), target, allocatable, dimension(:, :, :) :: poly_coef_cbL_y - real(kind(0d0)), target, allocatable, dimension(:, :, :) :: poly_coef_cbL_z + real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbL_x + real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbL_y + real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbL_z - real(kind(0d0)), target, allocatable, dimension(:, :, :) :: poly_coef_cbR_x - real(kind(0d0)), target, allocatable, dimension(:, :, :) :: poly_coef_cbR_y - real(kind(0d0)), target, allocatable, dimension(:, :, :) :: poly_coef_cbR_z + real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbR_x + real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbR_y + real(wp), target, allocatable, dimension(:, :, :) :: poly_coef_cbR_z #endif - ! real(kind(0d0)), pointer, dimension(:, :, :) :: poly_coef_L => null() - ! real(kind(0d0)), pointer, dimension(:, :, :) :: poly_coef_R => null() + ! real(wp), pointer, dimension(:, :, :) :: poly_coef_L => null() + ! real(wp), pointer, dimension(:, :, :) :: poly_coef_R => null() !> @} !> @name The ideal weights at the left and the right cell-boundaries and at the @@ -90,25 +90,25 @@ module m_weno !! last denotes the cell-location in the relevant coordinate direction. !> @{ #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :), d_cbL_y) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :), d_cbL_x) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :), d_cbL_z) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :), d_cbL_y) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :), d_cbL_x) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :), d_cbL_z) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :), d_cbR_x) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :), d_cbR_y) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :), d_cbR_z) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :), d_cbR_x) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :), d_cbR_y) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :), d_cbR_z) !$acc declare link(d_cbL_x, d_cbL_y, d_cbL_z, d_cbR_x, d_cbR_y, d_cbR_z) #else - real(kind(0d0)), target, allocatable, dimension(:, :) :: d_cbL_x - real(kind(0d0)), target, allocatable, dimension(:, :) :: d_cbL_y - real(kind(0d0)), target, allocatable, dimension(:, :) :: d_cbL_z + real(wp), target, allocatable, dimension(:, :) :: d_cbL_x + real(wp), target, allocatable, dimension(:, :) :: d_cbL_y + real(wp), target, allocatable, dimension(:, :) :: d_cbL_z - real(kind(0d0)), target, allocatable, dimension(:, :) :: d_cbR_x - real(kind(0d0)), target, allocatable, dimension(:, :) :: d_cbR_y - real(kind(0d0)), target, allocatable, dimension(:, :) :: d_cbR_z + real(wp), target, allocatable, dimension(:, :) :: d_cbR_x + real(wp), target, allocatable, dimension(:, :) :: d_cbR_y + real(wp), target, allocatable, dimension(:, :) :: d_cbR_z #endif -! real(kind(0d0)), pointer, dimension(:, :) :: d_L => null() -! real(kind(0d0)), pointer, dimension(:, :) :: d_R => null() +! real(wp), pointer, dimension(:, :) :: d_L => null() +! real(wp), pointer, dimension(:, :) :: d_R => null() !> @} !> @name Smoothness indicator coefficients in the x-, y-, and z-directions. Note @@ -117,16 +117,16 @@ module m_weno !! the cell-location in the relevant coordinate direction. !> @{ #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), beta_coef_x) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), beta_coef_y) - @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:, :, :), beta_coef_z) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), beta_coef_x) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), beta_coef_y) + @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:, :, :), beta_coef_z) !$acc declare link(beta_coef_x, beta_coef_y, beta_coef_z) #else - real(kind(0d0)), target, allocatable, dimension(:, :, :) :: beta_coef_x - real(kind(0d0)), target, allocatable, dimension(:, :, :) :: beta_coef_y - real(kind(0d0)), target, allocatable, dimension(:, :, :) :: beta_coef_z + real(wp), target, allocatable, dimension(:, :, :) :: beta_coef_x + real(wp), target, allocatable, dimension(:, :, :) :: beta_coef_y + real(wp), target, allocatable, dimension(:, :, :) :: beta_coef_z #endif -! real(kind(0d0)), pointer, dimension(:, :, :) :: beta_coef => null() +! real(wp), pointer, dimension(:, :, :) :: beta_coef => null() !> @} ! END: WENO Coefficients =================================================== @@ -142,7 +142,7 @@ module m_weno ! !> @} - real(kind(0d0)) :: test + real(wp) :: test !$acc declare create(test) #ifndef CRAY_ACC_WAR @@ -271,7 +271,7 @@ contains type(int_bounds_info), intent(in) :: is integer :: s - real(kind(0d0)), pointer, dimension(:) :: s_cb => null() !< + real(wp), pointer, dimension(:) :: s_cb => null() !< !! Cell-boundary locations in the s-direction type(int_bounds_info) :: bc_s !< Boundary conditions (BC) in the s-direction @@ -507,22 +507,22 @@ contains is1_weno_d, is2_weno_d, is3_weno_d) type(scalar_field), dimension(1:), intent(in) :: v_vf - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: vL_rs_vf_x, vL_rs_vf_y, vL_rs_vf_z - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(inout) :: vR_rs_vf_x, vR_rs_vf_y, vR_rs_vf_z + real(wp), dimension(startx:, starty:, startz:, 1:), intent(inout) :: vL_rs_vf_x, vL_rs_vf_y, vL_rs_vf_z + real(wp), dimension(startx:, starty:, startz:, 1:), intent(inout) :: vR_rs_vf_x, vR_rs_vf_y, vR_rs_vf_z integer, intent(in) :: norm_dir integer, intent(in) :: weno_dir type(int_bounds_info), intent(in) :: is1_weno_d, is2_weno_d, is3_weno_d - real(kind(0d0)), dimension(-weno_polyn:weno_polyn - 1) :: dvd - real(kind(0d0)), dimension(0:weno_polyn) :: poly - real(kind(0d0)), dimension(0:weno_polyn) :: alpha - real(kind(0d0)), dimension(0:weno_polyn) :: omega - real(kind(0d0)), dimension(0:weno_polyn) :: beta - real(kind(0d0)), dimension(0:weno_polyn) :: delta - real(kind(0d0)) :: tau5 - real(kind(0d0)), pointer :: beta_p(:) + real(wp), dimension(-weno_polyn:weno_polyn - 1) :: dvd + real(wp), dimension(0:weno_polyn) :: poly + real(wp), dimension(0:weno_polyn) :: alpha + real(wp), dimension(0:weno_polyn) :: omega + real(wp), dimension(0:weno_polyn) :: beta + real(wp), dimension(0:weno_polyn) :: delta + real(wp) :: tau5 + real(wp), pointer :: beta_p(:) - real(kind(0d0)) :: v_rs1, v_rs2, v_rs3, v_rs4, v_rs5 + real(wp) :: v_rs1, v_rs2, v_rs3, v_rs4, v_rs5 integer :: i, j, k, l, r, s, w @@ -913,37 +913,37 @@ contains !! @param l Third-coordinate cell index subroutine s_preserve_monotonicity(v_rs_ws, vL_rs_vf, vR_rs_vf) - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(IN) :: v_rs_ws - real(kind(0d0)), dimension(startx:, starty:, startz:, 1:), intent(INOUT) :: vL_rs_vf, vR_rs_vf + real(wp), dimension(startx:, starty:, startz:, 1:), intent(IN) :: v_rs_ws + real(wp), dimension(startx:, starty:, startz:, 1:), intent(INOUT) :: vL_rs_vf, vR_rs_vf integer :: i, j, k, l - real(kind(0d0)), dimension(-1:1) :: d !< Curvature measures at the zone centers + real(wp), dimension(-1:1) :: d !< Curvature measures at the zone centers - real(kind(0d0)) :: d_MD, d_LC !< + real(wp) :: d_MD, d_LC !< !! Median (md) curvature and large curvature (LC) measures ! The left and right upper bounds (UL), medians, large curvatures, ! minima, and maxima of the WENO-reconstructed values of the cell- ! average variables. - real(kind(0d0)) :: vL_UL, vR_UL - real(kind(0d0)) :: vL_MD, vR_MD - real(kind(0d0)) :: vL_LC, vR_LC - real(kind(0d0)) :: vL_min, vR_min - real(kind(0d0)) :: vL_max, vR_max + real(wp) :: vL_UL, vR_UL + real(wp) :: vL_MD, vR_MD + real(wp) :: vL_LC, vR_LC + real(wp) :: vL_min, vR_min + real(wp) :: vL_max, vR_max - real(kind(0d0)), parameter :: alpha = 2d0 !> + real(wp), parameter :: alpha = 2d0 !> !! Determines the maximum Courant–Friedrichs–Lewy (CFL) number that !! may be utilized with the scheme. In theory, for stability, a CFL !! number less than 1/(1+alpha) is necessary. The default value for !! alpha is 2. - real(kind(0d0)), parameter :: beta = 4d0/3d0 !< + real(wp), parameter :: beta = 4d0/3d0 !< !! Determines the amount of freedom available from utilizing a large !! value for the local curvature. The default value for beta is 4/3. - real(kind(0d0)), parameter :: alpha_mp = 2d0 - real(kind(0d0)), parameter :: beta_mp = 4d0/3d0 + real(wp), parameter :: alpha_mp = 2d0 + real(wp), parameter :: beta_mp = 4d0/3d0 !$acc parallel loop gang vector collapse (4) default(present) private(d) do l = is3_weno%beg, is3_weno%end diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index 091538073e..37c13f5743 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -26,12 +26,12 @@ program p_main implicit none integer :: t_step !< Iterator for the time-stepping loop - real(kind(0d0)) :: time_avg, time_final - real(kind(0d0)) :: io_time_avg, io_time_final - real(kind(0d0)), allocatable, dimension(:) :: proc_time - real(kind(0d0)), allocatable, dimension(:) :: io_proc_time + real(wp) :: time_avg, time_final + real(wp) :: io_time_avg, io_time_final + real(wp), allocatable, dimension(:) :: proc_time + real(wp), allocatable, dimension(:) :: io_proc_time logical :: file_exists - real(kind(0d0)) :: start, finish + real(wp) :: start, finish integer :: nt call system_clock(COUNT=cpu_start, COUNT_RATE=cpu_rate) diff --git a/src/syscheck/syscheck.fpp b/src/syscheck/syscheck.fpp index de613a6f8d..7fdb3cf1e7 100644 --- a/src/syscheck/syscheck.fpp +++ b/src/syscheck/syscheck.fpp @@ -53,7 +53,7 @@ program syscheck @:ACC(integer(acc_device_kind) :: devtype) @:ACC(integer :: i, num_devices) - @:ACC(real(kind(0d0)), allocatable, dimension(:) :: arr) + @:ACC(real(wp), allocatable, dimension(:) :: arr) @:ACC(integer, parameter :: N = 100) @:MPIC(call mpi_init(ierr)) From 922d5431ee7780ac5bdf60900182ec745be9e4b9 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Thu, 19 Sep 2024 21:44:26 -0700 Subject: [PATCH 02/68] Replace instances of 0d0 and d0 with wp --- src/common/m_checker_common.fpp | 30 +- src/common/m_constants.fpp | 6 +- src/common/m_eigen_solver.f90 | 144 ++--- src/common/m_finite_differences.fpp | 26 +- src/common/m_helper.fpp | 156 ++--- src/common/m_helper_basic.f90 | 2 +- src/common/m_phase_change.fpp | 158 ++--- src/common/m_variables_conversion.fpp | 164 +++--- src/post_process/m_checker.fpp | 2 +- src/post_process/m_data_input.f90 | 32 +- src/post_process/m_derived_variables.fpp | 72 +-- src/post_process/m_global_parameters.fpp | 34 +- src/post_process/m_mpi_proxy.fpp | 12 +- src/post_process/m_start_up.f90 | 8 +- src/pre_process/include/2dHardcodedIC.fpp | 56 +- src/pre_process/m_assign_variables.fpp | 130 ++--- src/pre_process/m_check_ib_patches.fpp | 38 +- src/pre_process/m_check_patches.fpp | 76 +-- src/pre_process/m_checker.fpp | 10 +- src/pre_process/m_data_output.fpp | 14 +- src/pre_process/m_global_parameters.fpp | 64 +- src/pre_process/m_grid.f90 | 24 +- src/pre_process/m_mpi_proxy.fpp | 8 +- src/pre_process/m_patches.fpp | 370 ++++++------ src/pre_process/m_perturbation.fpp | 96 +-- src/pre_process/m_start_up.fpp | 28 +- src/simulation/include/inline_riemann.fpp | 20 +- src/simulation/m_acoustic_src.fpp | 112 ++-- src/simulation/m_body_forces.fpp | 4 +- src/simulation/m_boundary_conditions.fpp | 48 +- src/simulation/m_bubbles.fpp | 226 ++++---- src/simulation/m_cbc.fpp | 90 +-- src/simulation/m_checker.fpp | 20 +- src/simulation/m_chemistry.fpp | 14 +- src/simulation/m_compute_cbc.fpp | 20 +- src/simulation/m_compute_levelset.fpp | 18 +- src/simulation/m_data_output.fpp | 176 +++--- src/simulation/m_derived_variables.f90 | 36 +- src/simulation/m_fftw.fpp | 12 +- src/simulation/m_global_parameters.fpp | 48 +- src/simulation/m_hypoelastic.fpp | 74 +-- src/simulation/m_ibm.fpp | 110 ++-- src/simulation/m_mpi_proxy.fpp | 8 +- src/simulation/m_qbmm.fpp | 676 +++++++++++----------- src/simulation/m_rhs.fpp | 156 ++--- src/simulation/m_riemann_solvers.fpp | 522 ++++++++--------- src/simulation/m_sim_helpers.f90 | 40 +- src/simulation/m_start_up.fpp | 48 +- src/simulation/m_surface_tension.fpp | 46 +- src/simulation/m_time_steppers.fpp | 36 +- src/simulation/m_viscous.fpp | 138 ++--- src/simulation/m_weno.fpp | 204 +++---- src/simulation/p_main.fpp | 2 +- 53 files changed, 2332 insertions(+), 2332 deletions(-) diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index 43147ad6bd..5f0c959ef5 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -61,7 +61,7 @@ contains !! Called by s_check_inputs_common for simulation and post-processing subroutine s_check_inputs_time_stepping if (cfl_dt) then - @:PROHIBIT(cfl_target < 0 .or. cfl_target > 1d0) + @:PROHIBIT(cfl_target < 0 .or. cfl_target > 1._wp) @:PROHIBIT(t_stop <= 0) @:PROHIBIT(t_save <= 0) @:PROHIBIT(t_save > t_stop) @@ -144,10 +144,10 @@ contains @:PROHIBIT(relax .and. model_eqns /= 3, "phase change requires model_eqns = 3") @:PROHIBIT(relax .and. relax_model < 0, "relax_model must be in between 0 and 6") @:PROHIBIT(relax .and. relax_model > 6, "relax_model must be in between 0 and 6") - @:PROHIBIT(relax .and. palpha_eps <= 0d0, "palpha_eps must be positive") - @:PROHIBIT(relax .and. palpha_eps >= 1d0, "palpha_eps must be less than 1") - @:PROHIBIT(relax .and. ptgalpha_eps <= 0d0, "ptgalpha_eps must be positive") - @:PROHIBIT(relax .and. ptgalpha_eps >= 1d0, "ptgalpha_eps must be less than 1") + @:PROHIBIT(relax .and. palpha_eps <= 0._wp, "palpha_eps must be positive") + @:PROHIBIT(relax .and. palpha_eps >= 1._wp, "palpha_eps must be less than 1") + @:PROHIBIT(relax .and. ptgalpha_eps <= 0._wp, "ptgalpha_eps must be positive") + @:PROHIBIT(relax .and. ptgalpha_eps >= 1._wp, "ptgalpha_eps must be less than 1") @:PROHIBIT((.not. relax) .and. & ((relax_model /= dflt_int) .or. (.not. f_is_default(palpha_eps)) .or. (.not. f_is_default(ptgalpha_eps))), & "relax is not set as true, but other phase change parameters have been modified. " // & @@ -262,27 +262,27 @@ contains do i = 1, num_fluids call s_int_to_str(i, iStr) - @:PROHIBIT(.not. f_is_default(fluid_pp(i)%gamma) .and. fluid_pp(i)%gamma <= 0d0, & + @:PROHIBIT(.not. f_is_default(fluid_pp(i)%gamma) .and. fluid_pp(i)%gamma <= 0._wp, & "fluid_pp("//trim(iStr)//")%gamma must be positive") @:PROHIBIT(model_eqns == 1 .and. (.not. f_is_default(fluid_pp(i)%gamma)), & "model_eqns = 1 does not support fluid_pp("//trim(iStr)//")%gamma") - @:PROHIBIT((i <= num_fluids + bub_fac .and. fluid_pp(i)%gamma <= 0d0) .or. & + @:PROHIBIT((i <= num_fluids + bub_fac .and. fluid_pp(i)%gamma <= 0._wp) .or. & (i > num_fluids + bub_fac .and. (.not. f_is_default(fluid_pp(i)%gamma))), & "for fluid_pp("//trim(iStr)//")%gamma") - @:PROHIBIT(.not. f_is_default(fluid_pp(i)%pi_inf) .and. fluid_pp(i)%pi_inf < 0d0, & + @:PROHIBIT(.not. f_is_default(fluid_pp(i)%pi_inf) .and. fluid_pp(i)%pi_inf < 0._wp, & "fluid_pp("//trim(iStr)//")%pi_inf must be non-negative") @:PROHIBIT(model_eqns == 1 .and. (.not. f_is_default(fluid_pp(i)%pi_inf)), & "model_eqns = 1 does not support fluid_pp("//trim(iStr)//")%pi_inf") - @:PROHIBIT((i <= num_fluids + bub_fac .and. fluid_pp(i)%pi_inf < 0d0) .or. & + @:PROHIBIT((i <= num_fluids + bub_fac .and. fluid_pp(i)%pi_inf < 0._wp) .or. & (i > num_fluids + bub_fac .and. (.not. f_is_default(fluid_pp(i)%pi_inf))), & "for fluid_pp("//trim(iStr)//")%pi_inf") - @:PROHIBIT(fluid_pp(i)%cv < 0d0, & + @:PROHIBIT(fluid_pp(i)%cv < 0._wp, & "fluid_pp("//trim(iStr)//")%cv must be positive") end do end subroutine s_check_inputs_stiffened_eos @@ -290,7 +290,7 @@ contains !> Checks constraints on the surface tension parameters. !! Called by s_check_inputs_common for all three stages subroutine s_check_inputs_surface_tension - @:PROHIBIT(.not. f_is_default(sigma) .and. sigma < 0d0, & + @:PROHIBIT(.not. f_is_default(sigma) .and. sigma < 0._wp, & "sigma must be greater than or equal to zero") @:PROHIBIT(.not. f_is_default(sigma) .and. model_eqns /= 3, & @@ -301,9 +301,9 @@ contains !! 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 (any((/bc_${X}$%vb1, bc_${X}$%vb2, bc_${X}$%vb3/) /= 0._wp)) then if (bc_${X}$%beg == -15) then - if (any((/bc_${X}$%${VB2}$, bc_${X}$%${VB3}$/) /= 0d0)) then + if (any((/bc_${X}$%${VB2}$, bc_${X}$%${VB3}$/) /= 0._wp)) then call s_mpi_abort("bc_${X}$%beg must be -15 if "// & "bc_${X}$%${VB2}$ or bc_${X}$%${VB3}$ "// & "is set. Exiting ...") @@ -316,9 +316,9 @@ contains #: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 (any((/bc_${X}$%ve1, bc_${X}$%ve2, bc_${X}$%ve3/) /= 0._wp)) then if (bc_${X}$%end == -15) then - if (any((/bc_${X}$%${VE2}$, bc_${X}$%${VE3}$/) /= 0d0)) then + if (any((/bc_${X}$%${VE2}$, bc_${X}$%${VE3}$/) /= 0._wp)) then call s_mpi_abort("bc_${X}$%end must be -15 if "// & "bc_${X}$%${VE2}$ or bc_${X}$%${VE3}$ "// & "is set. Exiting ...") diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp index 6f1f0d25e6..a8ef8697a6 100644 --- a/src/common/m_constants.fpp +++ b/src/common/m_constants.fpp @@ -11,7 +11,7 @@ module m_constants real(wp), parameter :: dflt_real = -1d6 !< Default real value real(wp), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance real(wp), parameter :: small_alf = 1d-11 !< Small alf tolerance - real(wp), parameter :: pi = 3.141592653589793d0 !< Pi + real(wp), parameter :: pi = 3.141592653589793_wp !< Pi real(wp), parameter :: verysmall = 1.d-12 !< Very small number integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils @@ -25,7 +25,7 @@ module m_constants integer, parameter :: pathlen_max = 400 integer, parameter :: nnode = 4 !< Number of QBMM nodes real(wp), parameter :: capillary_cutoff = 1e-6 !< color function gradient magnitude at which to apply the surface tension fluxes - real(wp), parameter :: acoustic_spatial_support_width = 2.5d0 !< Spatial support width of acoustic source, used in s_source_spatial - real(wp), parameter :: dflt_vcfl_dt = 100d0 !< value of vcfl_dt when viscosity is off for computing adaptive timestep size + real(wp), parameter :: acoustic_spatial_support_width = 2.5_wp !< Spatial support width of acoustic source, used in s_source_spatial + real(wp), parameter :: dflt_vcfl_dt = 100._wp !< value of vcfl_dt when viscosity is off for computing adaptive timestep size end module m_constants diff --git a/src/common/m_eigen_solver.f90 b/src/common/m_eigen_solver.f90 index 3d120fd467..2c24806385 100644 --- a/src/common/m_eigen_solver.f90 +++ b/src/common/m_eigen_solver.f90 @@ -86,7 +86,7 @@ subroutine cbal(nm, nl, ar, ai, low, igh, scale) real(wp) :: c, f, g, r, s, b2, radix logical :: noconv - radix = 16.0d0 + radix = 16.0_wp b2 = radix*radix k = 1 @@ -126,7 +126,7 @@ subroutine cbal(nm, nl, ar, ai, low, igh, scale) do 110 i = 1, l if (i == j) go to 110 - if (ar(j, i) /= 0.0d0 .or. ai(j, i) /= 0.0d0) go to 120 + if (ar(j, i) /= 0.0_wp .or. ai(j, i) /= 0.0_wp) go to 120 110 end do ml = l @@ -143,7 +143,7 @@ subroutine cbal(nm, nl, ar, ai, low, igh, scale) do 150 i = k, l if (i == j) go to 150 - if (ar(i, j) /= 0.0d0 .or. ai(i, j) /= 0.0d0) go to 170 + if (ar(i, j) /= 0.0_wp .or. ai(i, j) /= 0.0_wp) go to 170 150 end do ml = k @@ -152,14 +152,14 @@ subroutine cbal(nm, nl, ar, ai, low, igh, scale) 170 end do ! .......... now balance the submatrix in rows k to l .......... do 180 i = k, l - scale(i) = 1.0d0 + scale(i) = 1.0_wp 180 end do ! .......... iterative loop for norm reduction .......... 190 noconv = .false. do 270 i = k, l - c = 0.0d0 - r = 0.0d0 + c = 0.0_wp + r = 0.0_wp do 200 j = k, l if (j == i) go to 200 @@ -167,9 +167,9 @@ subroutine cbal(nm, nl, ar, ai, low, igh, scale) r = r + dabs(ar(i, j)) + dabs(ai(i, j)) 200 end do ! .......... guard against zero c or r due to underflow .......... - if (c == 0.0d0 .or. r == 0.0d0) go to 270 + if (c == 0.0_wp .or. r == 0.0_wp) go to 270 g = r/radix - f = 1.0d0 + f = 1.0_wp s = c + r 210 if (c >= g) go to 220 f = f*radix @@ -181,8 +181,8 @@ subroutine cbal(nm, nl, ar, ai, low, igh, scale) c = c/b2 go to 230 ! .......... now balance .......... -240 if ((c + r)/f >= 0.95d0*s) go to 270 - g = 1.0d0/f +240 if ((c + r)/f >= 0.95_wp*s) go to 270 + g = 1.0_wp/f scale(i) = scale(i)*f noconv = .true. @@ -237,15 +237,15 @@ subroutine corth(nm, nl, low, igh, ar, ai, ortr, orti) if (la < kp1) go to 200 do 180 ml = kp1, la - h = 0.0d0 - ortr(ml) = 0.0d0 - orti(ml) = 0.0d0 - scale = 0.0d0 + h = 0.0_wp + ortr(ml) = 0.0_wp + orti(ml) = 0.0_wp + scale = 0.0_wp ! .......... scale column (algol tol then not needed) .......... do 90 i = ml, igh scale = scale + dabs(ar(i, ml - 1)) + dabs(ai(i, ml - 1)) 90 end do - if (scale == 0d0) go to 180 + if (scale == 0._wp) go to 180 mp = ml + igh ! .......... for i=igh step -1 until ml do -- .......... do 100 ii = ml, igh @@ -257,19 +257,19 @@ subroutine corth(nm, nl, low, igh, ar, ai, ortr, orti) ! g = dsqrt(h) call pythag(ortr(ml), orti(ml), f) - if (f == 0d0) go to 103 + if (f == 0._wp) go to 103 h = h + f*g g = g/f - ortr(ml) = (1.0d0 + g)*ortr(ml) - orti(ml) = (1.0d0 + g)*orti(ml) + ortr(ml) = (1.0_wp + g)*ortr(ml) + orti(ml) = (1.0_wp + g)*orti(ml) go to 105 103 ortr(ml) = g ar(ml, ml - 1) = scale ! .......... form (i-(u*ut)/h) * a .......... 105 do 130 j = ml, nl - fr = 0.0d0 - fi = 0.0d0 + fr = 0.0_wp + fi = 0.0_wp ! .......... for i=igh step -1 until ml do -- .......... do 110 ii = ml, igh i = mp - ii @@ -288,8 +288,8 @@ subroutine corth(nm, nl, low, igh, ar, ai, ortr, orti) 130 end do ! .......... form (i-(u*ut)/h)*a*(i-(u*ut)/h) .......... do 160 i = 1, igh - fr = 0.0d0 - fi = 0.0d0 + fr = 0.0_wp + fi = 0.0_wp ! .......... for j=igh step -1 until ml do -- .......... do 140 jj = ml, igh j = mp - jj @@ -361,10 +361,10 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) do 101 j = 1, nl ! do 100 i = 1, nl - zr(i, j) = 0.0d0 - zi(i, j) = 0.0d0 + zr(i, j) = 0.0_wp + zi(i, j) = 0.0_wp 100 end do - zr(j, j) = 1.0d0 + zr(j, j) = 1.0_wp 101 end do ! .......... form the matrix of accumulated transformations ! from the information left by corth .......... @@ -375,8 +375,8 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) ! .......... for i=igh-1 step -1 until low+1 do -- .......... 105 do 140 ii = 1, iend i = igh - ii - if (dabs(ortr(i)) == 0d0 .and. dabs(orti(i)) == 0d0) go to 140 - if (dabs(hr(i, i - 1)) == 0d0 .and. dabs(hi(i, i - 1)) == 0d0) go to 140 + if (dabs(ortr(i)) == 0._wp .and. dabs(orti(i)) == 0._wp) go to 140 + if (dabs(hr(i, i - 1)) == 0._wp .and. dabs(hi(i, i - 1)) == 0._wp) go to 140 ! .......... norm below is negative of h formed in corth .......... norm = hr(i, i - 1)*ortr(i) + hi(i, i - 1)*orti(i) ip1 = i + 1 @@ -387,8 +387,8 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) 110 end do ! do 130 j = i, igh - sr = 0.0d0 - si = 0.0d0 + sr = 0.0_wp + si = 0.0_wp ! do 115 k = i, igh sr = sr + ortr(k)*zr(k, j) + orti(k)*zi(k, j) @@ -411,12 +411,12 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) ! do 170 i = l, igh ll = min0(i + 1, igh) - if (dabs(hi(i, i - 1)) == 0d0) go to 170 + if (dabs(hi(i, i - 1)) == 0._wp) go to 170 call pythag(hr(i, i - 1), hi(i, i - 1), norm) yr = hr(i, i - 1)/norm yi = hi(i, i - 1)/norm hr(i, i - 1) = norm - hi(i, i - 1) = 0.0d0 + hi(i, i - 1) = 0.0_wp ! do 155 j = i, nl si = yr*hi(i, j) - yi*hr(i, j) @@ -444,8 +444,8 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) 200 end do ! en = igh - tr = 0.0d0 - ti = 0.0d0 + tr = 0.0_wp + ti = 0.0_wp itn = 30*nl ! .......... search for next eigenvalue .......... 220 if (en < low) go to 680 @@ -469,11 +469,11 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) si = hi(en, en) xr = hr(enm1, en)*hr(en, enm1) xi = hi(enm1, en)*hr(en, enm1) - if (xr == 0.0d0 .and. xi == 0.0d0) go to 340 - yr = (hr(enm1, enm1) - sr)/2.0d0 - yi = (hi(enm1, enm1) - si)/2.0d0 - call csroot(yr**2 - yi**2 + xr, 2.0d0*yr*yi + xi, zzr, zzi) - if (yr*zzr + yi*zzi >= 0.0d0) go to 310 + if (xr == 0.0_wp .and. xi == 0.0_wp) go to 340 + yr = (hr(enm1, enm1) - sr)/2.0_wp + yi = (hi(enm1, enm1) - si)/2.0_wp + call csroot(yr**2 - yi**2 + xr, 2.0_wp*yr*yi + xi, zzr, zzi) + if (yr*zzr + yi*zzi >= 0.0_wp) go to 310 zzr = -zzr zzi = -zzi 310 call cdiv(xr, xi, yr + zzr, yi + zzi, xxr, xxi) @@ -482,7 +482,7 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) go to 340 ! .......... form exceptional shift .......... 320 sr = dabs(hr(en, enm1)) + dabs(hr(enm1, en - 2)) - si = 0.0d0 + si = 0.0_wp ! 340 do 360 i = low, en hr(i, i) = hr(i, i) - sr @@ -498,7 +498,7 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) ! do 500 i = lp1, en sr = hr(i, i - 1) - hr(i, i - 1) = 0.0d0 + hr(i, i - 1) = 0.0_wp call pythag(hr(i - 1, i - 1), hi(i - 1, i - 1), c) call pythag(c, sr, norm) xr = hr(i - 1, i - 1)/norm @@ -506,7 +506,7 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) xi = hi(i - 1, i - 1)/norm wi(i - 1) = xi hr(i - 1, i - 1) = norm - hi(i - 1, i - 1) = 0.0d0 + hi(i - 1, i - 1) = 0.0_wp hi(i, i - 1) = sr/norm ! do 490 j = i, nl @@ -523,12 +523,12 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) 500 end do ! si = hi(en, en) - if (dabs(si) == 0d0) go to 540 + if (dabs(si) == 0._wp) go to 540 call pythag(hr(en, en), si, norm) sr = hr(en, en)/norm si = si/norm hr(en, en) = norm - hi(en, en) = 0.0d0 + hi(en, en) = 0.0_wp if (en == nl) go to 540 ip1 = en + 1 ! @@ -545,7 +545,7 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) ! do 580 i = 1, j yr = hr(i, j - 1) - yi = 0.0d0 + yi = 0.0_wp zzr = hr(i, j) zzi = hi(i, j) if (i == j) go to 560 @@ -568,7 +568,7 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) 590 end do 600 end do ! - if (dabs(si) == 0d0) go to 240 + if (dabs(si) == 0._wp) go to 240 ! do 630 i = 1, en yr = hr(i, en) @@ -594,7 +594,7 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) go to 220 ! .......... all roots found. backsubstitute to find ! vectors of upper triangular form .......... -680 norm = 0.0d0 +680 norm = 0.0_wp ! do i = 1, nl do j = i, nl @@ -603,20 +603,20 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) end do end do ! - if (nl == 1 .or. norm == 0d0) go to 1001 + if (nl == 1 .or. norm == 0._wp) go to 1001 ! .......... for en=nl step -1 until 2 do -- .......... do 800 nn = 2, nl en = nl + 2 - nn xr = wr(en) xi = wi(en) - hr(en, en) = 1.0d0 - hi(en, en) = 0.0d0 + hr(en, en) = 1.0_wp + hi(en, en) = 0.0_wp enm1 = en - 1 ! .......... for i=en-1 step -1 until 1 do -- .......... do 780 ii = 1, enm1 i = en - ii - zzr = 0.0d0 - zzi = 0.0d0 + zzr = 0.0_wp + zzi = 0.0_wp ip1 = i + 1 do 740 j = ip1, en @@ -626,19 +626,19 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) ! yr = xr - wr(i) yi = xi - wi(i) - if (yr /= 0.0d0 .or. yi /= 0.0d0) go to 765 + if (yr /= 0.0_wp .or. yi /= 0.0_wp) go to 765 tst1 = norm yr = tst1 -760 yr = 0.01d0*yr +760 yr = 0.01_wp*yr tst2 = norm + yr if (tst2 > tst1) go to 760 765 continue call cdiv(zzr, zzi, yr, yi, hr(i, en), hi(i, en)) ! .......... overflow control .......... tr = dabs(hr(i, en)) + dabs(hi(i, en)) - if (tr == 0.0d0) go to 780 + if (tr == 0.0_wp) go to 780 tst1 = tr - tst2 = tst1 + 1.0d0/tst1 + tst2 = tst1 + 1.0_wp/tst1 if (tst2 > tst1) go to 780 do 770 j = i, en hr(j, en) = hr(j, en)/tr @@ -667,8 +667,8 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) ml = min0(j, igh) ! do i = low, igh - zzr = 0.0d0 - zzi = 0.0d0 + zzr = 0.0_wp + zzi = 0.0_wp ! do 860 k = low, ml zzr = zzr + zr(i, k)*hr(k, j) - zi(i, k)*hi(k, j) @@ -723,7 +723,7 @@ subroutine cbabk2(nm, nl, low, igh, scale, ml, zr, zi) s = scale(i) ! .......... left hand eigenvectors are back transformed ! if the foregoing statement is replaced by -! s=1.0d0/scale(i). .......... +! s=1.0_wp/scale(i). .......... do 100 j = 1, ml zr(i, j) = zr(i, j)*s zi(i, j) = zi(i, j)*s @@ -764,12 +764,12 @@ subroutine csroot(xr, xi, yr, yi) tr = xr ti = xi call pythag(tr, ti, c) - s = dsqrt(0.5d0*(c + dabs(tr))) - if (tr >= 0.0d0) yr = s - if (ti < 0.0d0) s = -s - if (tr <= 0.0d0) yi = s - if (tr < 0.0d0) yr = 0.5d0*(ti/yi) - if (tr > 0.0d0) yi = 0.5d0*(ti/yr) + s = dsqrt(0.5_wp*(c + dabs(tr))) + if (tr >= 0.0_wp) yr = s + if (ti < 0.0_wp) s = -s + if (tr <= 0.0_wp) yi = s + if (tr < 0.0_wp) yr = 0.5_wp*(ti/yi) + if (tr > 0.0_wp) yi = 0.5_wp*(ti/yr) return end subroutine csroot @@ -783,15 +783,15 @@ subroutine cdiv(ar, ai, br, bi, cr, ci) ! (ar + i*ai) * (br - i*bi) /(br**2 + bi**2) ! ((ar*br + i*ai*br) + (-i*ar*bi + ai*bi)) /(br**2 + bi**2) ! (ar*br + ai*bi + i*(ai*br - ar*bi)) /(br**2 + bi**2) - ! cr = (ar*br + ai*bi) / (br**2d0 + bi**2d0) - ! ci = (ai*br - ar*bi) / (br**2d0 + bi**2d0) + ! cr = (ar*br + ai*bi) / (br**2._wp + bi**2._wp) + ! ci = (ai*br - ar*bi) / (br**2._wp + bi**2._wp) s = dabs(br) + dabs(bi) ars = ar/s ais = ai/s brs = br/s bis = bi/s - s = brs**2d0 + bis**2d0 + s = brs**2._wp + bis**2._wp cr = (ars*brs + ais*bis)/s ci = (ais*brs - ars*bis)/s return @@ -805,15 +805,15 @@ subroutine pythag(a, b, c) ! real(wp) :: p, r, s, t, u p = dmax1(dabs(a), dabs(b)) - if (p == 0.0d0) go to 20 + if (p == 0.0_wp) go to 20 r = (dmin1(dabs(a), dabs(b))/p)**2 10 continue - t = 4.0d0 + r - if (t == 4.0d0) go to 20 + t = 4.0_wp + r + if (t == 4.0_wp) go to 20 s = r/t - u = 1.0d0 + 2.0d0*s + u = 1.0_wp + 2.0_wp*s p = u*p - r = (s/u)**2d0*r + r = (s/u)**2._wp*r go to 10 20 c = p return diff --git a/src/common/m_finite_differences.fpp b/src/common/m_finite_differences.fpp index 1ae6d1ee82..fd0323a795 100644 --- a/src/common/m_finite_differences.fpp +++ b/src/common/m_finite_differences.fpp @@ -22,18 +22,18 @@ contains do z = iz_s%beg, iz_s%end if (x == ix_s%beg) then - divergence = (-3d0*fields(1)%sf(x, y, z) + 4d0*fields(1)%sf(x + 1, y, z) - fields(1)%sf(x + 2, y, z))/(x_cc(x + 2) - x_cc(x)) + divergence = (-3._wp*fields(1)%sf(x, y, z) + 4._wp*fields(1)%sf(x + 1, y, z) - fields(1)%sf(x + 2, y, z))/(x_cc(x + 2) - x_cc(x)) else if (x == ix_s%end) then - divergence = (+3d0*fields(1)%sf(x, y, z) - 4d0*fields(1)%sf(x - 1, y, z) + fields(1)%sf(x - 2, y, z))/(x_cc(x) - x_cc(x - 2)) + divergence = (+3._wp*fields(1)%sf(x, y, z) - 4._wp*fields(1)%sf(x - 1, y, z) + fields(1)%sf(x - 2, y, z))/(x_cc(x) - x_cc(x - 2)) else divergence = (fields(1)%sf(x + 1, y, z) - fields(1)%sf(x - 1, y, z))/(x_cc(x + 1) - x_cc(x - 1)) end if if (n > 0) then if (y == iy_s%beg) then - divergence = divergence + (-3d0*fields(2)%sf(x, y, z) + 4d0*fields(2)%sf(x, y + 1, z) - fields(2)%sf(x, y + 2, z))/(y_cc(y + 2) - y_cc(y)) + divergence = divergence + (-3._wp*fields(2)%sf(x, y, z) + 4._wp*fields(2)%sf(x, y + 1, z) - fields(2)%sf(x, y + 2, z))/(y_cc(y + 2) - y_cc(y)) else if (y == iy_s%end) then - divergence = divergence + (+3d0*fields(2)%sf(x, y, z) - 4d0*fields(2)%sf(x, y - 1, z) + fields(2)%sf(x, y - 2, z))/(y_cc(y) - y_cc(y - 2)) + divergence = divergence + (+3._wp*fields(2)%sf(x, y, z) - 4._wp*fields(2)%sf(x, y - 1, z) + fields(2)%sf(x, y - 2, z))/(y_cc(y) - y_cc(y - 2)) else divergence = divergence + (fields(2)%sf(x, y + 1, z) - fields(2)%sf(x, y - 1, z))/(y_cc(y + 1) - y_cc(y - 1)) end if @@ -41,9 +41,9 @@ contains if (p > 0) then if (z == iz_s%beg) then - divergence = divergence + (-3d0*fields(3)%sf(x, y, z) + 4d0*fields(3)%sf(x, y, z + 1) - fields(3)%sf(x, y, z + 2))/(z_cc(z + 2) - z_cc(z)) + divergence = divergence + (-3._wp*fields(3)%sf(x, y, z) + 4._wp*fields(3)%sf(x, y, z + 1) - fields(3)%sf(x, y, z + 2))/(z_cc(z + 2) - z_cc(z)) else if (z == iz_s%end) then - divergence = divergence + (+3d0*fields(3)%sf(x, y, z) - 4d0*fields(3)%sf(x, y, z - 1) + fields(2)%sf(x, y, z - 2))/(z_cc(z) - z_cc(z - 2)) + divergence = divergence + (+3._wp*fields(3)%sf(x, y, z) - 4._wp*fields(3)%sf(x, y, z - 1) + fields(2)%sf(x, y, z - 2))/(z_cc(z) - z_cc(z - 2)) else divergence = divergence + (fields(3)%sf(x, y, z + 1) - fields(3)%sf(x, y, z - 1))/(z_cc(z + 1) - z_cc(z - 1)) end if @@ -96,25 +96,25 @@ contains ! Computing the 1st order finite-difference coefficients if (fd_order_in == 1) then do i = lB, lE - fd_coeff_s(-1, i) = 0d0 - fd_coeff_s(0, i) = -1d0/(s_cc(i + 1) - s_cc(i)) + fd_coeff_s(-1, i) = 0._wp + fd_coeff_s(0, i) = -1._wp/(s_cc(i + 1) - s_cc(i)) fd_coeff_s(1, i) = -fd_coeff_s(0, i) end do ! Computing the 2nd order finite-difference coefficients elseif (fd_order_in == 2) then do i = lB, lE - fd_coeff_s(-1, i) = -1d0/(s_cc(i + 1) - s_cc(i - 1)) - fd_coeff_s(0, i) = 0d0 + fd_coeff_s(-1, i) = -1._wp/(s_cc(i + 1) - s_cc(i - 1)) + fd_coeff_s(0, i) = 0._wp fd_coeff_s(1, i) = -fd_coeff_s(-1, i) end do ! Computing the 4th order finite-difference coefficients else do i = lB, lE - fd_coeff_s(-2, i) = 1d0/(s_cc(i - 2) - 8d0*s_cc(i - 1) - s_cc(i + 2) + 8d0*s_cc(i + 1)) - fd_coeff_s(-1, i) = -8d0*fd_coeff_s(-2, i) - fd_coeff_s(0, i) = 0d0 + fd_coeff_s(-2, i) = 1._wp/(s_cc(i - 2) - 8._wp*s_cc(i - 1) - s_cc(i + 2) + 8._wp*s_cc(i + 1)) + fd_coeff_s(-1, i) = -8._wp*fd_coeff_s(-2, i) + fd_coeff_s(0, i) = 0._wp fd_coeff_s(1, i) = -fd_coeff_s(-1, i) fd_coeff_s(2, i) = -fd_coeff_s(-2, i) end do diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp index 50432eabd8..a4062ab5cb 100644 --- a/src/common/m_helper.fpp +++ b/src/common/m_helper.fpp @@ -46,30 +46,30 @@ contains !! @param ntmp is the output number bubble density subroutine s_comp_n_from_prim(vftmp, Rtmp, ntmp, weights) !$acc routine seq - real(kind(0.d0)), intent(in) :: vftmp - real(kind(0.d0)), dimension(nb), intent(in) :: Rtmp - real(kind(0.d0)), intent(out) :: ntmp - real(kind(0.d0)), dimension(nb), intent(in) :: weights + real(wp), intent(in) :: vftmp + real(wp), dimension(nb), intent(in) :: Rtmp + real(wp), intent(out) :: ntmp + real(wp), dimension(nb), intent(in) :: weights - real(kind(0.d0)) :: R3 + real(wp) :: R3 - R3 = dot_product(weights, Rtmp**3.d0) - ntmp = (3.d0/(4.d0*pi))*vftmp/R3 + R3 = dot_product(weights, Rtmp**3._wp) + ntmp = (3._wp/(4._wp*pi))*vftmp/R3 end subroutine s_comp_n_from_prim subroutine s_comp_n_from_cons(vftmp, nRtmp, ntmp, weights) !$acc routine seq - real(kind(0.d0)), intent(in) :: vftmp - real(kind(0.d0)), dimension(nb), intent(in) :: nRtmp - real(kind(0.d0)), intent(out) :: ntmp - real(kind(0.d0)), dimension(nb), intent(in) :: weights + real(wp), intent(in) :: vftmp + real(wp), dimension(nb), intent(in) :: nRtmp + real(wp), intent(out) :: ntmp + real(wp), dimension(nb), intent(in) :: weights - real(kind(0.d0)) :: nR3 + real(wp) :: nR3 - nR3 = dot_product(weights, nRtmp**3.d0) - ntmp = DSQRT((4.d0*pi/3.d0)*nR3/vftmp) - !ntmp = (3.d0/(4.d0*pi))*0.00001 + nR3 = dot_product(weights, nRtmp**3._wp) + ntmp = DSQRT((4._wp*pi/3._wp)*nR3/vftmp) + !ntmp = (3._wp/(4._wp*pi))*0.00001 !print *, "nbub", ntmp @@ -109,13 +109,13 @@ contains subroutine s_initialize_nonpoly integer :: ir - real(kind(0.d0)) :: rhol0, pl0, uu, D_m, temp, omega_ref - real(kind(0.d0)), dimension(Nb) :: chi_vw0, cp_m0, k_m0, rho_m0, x_vw + real(wp) :: rhol0, pl0, uu, D_m, temp, omega_ref + real(wp), dimension(Nb) :: chi_vw0, cp_m0, k_m0, rho_m0, x_vw - real(kind(0.d0)), parameter :: k_poly = 1.d0 !< + real(wp), parameter :: k_poly = 1._wp !< !! polytropic index used to compute isothermal natural frequency - real(kind(0.d0)), parameter :: Ru = 8314.d0 !< + real(wp), parameter :: Ru = 8314._wp !< !! universal gas constant rhol0 = rhoref @@ -150,42 +150,42 @@ contains k_n(:) = fluid_pp(2)%k_v gamma_m = gamma_n - if (thermal == 2) gamma_m = 1.d0 + if (thermal == 2) gamma_m = 1._wp - temp = 293.15d0 + temp = 293.15_wp D_m = 0.242d-4 uu = DSQRT(pl0/rhol0) - omega_ref = 3.d0*k_poly*Ca + 2.d0*(3.d0*k_poly - 1.d0)/Web + omega_ref = 3._wp*k_poly*Ca + 2._wp*(3._wp*k_poly - 1._wp)/Web !!! thermal properties !!! ! gas constants R_n = Ru/M_n R_v = Ru/M_v ! phi_vn & phi_nv (phi_nn = phi_vv = 1) - phi_vn = (1.d0 + DSQRT(mu_v/mu_n)*(M_n/M_v)**(0.25d0))**2 & - /(DSQRT(8.d0)*DSQRT(1.d0 + M_v/M_n)) - phi_nv = (1.d0 + DSQRT(mu_n/mu_v)*(M_v/M_n)**(0.25d0))**2 & - /(DSQRT(8.d0)*DSQRT(1.d0 + M_n/M_v)) + phi_vn = (1._wp + DSQRT(mu_v/mu_n)*(M_n/M_v)**(0.25_wp))**2 & + /(DSQRT(8._wp)*DSQRT(1._wp + M_v/M_n)) + phi_nv = (1._wp + DSQRT(mu_n/mu_v)*(M_v/M_n)**(0.25_wp))**2 & + /(DSQRT(8._wp)*DSQRT(1._wp + M_n/M_v)) ! internal bubble pressure - pb0 = pl0 + 2.d0*ss/(R0ref*R0) + pb0 = pl0 + 2._wp*ss/(R0ref*R0) ! mass fraction of vapor - chi_vw0 = 1.d0/(1.d0 + R_v/R_n*(pb0/pv - 1.d0)) + chi_vw0 = 1._wp/(1._wp + R_v/R_n*(pb0/pv - 1._wp)) ! specific heat for gas/vapor mixture - cp_m0 = chi_vw0*R_v*gamma_v/(gamma_v - 1.d0) & - + (1.d0 - chi_vw0)*R_n*gamma_n/(gamma_n - 1.d0) + cp_m0 = chi_vw0*R_v*gamma_v/(gamma_v - 1._wp) & + + (1._wp - chi_vw0)*R_n*gamma_n/(gamma_n - 1._wp) ! mole fraction of vapor x_vw = M_n*chi_vw0/(M_v + (M_n - M_v)*chi_vw0) ! thermal conductivity for gas/vapor mixture - k_m0 = x_vw*k_v/(x_vw + (1.d0 - x_vw)*phi_vn) & - + (1.d0 - x_vw)*k_n/(x_vw*phi_nv + 1.d0 - x_vw) + k_m0 = x_vw*k_v/(x_vw + (1._wp - x_vw)*phi_vn) & + + (1._wp - x_vw)*k_n/(x_vw*phi_nv + 1._wp - x_vw) ! mixture density rho_m0 = pv/(chi_vw0*R_v*temp) ! mass of gas/vapor computed using dimensional quantities - mass_n0 = 4.d0*(pb0 - pv)*pi/(3.d0*R_n*temp*rhol0)*R0**3 - mass_v0 = 4.d0*pv*pi/(3.d0*R_v*temp*rhol0)*R0**3 + mass_n0 = 4._wp*(pb0 - pv)*pi/(3._wp*R_n*temp*rhol0)*R0**3 + mass_v0 = 4._wp*pv*pi/(3._wp*R_v*temp*rhol0)*R0**3 ! Peclet numbers Pe_T = rho_m0*cp_m0*uu*R0ref/k_m0 Pe_c = uu*R0ref/D_m @@ -200,22 +200,22 @@ contains k_v = k_v/k_m0 pb0 = pb0/pl0 pv = pv/pl0 - Tw = 1.d0 - pl0 = 1.d0 + Tw = 1._wp + pl0 = 1._wp - rhoref = 1.d0 - pref = 1.d0 + rhoref = 1._wp + pref = 1._wp !end if ! natural frequencies - omegaN = DSQRT(3.d0*k_poly*Ca + 2.d0*(3.d0*k_poly - 1.d0)/(Web*R0))/R0 + omegaN = DSQRT(3._wp*k_poly*Ca + 2._wp*(3._wp*k_poly - 1._wp)/(Web*R0))/R0 do ir = 1, Nb call s_transcoeff(omegaN(ir)*R0(ir), Pe_T(ir)*R0(ir), & Re_trans_T(ir), Im_trans_T(ir)) call s_transcoeff(omegaN(ir)*R0(ir), Pe_c*R0(ir), & Re_trans_c(ir), Im_trans_c(ir)) end do - Im_trans_T = 0d0 + Im_trans_T = 0._wp end subroutine s_initialize_nonpoly @@ -226,17 +226,17 @@ contains !! @param Im_trans Imaginary part of the transport coefficients subroutine s_transcoeff(omega, peclet, Re_trans, Im_trans) - real(kind(0.d0)), intent(in) :: omega, peclet - real(kind(0.d0)), intent(out) :: Re_trans, Im_trans + real(wp), intent(in) :: omega, peclet + real(wp), intent(out) :: Re_trans, Im_trans complex :: trans, c1, c2, c3 complex :: imag = (0., 1.) - real(kind(0.d0)) :: f_transcoeff + real(wp) :: f_transcoeff c1 = imag*omega*peclet c2 = CSQRT(c1) c3 = (CEXP(c2) - CEXP(-c2))/(CEXP(c2) + CEXP(-c2)) ! TANH(c2) - trans = ((c2/c3 - 1.d0)**(-1) - 3.d0/c1)**(-1) ! transfer function + trans = ((c2/c3 - 1._wp)**(-1) - 3._wp/c1)**(-1) ! transfer function Re_trans = dble(trans) Im_trans = aimag(trans) @@ -256,8 +256,8 @@ contains subroutine s_simpson integer :: ir - real(kind(0.d0)) :: R0mn, R0mx, dphi, tmp, sd - real(kind(0.d0)), dimension(nb) :: phi + real(wp) :: R0mn, R0mx, dphi, tmp, sd + real(wp), dimension(nb) :: phi ! nondiml. min. & max. initial radii for numerical quadrature !sd = 0.05D0 @@ -273,8 +273,8 @@ contains !R0mx = 150.D0 sd = poly_sigma - R0mn = 0.8d0*DEXP(-2.8d0*sd) - R0mx = 0.2d0*DEXP(9.5d0*sd) + 1.d0 + R0mn = 0.8_wp*DEXP(-2.8_wp*sd) + R0mx = 0.2_wp*DEXP(9.5_wp*sd) + 1._wp ! phi = ln( R0 ) & return R0 do ir = 1, nb @@ -287,17 +287,17 @@ contains ! weights for quadrature using Simpson's rule do ir = 2, nb - 1 ! Gaussian - tmp = DEXP(-0.5d0*(phi(ir)/sd)**2)/DSQRT(2.d0*pi)/sd + tmp = DEXP(-0.5_wp*(phi(ir)/sd)**2)/DSQRT(2._wp*pi)/sd if (mod(ir, 2) == 0) then - weight(ir) = tmp*4.d0*dphi/3.d0 + weight(ir) = tmp*4._wp*dphi/3._wp else - weight(ir) = tmp*2.d0*dphi/3.d0 + weight(ir) = tmp*2._wp*dphi/3._wp end if end do - tmp = DEXP(-0.5d0*(phi(1)/sd)**2)/DSQRT(2.d0*pi)/sd - weight(1) = tmp*dphi/3.d0 - tmp = DEXP(-0.5d0*(phi(nb)/sd)**2)/DSQRT(2.d0*pi)/sd - weight(nb) = tmp*dphi/3.d0 + tmp = DEXP(-0.5_wp*(phi(1)/sd)**2)/DSQRT(2._wp*pi)/sd + weight(1) = tmp*dphi/3._wp + tmp = DEXP(-0.5_wp*(phi(nb)/sd)**2)/DSQRT(2._wp*pi)/sd + weight(nb) = tmp*dphi/3._wp end subroutine s_simpson !> This procedure computes the cross product of two vectors. @@ -336,34 +336,34 @@ contains t_mat4x4 :: sc, rz, rx, ry, tr, out_matrix sc = transpose(reshape([ & - p%scale(1), 0d0, 0d0, 0d0, & - 0d0, p%scale(2), 0d0, 0d0, & - 0d0, 0d0, p%scale(3), 0d0, & - 0d0, 0d0, 0d0, 1d0], shape(sc))) + p%scale(1), 0._wp, 0._wp, 0._wp, & + 0._wp, p%scale(2), 0._wp, 0._wp, & + 0._wp, 0._wp, p%scale(3), 0._wp, & + 0._wp, 0._wp, 0._wp, 1._wp], shape(sc))) rz = transpose(reshape([ & - cos(p%rotate(3)), -sin(p%rotate(3)), 0d0, 0d0, & - sin(p%rotate(3)), cos(p%rotate(3)), 0d0, 0d0, & - 0d0, 0d0, 1d0, 0d0, & - 0d0, 0d0, 0d0, 1d0], shape(rz))) + cos(p%rotate(3)), -sin(p%rotate(3)), 0._wp, 0._wp, & + sin(p%rotate(3)), cos(p%rotate(3)), 0._wp, 0._wp, & + 0._wp, 0._wp, 1._wp, 0._wp, & + 0._wp, 0._wp, 0._wp, 1._wp], shape(rz))) rx = transpose(reshape([ & - 1d0, 0d0, 0d0, 0d0, & - 0d0, cos(p%rotate(1)), -sin(p%rotate(1)), 0d0, & - 0d0, sin(p%rotate(1)), cos(p%rotate(1)), 0d0, & - 0d0, 0d0, 0d0, 1d0], shape(rx))) + 1._wp, 0._wp, 0._wp, 0._wp, & + 0._wp, cos(p%rotate(1)), -sin(p%rotate(1)), 0._wp, & + 0._wp, sin(p%rotate(1)), cos(p%rotate(1)), 0._wp, & + 0._wp, 0._wp, 0._wp, 1._wp], shape(rx))) ry = transpose(reshape([ & - cos(p%rotate(2)), 0d0, sin(p%rotate(2)), 0d0, & - 0d0, 1d0, 0d0, 0d0, & - -sin(p%rotate(2)), 0d0, cos(p%rotate(2)), 0d0, & - 0d0, 0d0, 0d0, 1d0], shape(ry))) + cos(p%rotate(2)), 0._wp, sin(p%rotate(2)), 0._wp, & + 0._wp, 1._wp, 0._wp, 0._wp, & + -sin(p%rotate(2)), 0._wp, cos(p%rotate(2)), 0._wp, & + 0._wp, 0._wp, 0._wp, 1._wp], shape(ry))) tr = transpose(reshape([ & - 1d0, 0d0, 0d0, p%translate(1), & - 0d0, 1d0, 0d0, p%translate(2), & - 0d0, 0d0, 1d0, p%translate(3), & - 0d0, 0d0, 0d0, 1d0], shape(tr))) + 1._wp, 0._wp, 0._wp, p%translate(1), & + 0._wp, 1._wp, 0._wp, p%translate(2), & + 0._wp, 0._wp, 1._wp, p%translate(3), & + 0._wp, 0._wp, 0._wp, 1._wp], shape(tr))) out_matrix = matmul(tr, matmul(ry, matmul(rx, matmul(rz, sc)))) @@ -379,7 +379,7 @@ contains real(wp), dimension(1:4) :: tmp - tmp = matmul(matrix, [vec(1), vec(2), vec(3), 1d0]) + tmp = matmul(matrix, [vec(1), vec(2), vec(3), 1._wp]) vec = tmp(1:3) end subroutine s_transform_vec @@ -429,8 +429,8 @@ contains integer :: i, j if (size(model%trs) == 0) then - bbox%min = 0d0 - bbox%max = 0d0 + bbox%min = 0._wp + bbox%max = 0._wp return end if diff --git a/src/common/m_helper_basic.f90 b/src/common/m_helper_basic.f90 index bddc0d130c..b5483998bb 100644 --- a/src/common/m_helper_basic.f90 +++ b/src/common/m_helper_basic.f90 @@ -40,7 +40,7 @@ logical function f_approx_equal(a, b, tol_input) result(res) if (a == b) then res = .true. - else if (a == 0d0 .or. b == 0d0 .or. (abs(a) + abs(b) < tiny(a))) then + else if (a == 0._wp .or. b == 0._wp .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) diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 6afece1cb0..2fe110d92c 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -77,15 +77,15 @@ contains subroutine s_initialize_phasechange_module ! variables used in the calculation of the saturation curves for fluids 1 and 2 A = (gs_min(lp)*cvs(lp) - gs_min(vp)*cvs(vp) & - + qvps(vp) - qvps(lp))/((gs_min(vp) - 1.0d0)*cvs(vp)) + + qvps(vp) - qvps(lp))/((gs_min(vp) - 1.0_wp)*cvs(vp)) - B = (qvs(lp) - qvs(vp))/((gs_min(vp) - 1.0d0)*cvs(vp)) + B = (qvs(lp) - qvs(vp))/((gs_min(vp) - 1.0_wp)*cvs(vp)) C = (gs_min(vp)*cvs(vp) - gs_min(lp)*cvs(lp)) & - /((gs_min(vp) - 1.0d0)*cvs(vp)) + /((gs_min(vp) - 1.0_wp)*cvs(vp)) - D = ((gs_min(lp) - 1.0d0)*cvs(lp)) & - /((gs_min(vp) - 1.0d0)*cvs(vp)) + D = ((gs_min(lp) - 1.0_wp)*cvs(lp)) & + /((gs_min(vp) - 1.0_wp)*cvs(vp)) end subroutine s_initialize_phasechange_module @@ -97,11 +97,11 @@ contains subroutine s_infinite_relaxation_k(q_cons_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf - real(kind(0.0d0)) :: pS, pSOV, pSSL !< equilibrium pressure for mixture, overheated vapor, and subcooled liquid - real(kind(0.0d0)) :: TS, TSOV, TSSL, TSatOV, TSatSL !< equilibrium temperature for mixture, overheated vapor, and subcooled liquid. Saturation Temperatures at overheated vapor and subcooled liquid - real(kind(0.0d0)) :: rhoe, dynE, rhos !< total internal energy, kinetic energy, and total entropy - real(kind(0.0d0)) :: rho, rM, m1, m2, MCT !< total density, total reacting mass, individual reacting masses - real(kind(0.0d0)) :: TvF !< total volume fraction + real(kind(0.0_wp)) :: pS, pSOV, pSSL !< equilibrium pressure for mixture, overheated vapor, and subcooled liquid + real(kind(0.0_wp)) :: TS, TSOV, TSSL, TSatOV, TSatSL !< equilibrium temperature for mixture, overheated vapor, and subcooled liquid. Saturation Temperatures at overheated vapor and subcooled liquid + real(kind(0.0_wp)) :: rhoe, dynE, rhos !< total internal energy, kinetic energy, and total entropy + real(kind(0.0_wp)) :: rho, rM, m1, m2, MCT !< total density, total reacting mass, individual reacting masses + real(kind(0.0_wp)) :: TvF !< total volume fraction !$acc declare create(pS, pSOV, pSSL, TS, TSOV, TSatOV, TSatSL, TSSL, rhoe, dynE, rhos, rho, rM, m1, m2, MCT, TvF) @@ -118,7 +118,7 @@ contains do k = 0, n do l = 0, p - rho = 0.0d0; TvF = 0.0d0 + rho = 0.0_wp; TvF = 0.0_wp !$acc loop seq do i = 1, num_fluids @@ -144,7 +144,7 @@ contains m2 = q_cons_vf(vp + contxb - 1)%sf(j, k, l) ! kinetic energy as an auxiliary variable to the calculation of the total internal energy - dynE = 0.0d0 + dynE = 0.0_wp !$acc loop seq do i = momxb, momxe @@ -177,7 +177,7 @@ contains q_cons_vf(lp + contxb - 1)%sf(j, k, l) = mixM*rM ! tranferring the total mass to vapor - q_cons_vf(vp + contxb - 1)%sf(j, k, l) = (1.0d0 - mixM)*rM + q_cons_vf(vp + contxb - 1)%sf(j, k, l) = (1.0_wp - mixM)*rM ! calling pT-equilibrium for overheated vapor, which is MFL = 0 call s_infinite_pt_relaxation_k(j, k, l, 0, pSOV, p_infOV, rM, q_cons_vf, rhoe, TSOV) @@ -187,7 +187,7 @@ contains ! subcooled liquid case ! tranferring the total mass to liquid - q_cons_vf(lp + contxb - 1)%sf(j, k, l) = (1.0d0 - mixM)*rM + q_cons_vf(lp + contxb - 1)%sf(j, k, l) = (1.0_wp - mixM)*rM ! depleting the mass of vapor q_cons_vf(vp + contxb - 1)%sf(j, k, l) = mixM*rM @@ -211,7 +211,7 @@ contains q_cons_vf(lp + contxb - 1)%sf(j, k, l) = mixM*rM ! correcting the vapor partial density - q_cons_vf(vp + contxb - 1)%sf(j, k, l) = (1.0d0 - mixM)*rM + q_cons_vf(vp + contxb - 1)%sf(j, k, l) = (1.0_wp - mixM)*rM elseif (TSSL < TSatSL) then @@ -222,7 +222,7 @@ contains TS = TSSL ! correcting the liquid partial density - q_cons_vf(lp + contxb - 1)%sf(j, k, l) = (1.0d0 - mixM)*rM + q_cons_vf(lp + contxb - 1)%sf(j, k, l) = (1.0_wp - mixM)*rM ! correcting the vapor partial density q_cons_vf(vp + contxb - 1)%sf(j, k, l) = mixM*rM @@ -247,7 +247,7 @@ contains ! entropy sk(1:num_fluids) = cvs(1:num_fluids)*DLOG((TS**gs_min(1:num_fluids)) & - /((pS + ps_inf(1:num_fluids))**(gs_min(1:num_fluids) - 1.0d0))) + qvps(1:num_fluids) + /((pS + ps_inf(1:num_fluids))**(gs_min(1:num_fluids) - 1.0_wp))) + qvps(1:num_fluids) ! enthalpy hk(1:num_fluids) = gs_min(1:num_fluids)*cvs(1:num_fluids)*TS & @@ -266,7 +266,7 @@ contains *cvs(1:num_fluids)*TS + qvs(1:num_fluids) ! calculating volume fractions, internal energies, and total entropy - rhos = 0.0d0 + rhos = 0.0_wp !$acc loop seq do i = 1, num_fluids @@ -302,21 +302,21 @@ contains ! initializing variables integer, intent(in) :: j, k, l, MFL - real(kind(0.0d0)), intent(out) :: pS - real(kind(0.0d0)), dimension(num_fluids), intent(out) :: p_infpT - real(kind(0.0d0)), intent(in) :: rM + real(kind(0.0_wp)), intent(out) :: pS + real(kind(0.0_wp)), dimension(num_fluids), intent(out) :: p_infpT + real(kind(0.0_wp)), intent(in) :: rM type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf - real(kind(0.0d0)), intent(in) :: rhoe - real(kind(0.0d0)), intent(out) :: TS + real(kind(0.0_wp)), intent(in) :: rhoe + real(kind(0.0_wp)), intent(out) :: TS integer, dimension(num_fluids) :: ig !< flags to toggle the inclusion of fluids for the pT-equilibrium - real(kind(0.0d0)), dimension(num_fluids) :: pk !< individual initial pressures - real(kind(0.0d0)) :: gp, gpp, hp, pO, mCP, mQ !< variables for the Newton Solver + real(kind(0.0_wp)), dimension(num_fluids) :: pk !< individual initial pressures + real(kind(0.0_wp)) :: gp, gpp, hp, pO, mCP, mQ !< variables for the Newton Solver integer :: i, ns !< generic loop iterators ! auxiliary variables for the pT-equilibrium solver - mCP = 0.0d0; mQ = 0.0d0; p_infpT = ps_inf; + mCP = 0.0_wp; mQ = 0.0_wp; p_infpT = ps_inf; ! Performing tests before initializing the pT-equilibrium !$acc loop seq do i = 1, num_fluids @@ -330,16 +330,16 @@ contains end do ! Checking energy constraint - if ((rhoe - mQ - minval(p_infpT)) < 0.0d0) then + if ((rhoe - mQ - minval(p_infpT)) < 0.0_wp) then if ((MFL == 0) .or. (MFL == 1)) then ! Assigning zero values for mass depletion cases ! pressure - pS = 0.0d0 + pS = 0.0_wp ! temperature - TS = 0.0d0 + TS = 0.0_wp return end if @@ -348,7 +348,7 @@ contains ! calculating initial estimate for pressure in the pT-relaxation procedure. I will also use this variable to ! iterate over the Newton's solver - pO = 0.0d0 + pO = 0.0_wp ! Maybe improve this condition afterwards. As long as the initial guess is in between -min(ps_inf) ! and infinity, a solution should be able to be found. @@ -366,23 +366,23 @@ contains pO = pS ! updating functions used in the Newton's solver - gpp = 0.0d0; gp = 0.0d0; hp = 0.0d0 + gpp = 0.0_wp; gp = 0.0_wp; hp = 0.0_wp !$acc loop seq do i = 1, num_fluids - gp = gp + (gs_min(i) - 1.0d0)*q_cons_vf(i + contxb - 1)%sf(j, k, l)*cvs(i) & + gp = gp + (gs_min(i) - 1.0_wp)*q_cons_vf(i + contxb - 1)%sf(j, k, l)*cvs(i) & *(rhoe + pS - mQ)/(mCP*(pS + p_infpT(i))) - gpp = gpp + (gs_min(i) - 1.0d0)*q_cons_vf(i + contxb - 1)%sf(j, k, l)*cvs(i) & + gpp = gpp + (gs_min(i) - 1.0_wp)*q_cons_vf(i + contxb - 1)%sf(j, k, l)*cvs(i) & *(p_infpT(i) - rhoe + mQ)/(mCP*(pS + p_infpT(i))**2) end do - hp = 1.0d0/(rhoe + pS - mQ) + 1.0d0/(pS + minval(p_infpT)) + hp = 1.0_wp/(rhoe + pS - mQ) + 1.0_wp/(pS + minval(p_infpT)) ! updating common pressure for the newton solver - pS = pO + ((1.0d0 - gp)/gpp)/(1.0d0 - (1.0d0 - gp + DABS(1.0d0 - gp)) & - /(2.0d0*gpp)*hp) + pS = pO + ((1.0_wp - gp)/gpp)/(1.0_wp - (1.0_wp - gp + DABS(1.0_wp - gp)) & + /(2.0_wp*gpp)*hp) end do ! common temperature @@ -405,17 +405,17 @@ contains !$acc routine seq integer, intent(in) :: j, k, l - real(kind(0.0d0)), intent(inout) :: pS - real(kind(0.0d0)), dimension(num_fluids), intent(in) :: p_infpT - real(kind(0.0d0)), intent(in) :: rhoe + real(kind(0.0_wp)), intent(inout) :: pS + real(kind(0.0_wp)), dimension(num_fluids), intent(in) :: p_infpT + real(kind(0.0_wp)), intent(in) :: rhoe type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf - real(kind(0.0d0)), intent(inout) :: TS + real(kind(0.0_wp)), intent(inout) :: TS - real(kind(0.0d0)), dimension(num_fluids) :: p_infpTg !< stiffness for the participating fluids for pTg-equilibrium - real(kind(0.0d0)), dimension(2, 2) :: Jac, InvJac, TJac !< matrices for the Newton Solver - real(kind(0.0d0)), dimension(2) :: R2D, DeltamP !< residual and correction array - real(kind(0.0d0)) :: Om ! underrelaxation factor - real(kind(0.0d0)) :: mCP, mCPD, mCVGP, mCVGP2, mQ, mQD ! auxiliary variables for the pTg-solver + real(kind(0.0_wp)), dimension(num_fluids) :: p_infpTg !< stiffness for the participating fluids for pTg-equilibrium + real(kind(0.0_wp)), dimension(2, 2) :: Jac, InvJac, TJac !< matrices for the Newton Solver + real(kind(0.0_wp)), dimension(2) :: R2D, DeltamP !< residual and correction array + real(kind(0.0_wp)) :: Om ! underrelaxation factor + real(kind(0.0_wp)) :: mCP, mCPD, mCVGP, mCVGP2, mQ, mQD ! auxiliary variables for the pTg-solver !< Generic loop iterators integer :: i, ns @@ -429,10 +429,10 @@ contains p_infpTg = p_infpT - if (((pS < 0.0d0) .and. ((q_cons_vf(lp + contxb - 1)%sf(j, k, l) & + if (((pS < 0.0_wp) .and. ((q_cons_vf(lp + contxb - 1)%sf(j, k, l) & + q_cons_vf(vp + contxb - 1)%sf(j, k, l)) > ((rhoe & - gs_min(lp)*ps_inf(lp)/(gs_min(lp) - 1))/qvs(lp)))) .or. & - ((pS >= 0.0d0) .and. (pS < 1.0d-1))) then + ((pS >= 0.0_wp) .and. (pS < 1.0d-1))) then ! improve this initial condition pS = 1.0d4 @@ -444,8 +444,8 @@ contains ! for the residual, and how to do it adequately. ! Dummy guess to start the pTg-equilibrium problem. ! improve this initial condition - R2D(1) = 0.0d0; R2D(2) = 0.0d0 - DeltamP(1) = 0.0d0; DeltamP(2) = 0.0d0 + R2D(1) = 0.0_wp; R2D(2) = 0.0_wp + DeltamP(1) = 0.0_wp; DeltamP(2) = 0.0_wp do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) & .or. (ns == 0)) @@ -454,7 +454,7 @@ contains ns = ns + 1 ! Auxiliary variables to help in the calculation of the residue - mCP = 0.0d0; mCPD = 0.0d0; mCVGP = 0.0d0; mCVGP2 = 0.0d0; mQ = 0.0d0; mQD = 0.0d0 + mCP = 0.0_wp; mCPD = 0.0_wp; mCVGP = 0.0_wp; mCVGP2 = 0.0_wp; mQ = 0.0_wp; mQD = 0.0_wp ! Those must be updated through the iterations, as they either depend on ! the partial masses for all fluids, or on the equilibrium pressure !$acc loop seq @@ -491,7 +491,7 @@ contains call s_compute_jacobian_matrix(InvJac, j, Jac, k, l, mCPD, mCVGP, mCVGP2, pS, q_cons_vf, TJac) ! calculating correction array for Newton's method - DeltamP = -1.0d0*matmul(InvJac, R2D) + DeltamP = -1.0_wp*matmul(InvJac, R2D) ! updating two reacting 'masses'. Recall that inert 'masses' do not change during the phase change ! liquid @@ -526,19 +526,19 @@ contains !> @name variables for the correction of the reacting partial densities !> @{ - real(kind(0.0d0)), intent(out) :: MCT + real(kind(0.0_wp)), intent(out) :: MCT type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf - real(kind(0.0d0)), intent(inout) :: rM + real(kind(0.0_wp)), intent(inout) :: rM integer, intent(in) :: j, k, l !> @} - if (rM < 0.0d0) then + if (rM < 0.0_wp) then - if ((q_cons_vf(lp + contxb - 1)%sf(j, k, l) >= -1.0d0*mixM) .and. & - (q_cons_vf(vp + contxb - 1)%sf(j, k, l) >= -1.0d0*mixM)) then + if ((q_cons_vf(lp + contxb - 1)%sf(j, k, l) >= -1.0_wp*mixM) .and. & + (q_cons_vf(vp + contxb - 1)%sf(j, k, l) >= -1.0_wp*mixM)) then - q_cons_vf(lp + contxb - 1)%sf(j, k, l) = 0.0d0 + q_cons_vf(lp + contxb - 1)%sf(j, k, l) = 0.0_wp - q_cons_vf(vp + contxb - 1)%sf(j, k, l) = 0.0d0 + q_cons_vf(vp + contxb - 1)%sf(j, k, l) = 0.0_wp rM = q_cons_vf(lp + contxb - 1)%sf(j, k, l) + q_cons_vf(vp + contxb - 1)%sf(j, k, l) @@ -551,15 +551,15 @@ contains MCT = 2*mixM ! correcting the partial densities of the reacting fluids. What to do for the nonreacting ones? - if (q_cons_vf(lp + contxb - 1)%sf(j, k, l) < 0.0d0) then + if (q_cons_vf(lp + contxb - 1)%sf(j, k, l) < 0.0_wp) then q_cons_vf(lp + contxb - 1)%sf(j, k, l) = MCT*rM - q_cons_vf(vp + contxb - 1)%sf(j, k, l) = (1.0d0 - MCT)*rM + q_cons_vf(vp + contxb - 1)%sf(j, k, l) = (1.0_wp - MCT)*rM - elseif (q_cons_vf(vp + contxb - 1)%sf(j, k, l) < 0.0d0) then + elseif (q_cons_vf(vp + contxb - 1)%sf(j, k, l) < 0.0_wp) then - q_cons_vf(lp + contxb - 1)%sf(j, k, l) = (1.0d0 - MCT)*rM + q_cons_vf(lp + contxb - 1)%sf(j, k, l) = (1.0_wp - MCT)*rM q_cons_vf(vp + contxb - 1)%sf(j, k, l) = MCT*rM @@ -582,15 +582,15 @@ contains subroutine s_compute_jacobian_matrix(InvJac, j, Jac, k, l, mCPD, mCVGP, mCVGP2, pS, q_cons_vf, TJac) !$acc routine seq - real(kind(0.0d0)), dimension(2, 2), intent(out) :: InvJac + real(kind(0.0_wp)), dimension(2, 2), intent(out) :: InvJac integer, intent(in) :: j - real(kind(0.0d0)), dimension(2, 2), intent(out) :: Jac + real(kind(0.0_wp)), dimension(2, 2), intent(out) :: Jac integer, intent(in) :: k, l - real(kind(0.0d0)), intent(in) :: mCPD, mCVGP, mCVGP2, pS + real(kind(0.0_wp)), intent(in) :: mCPD, mCVGP, mCVGP2, pS type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf - real(kind(0.0d0)), dimension(2, 2), intent(out) :: TJac + real(kind(0.0_wp)), dimension(2, 2), intent(out) :: TJac - real(kind(0.0d0)) :: ml, mT, TS, dFdT, dTdm, dTdp ! mass of the reacting fluid, total reacting mass, and auxiliary variables + real(kind(0.0_wp)) :: ml, mT, TS, dFdT, dTdm, dTdp ! mass of the reacting fluid, total reacting mass, and auxiliary variables ! mass of the reacting liquid ml = q_cons_vf(lp + contxb - 1)%sf(j, k, l) @@ -655,8 +655,8 @@ contains ! intermediate elements of J^{-1} InvJac(1, 1) = Jac(2, 2) - InvJac(1, 2) = -1.0d0*Jac(1, 2) - InvJac(2, 1) = -1.0d0*Jac(2, 1) + InvJac(1, 2) = -1.0_wp*Jac(1, 2) + InvJac(2, 1) = -1.0_wp*Jac(2, 1) InvJac(2, 2) = Jac(1, 1) ! elements of J^{T} @@ -685,12 +685,12 @@ contains !$acc routine seq integer, intent(in) :: j, k, l - real(kind(0.0d0)), intent(in) :: mCPD, mCVGP, mQD + real(kind(0.0_wp)), intent(in) :: mCPD, mCVGP, mQD type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf - real(kind(0.0d0)), intent(in) :: pS, rhoe - real(kind(0.0d0)), dimension(2), intent(out) :: R2D + real(kind(0.0_wp)), intent(in) :: pS, rhoe + real(kind(0.0_wp)), dimension(2), intent(out) :: R2D - real(kind(0.0d0)) :: ml, mT, TS !< mass of the reacting liquid, total reacting mass, equilibrium temperature + real(kind(0.0_wp)) :: ml, mT, TS !< mass of the reacting liquid, total reacting mass, equilibrium temperature ! mass of the reacting liquid ml = q_cons_vf(lp + contxb - 1)%sf(j, k, l) @@ -730,19 +730,19 @@ contains subroutine s_TSat(pSat, TSat, TSIn) !$acc routine seq - real(kind(0.0d0)), intent(in) :: pSat - real(kind(0.0d0)), intent(out) :: TSat - real(kind(0.0d0)), intent(in) :: TSIn + real(kind(0.0_wp)), intent(in) :: pSat + real(kind(0.0_wp)), intent(out) :: TSat + real(kind(0.0_wp)), intent(in) :: TSIn - real(kind(0.0d0)) :: dFdT, FT, Om !< auxiliary variables + real(kind(0.0_wp)) :: dFdT, FT, Om !< auxiliary variables ! Generic loop iterators integer :: ns - if ((pSat == 0.0d0) .and. (TSIn == 0.0d0)) then + if ((pSat == 0.0_wp) .and. (TSIn == 0.0_wp)) then ! assigning Saturation temperature - TSat = 0.0d0 + TSat = 0.0_wp else diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 5200e20cf6..de7fdd5ef8 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -152,7 +152,7 @@ contains if ((model_eqns /= 4) .and. (bubbles .neqv. .true.)) then pres = (energy - dyn_p - pi_inf - qv)/gamma else if ((model_eqns /= 4) .and. bubbles) then - pres = ((energy - dyn_p)/(1.d0 - alf) - pi_inf - qv)/gamma + pres = ((energy - dyn_p)/(1._wp - alf) - pi_inf - qv)/gamma else pres = (pref + pi_inf)* & (energy/ & @@ -162,22 +162,22 @@ contains if (hypoelasticity .and. present(G)) then ! calculate elastic contribution to Energy - E_e = 0d0 + E_e = 0._wp do s = stress_idx%beg, stress_idx%end if (G > 0) then - E_e = E_e + ((stress/rho)**2d0)/(4d0*G) + E_e = E_e + ((stress/rho)**2._wp)/(4._wp*G) ! Additional terms in 2D and 3D if ((s == stress_idx%beg + 1) .or. & (s == stress_idx%beg + 3) .or. & (s == stress_idx%beg + 4)) then - E_e = E_e + ((stress/rho)**2d0)/(4d0*G) + E_e = E_e + ((stress/rho)**2._wp)/(4._wp*G) end if end if end do pres = ( & energy - & - 0.5d0*(mom**2.d0)/rho - & + 0.5_wp*(mom**2._wp)/rho - & pi_inf - qv - E_e & )/gamma @@ -190,10 +190,10 @@ contains end do if (sum(Y_rs) > 1d-16) then - call get_temperature(.true., energy - dyn_p, 1200d0, Y_rs, T) + call get_temperature(.true., energy - dyn_p, 1200._wp, Y_rs, T) call get_pressure(rho, T, Y_rs, pres) else - pres = 0d0 + pres = 0._wp end if #:endif @@ -234,7 +234,7 @@ contains rho = q_vf(1)%sf(i, j, k) gamma = q_vf(gamma_idx)%sf(i, j, k) pi_inf = q_vf(pi_inf_idx)%sf(i, j, k) - qv = 0d0 ! keep this value nill for now. For future adjustment + qv = 0._wp ! keep this value nill for now. For future adjustment ! Post process requires rho_sf/gamma_sf/pi_inf_sf/qv_sf to also be updated #ifdef MFC_POST_PROCESS @@ -291,8 +291,8 @@ contains if (mpp_lim) then do i = 1, num_fluids - alpha_rho_K(i) = max(0d0, alpha_rho_K(i)) - alpha_K(i) = min(max(0d0, alpha_K(i)), 1d0) + alpha_rho_K(i) = max(0._wp, alpha_rho_K(i)) + alpha_K(i) = min(max(0._wp, alpha_K(i)), 1._wp) end do alpha_K = alpha_K/max(sum(alpha_K), 1d-16) @@ -308,7 +308,7 @@ contains pi_inf = fluid_pp(1)%pi_inf !qK_vf(pi_inf_idx)%sf(i,j,k) qv = fluid_pp(1)%qv else if ((model_eqns == 2) .and. bubbles) then - rho = 0d0; gamma = 0d0; pi_inf = 0d0; qv = 0d0 + rho = 0._wp; gamma = 0._wp; pi_inf = 0._wp; qv = 0._wp if (mpp_lim .and. (num_fluids > 2)) then do i = 1, num_fluids @@ -347,14 +347,14 @@ contains if (num_fluids == 1) then ! need to consider case with num_fluids >= 2 do i = 1, 2 - Re_K(i) = dflt_real; if (Re_size(i) > 0) Re_K(i) = 0d0 + Re_K(i) = dflt_real; if (Re_size(i) > 0) Re_K(i) = 0._wp do q = 1, Re_size(i) Re_K(i) = (1 - alpha_K(Re_idx(i, q)))/fluid_pp(Re_idx(i, q))%Re(i) & + Re_K(i) end do - Re_K(i) = 1d0/max(Re_K(i), sgm_eps) + Re_K(i) = 1._wp/max(Re_K(i), sgm_eps) end do end if @@ -416,8 +416,8 @@ contains if (mpp_lim) then do i = 1, num_fluids - alpha_rho_K(i) = max(0d0, alpha_rho_K(i)) - alpha_K(i) = min(max(0d0, alpha_K(i)), 1d0) + alpha_rho_K(i) = max(0._wp, alpha_rho_K(i)) + alpha_K(i) = min(max(0._wp, alpha_K(i)), 1._wp) end do alpha_K = alpha_K/max(sum(alpha_K), 1d-16) @@ -427,7 +427,7 @@ contains ! Calculating the density, the specific heat ratio function, the ! liquid stiffness function, and the energy reference function, ! respectively, from the species analogs - rho = 0d0; gamma = 0d0; pi_inf = 0d0; qv = 0d0 + rho = 0._wp; gamma = 0._wp; pi_inf = 0._wp; qv = 0._wp do i = 1, num_fluids rho = rho + alpha_rho_K(i) @@ -440,24 +440,24 @@ contains ! Computing the shear and bulk Reynolds numbers from species analogs do i = 1, 2 - Re_K(i) = dflt_real; if (Re_size(i) > 0) Re_K(i) = 0d0 + Re_K(i) = dflt_real; if (Re_size(i) > 0) Re_K(i) = 0._wp do j = 1, Re_size(i) Re_K(i) = alpha_K(Re_idx(i, j))/fluid_pp(Re_idx(i, j))%Re(i) & + Re_K(i) end do - Re_K(i) = 1d0/max(Re_K(i), sgm_eps) + Re_K(i) = 1._wp/max(Re_K(i), sgm_eps) end do #endif if (present(G_K)) then - G_K = 0d0 + G_K = 0._wp do i = 1, num_fluids G_K = G_K + alpha_K(i)*G(i) end do - G_K = max(0d0, G_K) + G_K = max(0._wp, G_K) end if ! Post process requires rho_sf/gamma_sf/pi_inf_sf/qv_sf to also be updated @@ -499,17 +499,17 @@ contains ! their physical bounds to make sure that any mixture variables that ! are derived from them result within the limits that are set by the ! fluids physical parameters that make up the mixture - rho_K = 0d0 - gamma_K = 0d0 - pi_inf_K = 0d0 - qv_K = 0d0 + rho_K = 0._wp + gamma_K = 0._wp + pi_inf_K = 0._wp + qv_K = 0._wp - alpha_K_sum = 0d0 + alpha_K_sum = 0._wp if (mpp_lim) then do i = 1, num_fluids - alpha_rho_K(i) = max(0d0, alpha_rho_K(i)) - alpha_K(i) = min(max(0d0, alpha_K(i)), 1d0) + alpha_rho_K(i) = max(0._wp, alpha_rho_K(i)) + alpha_K(i) = min(max(0._wp, alpha_K(i)), 1._wp) alpha_K_sum = alpha_K_sum + alpha_K(i) end do @@ -525,12 +525,12 @@ contains end do if (present(G_K)) then - G_K = 0d0 + G_K = 0._wp do i = 1, num_fluids !TODO: change to use Gs directly here? G_K = G_K + alpha_K(i)*G(i) end do - G_K = max(0d0, G_K) + G_K = max(0._wp, G_K) end if if (any(Re_size > 0)) then @@ -538,14 +538,14 @@ contains do i = 1, 2 Re_K(i) = dflt_real - if (Re_size(i) > 0) Re_K(i) = 0d0 + if (Re_size(i) > 0) Re_K(i) = 0._wp do j = 1, Re_size(i) Re_K(i) = alpha_K(Re_idx(i, j))/Res(i, j) & + Re_K(i) end do - Re_K(i) = 1d0/max(Re_K(i), sgm_eps) + Re_K(i) = 1._wp/max(Re_K(i), sgm_eps) end do end if @@ -573,10 +573,10 @@ contains integer :: i, j !< Generic loop iterators #ifdef MFC_SIMULATION - rho_K = 0d0 - gamma_K = 0d0 - pi_inf_K = 0d0 - qv_K = 0d0 + rho_K = 0._wp + gamma_K = 0._wp + pi_inf_K = 0._wp + qv_K = 0._wp if (mpp_lim .and. (model_eqns == 2) .and. (num_fluids > 2)) then do i = 1, num_fluids @@ -605,14 +605,14 @@ contains do i = 1, 2 Re_K(i) = dflt_real - if (Re_size(i) > 0) Re_K(i) = 0d0 + if (Re_size(i) > 0) Re_K(i) = 0._wp do j = 1, Re_size(i) - Re_K(i) = (1d0 - alpha_K(Re_idx(i, j)))/Res(i, j) & + Re_K(i) = (1._wp - alpha_K(Re_idx(i, j)))/Res(i, j) & + Re_K(i) end do - Re_K(i) = 1d0/max(Re_K(i), sgm_eps) + Re_K(i) = 1._wp/max(Re_K(i), sgm_eps) end do end if @@ -671,10 +671,10 @@ contains do i = 1, num_fluids gammas(i) = fluid_pp(i)%gamma - gs_min(i) = 1.0d0/gammas(i) + 1.0d0 + gs_min(i) = 1.0_wp/gammas(i) + 1.0_wp pi_infs(i) = fluid_pp(i)%pi_inf Gs(i) = fluid_pp(i)%G - ps_inf(i) = pi_infs(i)/(1.0d0 + gammas(i)) + ps_inf(i) = pi_infs(i)/(1.0_wp + gammas(i)) cvs(i) = fluid_pp(i)%cv qvs(i) = fluid_pp(i)%qv qvps(i) = fluid_pp(i)%qvp @@ -801,10 +801,10 @@ contains mu = qK_cons_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc sig = (qK_cons_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - mu**2)**0.5 - mv(j, k, l, 1, i) = (mass_v0(i))*(mu - sig)**(3d0)/(R0(i)**(3d0)) - mv(j, k, l, 2, i) = (mass_v0(i))*(mu - sig)**(3d0)/(R0(i)**(3d0)) - mv(j, k, l, 3, i) = (mass_v0(i))*(mu + sig)**(3d0)/(R0(i)**(3d0)) - mv(j, k, l, 4, i) = (mass_v0(i))*(mu + sig)**(3d0)/(R0(i)**(3d0)) + mv(j, k, l, 1, i) = (mass_v0(i))*(mu - sig)**(3._wp)/(R0(i)**(3._wp)) + mv(j, k, l, 2, i) = (mass_v0(i))*(mu - sig)**(3._wp)/(R0(i)**(3._wp)) + mv(j, k, l, 3, i) = (mass_v0(i))*(mu + sig)**(3._wp)/(R0(i)**(3._wp)) + mv(j, k, l, 4, i) = (mass_v0(i))*(mu + sig)**(3._wp)/(R0(i)**(3._wp)) end do end do @@ -834,10 +834,10 @@ contains sig = (qK_cons_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - mu**2)**0.5 !PRESTON (ISOTHERMAL) - pb(j, k, l, 1, i) = (pb0(i))*(R0(i)**(3d0))*(mass_n0(i) + mv(j, k, l, 1, i))/(mu - sig)**(3d0)/(mass_n0(i) + mass_v0(i)) - pb(j, k, l, 2, i) = (pb0(i))*(R0(i)**(3d0))*(mass_n0(i) + mv(j, k, l, 2, i))/(mu - sig)**(3d0)/(mass_n0(i) + mass_v0(i)) - pb(j, k, l, 3, i) = (pb0(i))*(R0(i)**(3d0))*(mass_n0(i) + mv(j, k, l, 3, i))/(mu + sig)**(3d0)/(mass_n0(i) + mass_v0(i)) - pb(j, k, l, 4, i) = (pb0(i))*(R0(i)**(3d0))*(mass_n0(i) + mv(j, k, l, 4, i))/(mu + sig)**(3d0)/(mass_n0(i) + mass_v0(i)) + pb(j, k, l, 1, i) = (pb0(i))*(R0(i)**(3._wp))*(mass_n0(i) + mv(j, k, l, 1, i))/(mu - sig)**(3._wp)/(mass_n0(i) + mass_v0(i)) + pb(j, k, l, 2, i) = (pb0(i))*(R0(i)**(3._wp))*(mass_n0(i) + mv(j, k, l, 2, i))/(mu - sig)**(3._wp)/(mass_n0(i) + mass_v0(i)) + pb(j, k, l, 3, i) = (pb0(i))*(R0(i)**(3._wp))*(mass_n0(i) + mv(j, k, l, 3, i))/(mu + sig)**(3._wp)/(mass_n0(i) + mass_v0(i)) + pb(j, k, l, 4, i) = (pb0(i))*(R0(i)**(3._wp))*(mass_n0(i) + mv(j, k, l, 4, i))/(mu + sig)**(3._wp)/(mass_n0(i) + mass_v0(i)) end do end do end do @@ -890,7 +890,7 @@ contains integer :: i, j, k, l, q !< Generic loop iterators - real(kind(0.d0)) :: ntmp + real(wp) :: ntmp #:if MFC_CASE_OPTIMIZATION #ifndef MFC_SIMULATION @@ -912,7 +912,7 @@ contains do l = izb, ize do k = iyb, iye do j = ixb, ixe - dyn_pres_K = 0d0 + dyn_pres_K = 0._wp !$acc loop seq do i = 1, num_fluids @@ -946,11 +946,11 @@ contains end if if (chemistry) then - rho_K = 0d0 + rho_K = 0._wp !$acc loop seq do i = chemxb, chemxe !print*, j,k,l, qK_cons_vf(i)%sf(j, k, l) - rho_K = rho_K + max(0d0, qK_cons_vf(i)%sf(j, k, l)) + rho_K = rho_K + max(0._wp, qK_cons_vf(i)%sf(j, k, l)) end do !$acc loop seq @@ -958,10 +958,10 @@ contains qK_prim_vf(i)%sf(j, k, l) = rho_K end do - Yksum = 0d0 + Yksum = 0._wp !$acc loop seq do i = chemxb, chemxe - qK_prim_vf(i)%sf(j, k, l) = max(0d0, qK_cons_vf(i)%sf(j, k, l)/rho_K) + qK_prim_vf(i)%sf(j, k, l) = max(0._wp, qK_cons_vf(i)%sf(j, k, l)/rho_K) Yksum = Yksum + qK_prim_vf(i)%sf(j, k, l) end do @@ -1053,13 +1053,13 @@ contains ! subtracting elastic contribution for pressure calculation if (G_K > 1000) then !TODO: check if stable for >0 qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K + ((qK_prim_vf(i)%sf(j, k, l)**2._wp)/(4._wp*G_K))/gamma_K ! extra terms in 2 and 3D if ((i == strxb + 1) .or. & (i == strxb + 3) .or. & (i == strxb + 4)) then qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - & - ((qK_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G_K))/gamma_K + ((qK_prim_vf(i)%sf(j, k, l)**2._wp)/(4._wp*G_K))/gamma_K end if end if end do @@ -1110,7 +1110,7 @@ contains real(wp) :: dyn_pres real(wp) :: nbub, R3, vftmp, R3tmp real(wp), dimension(nb) :: Rtmp - real(wp) :: G = 0d0 + real(wp) :: G = 0._wp real(wp), dimension(2) :: Re_K integer :: i, j, k, l, q !< Generic loop iterators @@ -1142,13 +1142,13 @@ contains ! Zeroing out the dynamic pressure since it is computed ! iteratively by cycling through the velocity equations - dyn_pres = 0d0 + dyn_pres = 0._wp ! Computing momenta and dynamic pressure from velocity do i = momxb, momxe q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l) dyn_pres = dyn_pres + q_cons_vf(i)%sf(j, k, l)* & - q_prim_vf(i)%sf(j, k, l)/2d0 + q_prim_vf(i)%sf(j, k, l)/2._wp end do #:if chemistry @@ -1175,7 +1175,7 @@ contains else if ((model_eqns /= 4) .and. (bubbles)) then ! \tilde{E} = dyn_pres + (1-\alf)(\Gamma p_l + \Pi_inf) q_cons_vf(E_idx)%sf(j, k, l) = dyn_pres + & - (1.d0 - q_prim_vf(alf_idx)%sf(j, k, l))* & + (1._wp - q_prim_vf(alf_idx)%sf(j, k, l))* & (gamma*q_prim_vf(E_idx)%sf(j, k, l) + pi_inf) else !Tait EOS, no conserved energy variable @@ -1210,13 +1210,13 @@ contains end if else !Initialize R3 averaging over R0 and R directions - R3tmp = 0d0 + R3tmp = 0._wp do i = 1, nb - R3tmp = R3tmp + weight(i)*0.5d0*(Rtmp(i) + sigR)**3d0 - R3tmp = R3tmp + weight(i)*0.5d0*(Rtmp(i) - sigR)**3d0 + R3tmp = R3tmp + weight(i)*0.5_wp*(Rtmp(i) + sigR)**3._wp + R3tmp = R3tmp + weight(i)*0.5_wp*(Rtmp(i) - sigR)**3._wp end do !Initialize nb - nbub = 3d0*q_prim_vf(alf_idx)%sf(j, k, l)/(4d0*pi*R3tmp) + nbub = 3._wp*q_prim_vf(alf_idx)%sf(j, k, l)/(4._wp*pi*R3tmp) end if if (j == 0 .and. k == 0 .and. l == 0) print *, 'In convert, nbub:', nbub @@ -1232,13 +1232,13 @@ contains ! adding elastic contribution if (G > 1000) then q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) + (q_prim_vf(i)%sf(j, k, l)**2._wp)/(4._wp*G) ! extra terms in 2 and 3D if ((i == stress_idx%beg + 1) .or. & (i == stress_idx%beg + 3) .or. & (i == stress_idx%beg + 4)) then q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + & - (q_prim_vf(i)%sf(j, k, l)**2d0)/(4d0*G) + (q_prim_vf(i)%sf(j, k, l)**2._wp)/(4._wp*G) end if end if end do @@ -1328,10 +1328,10 @@ contains vel_K(i) = qK_prim_vf(j, k, l, contxe + i) end do - vel_K_sum = 0d0 + vel_K_sum = 0._wp !$acc loop seq do i = 1, num_dims - vel_K_sum = vel_K_sum + vel_K(i)**2d0 + vel_K_sum = vel_K_sum + vel_K(i)**2._wp end do pres_K = qK_prim_vf(j, k, l, E_idx) @@ -1371,7 +1371,7 @@ contains if (riemann_solver == 1) then !$acc loop seq do i = advxb, advxe - FK_vf(j, k, l, i) = 0d0 + FK_vf(j, k, l, i) = 0._wp FK_src_vf(j, k, l, i) = alpha_K(i - E_idx) end do @@ -1441,17 +1441,17 @@ contains integer :: q if (alt_soundspeed) then - blkmod1 = ((gammas(1) + 1d0)*pres + & + blkmod1 = ((gammas(1) + 1._wp)*pres + & pi_infs(1))/gammas(1) - blkmod2 = ((gammas(2) + 1d0)*pres + & + blkmod2 = ((gammas(2) + 1._wp)*pres + & pi_infs(2))/gammas(2) - c = (1d0/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2))) + c = (1._wp/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2))) elseif (model_eqns == 3) then - c = 0d0 + c = 0._wp !$acc loop seq do q = 1, num_fluids - c = c + adv(q)*(1d0/gammas(q) + 1d0)* & - (pres + pi_infs(q)/(gammas(q) + 1d0)) + c = c + adv(q)*(1._wp/gammas(q) + 1._wp)* & + (pres + pi_infs(q)/(gammas(q) + 1._wp)) end do c = c/rho @@ -1459,20 +1459,20 @@ contains ! Sound speed for bubble mmixture to order O(\alpha) if (mpp_lim .and. (num_fluids > 1)) then - c = (1d0/gamma + 1d0)* & - (pres + pi_inf/(gamma + 1d0))/rho + c = (1._wp/gamma + 1._wp)* & + (pres + pi_inf/(gamma + 1._wp))/rho else c = & - (1d0/gamma + 1d0)* & - (pres + pi_inf/(gamma + 1d0))/ & - (rho*(1d0 - adv(num_fluids))) + (1._wp/gamma + 1._wp)* & + (pres + pi_inf/(gamma + 1._wp))/ & + (rho*(1._wp - adv(num_fluids))) end if else c = ((H - 5d-1*vel_sum)/gamma) end if - if (mixture_err .and. c < 0d0) then - c = 100.d0*sgm_eps + if (mixture_err .and. c < 0._wp) then + c = 100._wp*sgm_eps else c = sqrt(c) end if diff --git a/src/post_process/m_checker.fpp b/src/post_process/m_checker.fpp index 3ebdf3f874..e7779987b5 100644 --- a/src/post_process/m_checker.fpp +++ b/src/post_process/m_checker.fpp @@ -104,7 +104,7 @@ contains do i = 1, num_fluids call s_int_to_str(i, iStr) - @:PROHIBIT(.not. f_is_default(schlieren_alpha(i)) .and. schlieren_alpha(i) <= 0d0, & + @:PROHIBIT(.not. f_is_default(schlieren_alpha(i)) .and. schlieren_alpha(i) <= 0._wp, & "schlieren_alpha("//trim(iStr)//") must be greater than zero") @:PROHIBIT(.not. f_is_default(schlieren_alpha(i)) .and. i > num_fluids, & "Index of schlieren_alpha("//trim(iStr)//") exceeds the total number of fluids") diff --git a/src/post_process/m_data_input.f90 b/src/post_process/m_data_input.f90 index 247cd665b4..ba9543ec4f 100644 --- a/src/post_process/m_data_input.f90 +++ b/src/post_process/m_data_input.f90 @@ -140,7 +140,7 @@ subroutine s_read_serial_data_files(t_step) dx(0:m) = x_cb(0:m) - x_cb(-1:m - 1) ! Computing the cell-center locations - x_cc(0:m) = x_cb(-1:m - 1) + dx(0:m)/2d0 + x_cc(0:m) = x_cb(-1:m - 1) + dx(0:m)/2._wp ! ================================================================== @@ -167,7 +167,7 @@ subroutine s_read_serial_data_files(t_step) dy(0:n) = y_cb(0:n) - y_cb(-1:n - 1) ! Computing the cell-center locations - y_cc(0:n) = y_cb(-1:n - 1) + dy(0:n)/2d0 + y_cc(0:n) = y_cb(-1:n - 1) + dy(0:n)/2._wp ! ================================================================== @@ -194,7 +194,7 @@ subroutine s_read_serial_data_files(t_step) dz(0:p) = z_cb(0:p) - z_cb(-1:p - 1) ! Computing the cell-center locations - z_cc(0:p) = z_cb(-1:p - 1) + dz(0:p)/2d0 + z_cc(0:p) = z_cb(-1:p - 1) + dz(0:p)/2._wp end if @@ -294,7 +294,7 @@ subroutine s_read_parallel_data_files(t_step) ! Computing the cell width distribution dx(0:m) = x_cb(0:m) - x_cb(-1:m - 1) ! Computing the cell center location - x_cc(0:m) = x_cb(-1:m - 1) + dx(0:m)/2d0 + x_cc(0:m) = x_cb(-1:m - 1) + dx(0:m)/2._wp if (n > 0) then ! Read in cell boundary locations in y-direction @@ -315,7 +315,7 @@ subroutine s_read_parallel_data_files(t_step) ! Computing the cell width distribution dy(0:n) = y_cb(0:n) - y_cb(-1:n - 1) ! Computing the cell center location - y_cc(0:n) = y_cb(-1:n - 1) + dy(0:n)/2d0 + y_cc(0:n) = y_cb(-1:n - 1) + dy(0:n)/2._wp if (p > 0) then ! Read in cell boundary locations in z-direction @@ -336,7 +336,7 @@ subroutine s_read_parallel_data_files(t_step) ! Computing the cell width distribution dz(0:p) = z_cb(0:p) - z_cb(-1:p - 1) ! Computing the cell center location - z_cc(0:p) = z_cb(-1:p - 1) + dz(0:p)/2d0 + z_cc(0:p) = z_cb(-1:p - 1) + dz(0:p)/2._wp end if end if @@ -364,8 +364,8 @@ subroutine s_read_parallel_data_files(t_step) m_MOK = int(m_glb + 1, MPI_OFFSET_KIND) n_MOK = int(n_glb + 1, MPI_OFFSET_KIND) p_MOK = int(p_glb + 1, MPI_OFFSET_KIND) - WP_MOK = int(8d0, MPI_OFFSET_KIND) - MOK = int(1d0, MPI_OFFSET_KIND) + WP_MOK = int(8._wp, MPI_OFFSET_KIND) + MOK = int(1._wp, MPI_OFFSET_KIND) str_MOK = int(name_len, MPI_OFFSET_KIND) NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) @@ -438,8 +438,8 @@ subroutine s_read_parallel_data_files(t_step) m_MOK = int(m_glb + 1, MPI_OFFSET_KIND) n_MOK = int(n_glb + 1, MPI_OFFSET_KIND) p_MOK = int(p_glb + 1, MPI_OFFSET_KIND) - WP_MOK = int(8d0, MPI_OFFSET_KIND) - MOK = int(1d0, MPI_OFFSET_KIND) + WP_MOK = int(8._wp, MPI_OFFSET_KIND) + MOK = int(1._wp, MPI_OFFSET_KIND) str_MOK = int(name_len, MPI_OFFSET_KIND) NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) @@ -553,7 +553,7 @@ subroutine s_populate_grid_variables_buffer_regions end do do i = 1, buff_size - x_cc(-i) = x_cc(1 - i) - (dx(1 - i) + dx(-i))/2d0 + x_cc(-i) = x_cc(1 - i) - (dx(1 - i) + dx(-i))/2._wp end do ! Ghost-cell extrapolation BC at the end @@ -589,7 +589,7 @@ subroutine s_populate_grid_variables_buffer_regions end do do i = 1, buff_size - x_cc(m + i) = x_cc(m + (i - 1)) + (dx(m + (i - 1)) + dx(m + i))/2d0 + x_cc(m + i) = x_cc(m + (i - 1)) + (dx(m + (i - 1)) + dx(m + i))/2._wp end do ! END: Populating Buffer Regions in the x-direction ================ @@ -631,7 +631,7 @@ subroutine s_populate_grid_variables_buffer_regions end do do i = 1, buff_size - y_cc(-i) = y_cc(1 - i) - (dy(1 - i) + dy(-i))/2d0 + y_cc(-i) = y_cc(1 - i) - (dy(1 - i) + dy(-i))/2._wp end do ! Ghost-cell extrapolation BC at the end @@ -667,7 +667,7 @@ subroutine s_populate_grid_variables_buffer_regions end do do i = 1, buff_size - y_cc(n + i) = y_cc(n + (i - 1)) + (dy(n + (i - 1)) + dy(n + i))/2d0 + y_cc(n + i) = y_cc(n + (i - 1)) + (dy(n + (i - 1)) + dy(n + i))/2._wp end do ! END: Populating Buffer Regions in the y-direction ================ @@ -709,7 +709,7 @@ subroutine s_populate_grid_variables_buffer_regions end do do i = 1, buff_size - z_cc(-i) = z_cc(1 - i) - (dz(1 - i) + dz(-i))/2d0 + z_cc(-i) = z_cc(1 - i) - (dz(1 - i) + dz(-i))/2._wp end do ! Ghost-cell extrapolation BC at the end @@ -745,7 +745,7 @@ subroutine s_populate_grid_variables_buffer_regions end do do i = 1, buff_size - z_cc(p + i) = z_cc(p + (i - 1)) + (dz(p + (i - 1)) + dz(p + i))/2d0 + z_cc(p + i) = z_cc(p + (i - 1)) + (dz(p + (i - 1)) + dz(p + i))/2._wp end do end if diff --git a/src/post_process/m_derived_variables.fpp b/src/post_process/m_derived_variables.fpp index f8b371fe4b..7705ecda1b 100644 --- a/src/post_process/m_derived_variables.fpp +++ b/src/post_process/m_derived_variables.fpp @@ -131,7 +131,7 @@ contains do k = -offset_z%beg, p + offset_z%end do j = -offset_y%beg, n + offset_y%end do i = -offset_x%beg, m + offset_x%end - q_sf(i, j, k) = 1d0 + 1d0/gamma_sf(i, j, k) + q_sf(i, j, k) = 1._wp + 1._wp/gamma_sf(i, j, k) end do end do end do @@ -159,7 +159,7 @@ contains do k = -offset_z%beg, p + offset_z%end do j = -offset_y%beg, n + offset_y%end do i = -offset_x%beg, m + offset_x%end - q_sf(i, j, k) = pi_inf_sf(i, j, k)/(gamma_sf(i, j, k) + 1d0) + q_sf(i, j, k) = pi_inf_sf(i, j, k)/(gamma_sf(i, j, k) + 1._wp) end do end do end do @@ -198,20 +198,20 @@ contains ! Compute mixture sound speed if (alt_soundspeed .neqv. .true.) then - q_sf(i, j, k) = (((gamma_sf(i, j, k) + 1d0)* & + q_sf(i, j, k) = (((gamma_sf(i, j, k) + 1._wp)* & q_prim_vf(E_idx)%sf(i, j, k) + & pi_inf_sf(i, j, k))/(gamma_sf(i, j, k)* & rho_sf(i, j, k))) else - blkmod1 = ((fluid_pp(1)%gamma + 1d0)*q_prim_vf(E_idx)%sf(i, j, k) + & + blkmod1 = ((fluid_pp(1)%gamma + 1._wp)*q_prim_vf(E_idx)%sf(i, j, k) + & fluid_pp(1)%pi_inf)/fluid_pp(1)%gamma - blkmod2 = ((fluid_pp(2)%gamma + 1d0)*q_prim_vf(E_idx)%sf(i, j, k) + & + blkmod2 = ((fluid_pp(2)%gamma + 1._wp)*q_prim_vf(E_idx)%sf(i, j, k) + & fluid_pp(2)%pi_inf)/fluid_pp(2)%gamma - q_sf(i, j, k) = (1d0/(rho_sf(i, j, k)*(q_prim_vf(adv_idx%beg)%sf(i, j, k)/blkmod1 + & - (1d0 - q_prim_vf(adv_idx%beg)%sf(i, j, k))/blkmod2))) + q_sf(i, j, k) = (1._wp/(rho_sf(i, j, k)*(q_prim_vf(adv_idx%beg)%sf(i, j, k)/blkmod1 + & + (1._wp - q_prim_vf(adv_idx%beg)%sf(i, j, k))/blkmod2))) end if - if (mixture_err .and. q_sf(i, j, k) < 0d0) then + if (mixture_err .and. q_sf(i, j, k) < 0._wp) then q_sf(i, j, k) = 1d-16 else q_sf(i, j, k) = sqrt(q_sf(i, j, k)) @@ -248,7 +248,7 @@ contains do k = -offset_y%beg, n + offset_y%end do j = -offset_x%beg, m + offset_x%end if (i == 1) then - if (q_prim_vf(cont_idx%end + i)%sf(j, k, l) >= 0d0) then + if (q_prim_vf(cont_idx%end + i)%sf(j, k, l) >= 0._wp) then top = q_prim_vf(adv_idx%beg)%sf(j, k, l) - & q_prim_vf(adv_idx%beg)%sf(j - 1, k, l) bottom = q_prim_vf(adv_idx%beg)%sf(j + 1, k, l) - & @@ -260,7 +260,7 @@ contains q_prim_vf(adv_idx%beg)%sf(j, k, l) end if elseif (i == 2) then - if (q_prim_vf(cont_idx%end + i)%sf(j, k, l) >= 0d0) then + if (q_prim_vf(cont_idx%end + i)%sf(j, k, l) >= 0._wp) then top = q_prim_vf(adv_idx%beg)%sf(j, k, l) - & q_prim_vf(adv_idx%beg)%sf(j, k - 1, l) bottom = q_prim_vf(adv_idx%beg)%sf(j, k + 1, l) - & @@ -272,7 +272,7 @@ contains q_prim_vf(adv_idx%beg)%sf(j, k, l) end if else - if (q_prim_vf(cont_idx%end + i)%sf(j, k, l) >= 0d0) then + if (q_prim_vf(cont_idx%end + i)%sf(j, k, l) >= 0._wp) then top = q_prim_vf(adv_idx%beg)%sf(j, k, l) - & q_prim_vf(adv_idx%beg)%sf(j, k, l - 1) bottom = q_prim_vf(adv_idx%beg)%sf(j, k, l + 1) - & @@ -285,34 +285,34 @@ contains end if end if - if (abs(top) < 1d-8) top = 0d0 - if (abs(bottom) < 1d-8) bottom = 0d0 + if (abs(top) < 1d-8) top = 0._wp + if (abs(bottom) < 1d-8) bottom = 0._wp if (top == bottom) then - slope = 1d0 - ! ELSEIF((top == 0d0 .AND. bottom /= 0d0) & + slope = 1._wp + ! ELSEIF((top == 0._wp .AND. bottom /= 0._wp) & ! .OR. & - ! (bottom == 0d0 .AND. top /= 0d0)) THEN - ! slope = 0d0 + ! (bottom == 0._wp .AND. top /= 0._wp)) THEN + ! slope = 0._wp else - slope = (top*bottom)/(bottom**2d0 + 1d-16) + slope = (top*bottom)/(bottom**2._wp + 1d-16) end if ! Flux limiter function if (flux_lim == 1) then ! MINMOD (MM) - q_sf(j, k, l) = max(0d0, min(1d0, slope)) + q_sf(j, k, l) = max(0._wp, min(1._wp, slope)) elseif (flux_lim == 2) then ! MUSCL (MC) - q_sf(j, k, l) = max(0d0, min(2d0*slope, 5d-1*(1d0 + slope), 2d0)) + q_sf(j, k, l) = max(0._wp, min(2._wp*slope, 5d-1*(1._wp + slope), 2._wp)) elseif (flux_lim == 3) then ! OSPRE (OP) - q_sf(j, k, l) = (15d-1*(slope**2d0 + slope))/(slope**2d0 + slope + 1d0) + q_sf(j, k, l) = (15d-1*(slope**2._wp + slope))/(slope**2._wp + slope + 1._wp) elseif (flux_lim == 4) then ! SUPERBEE (SB) - q_sf(j, k, l) = max(0d0, min(1d0, 2d0*slope), min(slope, 2d0)) + q_sf(j, k, l) = max(0._wp, min(1._wp, 2._wp*slope), min(slope, 2._wp)) elseif (flux_lim == 5) then ! SWEBY (SW) (beta = 1.5) - q_sf(j, k, l) = max(0d0, min(15d-1*slope, 1d0), min(slope, 15d-1)) + q_sf(j, k, l) = max(0._wp, min(15d-1*slope, 1._wp), min(slope, 15d-1)) elseif (flux_lim == 6) then ! VAN ALBADA (VA) - q_sf(j, k, l) = (slope**2d0 + slope)/(slope**2d0 + 1d0) + q_sf(j, k, l) = (slope**2._wp + slope)/(slope**2._wp + 1._wp) elseif (flux_lim == 7) then ! VAN LEER (VL) - q_sf(j, k, l) = (abs(slope) + slope)/(1d0 + abs(slope)) + q_sf(j, k, l) = (abs(slope) + slope)/(1._wp + abs(slope)) end if end do end do @@ -399,12 +399,12 @@ contains do k = -offset_y%beg, n + offset_y%end do j = -offset_x%beg, m + offset_x%end - q_sf(j, k, l) = 0d0 + q_sf(j, k, l) = 0._wp do r = -fd_number, fd_number if (grid_geometry == 3) then q_sf(j, k, l) = & - q_sf(j, k, l) + 1d0/y_cc(k)* & + q_sf(j, k, l) + 1._wp/y_cc(k)* & (fd_coeff_y(r, k)*y_cc(r + k)* & q_prim_vf(mom_idx%end)%sf(j, r + k, l) & - fd_coeff_z(r, l)* & @@ -428,7 +428,7 @@ contains do k = -offset_y%beg, n + offset_y%end do j = -offset_x%beg, m + offset_x%end - q_sf(j, k, l) = 0d0 + q_sf(j, k, l) = 0._wp do r = -fd_number, fd_number if (grid_geometry == 3) then @@ -456,7 +456,7 @@ contains do k = -offset_y%beg, n + offset_y%end do j = -offset_x%beg, m + offset_x%end - q_sf(j, k, l) = 0d0 + q_sf(j, k, l) = 0._wp do r = -fd_number, fd_number q_sf(j, k, l) = & @@ -501,7 +501,7 @@ contains do j = -offset_x%beg, m + offset_x%end ! Get velocity gradient tensor - q_jacobian_sf(:, :) = 0d0 + q_jacobian_sf(:, :) = 0._wp do r = -fd_number, fd_number do jj = 1, 3 @@ -526,9 +526,9 @@ contains ! Decompose J into asymmetric matrix, S, and a skew-symmetric matrix, O do jj = 1, 3 do kk = 1, 3 - S(jj, kk) = 0.5d0* & + S(jj, kk) = 0.5_wp* & (q_jacobian_sf(jj, kk) + q_jacobian_sf(kk, jj)) - O(jj, kk) = 0.5d0* & + O(jj, kk) = 0.5_wp* & (q_jacobian_sf(jj, kk) - q_jacobian_sf(kk, jj)) end do end do @@ -598,8 +598,8 @@ contains do k = -offset_y%beg, n + offset_y%end do j = -offset_x%beg, m + offset_x%end - drho_dx = 0d0 - drho_dy = 0d0 + drho_dx = 0._wp + drho_dy = 0._wp do i = -fd_number, fd_number drho_dx = drho_dx + fd_coeff_x(i, j)*rho_sf(i + j, k, l) @@ -618,7 +618,7 @@ contains do k = -offset_y%beg, n + offset_y%end do j = -offset_x%beg, m + offset_x%end - drho_dz = 0d0 + drho_dz = 0._wp do i = -fd_number, fd_number if (grid_geometry == 3) then @@ -674,7 +674,7 @@ contains do k = -offset_y%beg, n + offset_y%end do j = -offset_x%beg, m + offset_x%end - q_sf(j, k, l) = 0d0 + q_sf(j, k, l) = 0._wp do i = 1, adv_idx%end - E_idx q_sf(j, k, l) = & diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index b98053eca2..ef2b3f53d9 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -324,8 +324,8 @@ contains #:for DIM in ['x', 'y', 'z'] #:for DIR in [1, 2, 3] - bc_${DIM}$%vb${DIR}$ = 0d0 - bc_${DIM}$%ve${DIR}$ = 0d0 + bc_${DIM}$%vb${DIR}$ = 0._wp + bc_${DIM}$%ve${DIR}$ = 0._wp #:endfor #:endfor @@ -333,9 +333,9 @@ contains do i = 1, num_fluids_max fluid_pp(i)%gamma = dflt_real fluid_pp(i)%pi_inf = dflt_real - fluid_pp(i)%cv = 0d0 - fluid_pp(i)%qv = 0d0 - fluid_pp(i)%qvp = 0d0 + fluid_pp(i)%cv = 0._wp + fluid_pp(i)%qv = 0._wp + fluid_pp(i)%qvp = 0._wp fluid_pp(i)%G = dflt_real end do @@ -499,12 +499,12 @@ contains end if if (nb == 1) then - weight(:) = 1d0 - R0(:) = 1d0 - V0(:) = 0d0 + weight(:) = 1._wp + R0(:) = 1._wp + V0(:) = 0._wp else if (nb > 1) then !call s_simpson - V0(:) = 0d0 + V0(:) = 0._wp else stop 'Invalid value of nb' end if @@ -512,8 +512,8 @@ contains if (polytropic .neqv. .true.) then !call s_initialize_nonpoly else - rhoref = 1.d0 - pref = 1.d0 + rhoref = 1._wp + pref = 1._wp end if end if @@ -594,18 +594,18 @@ contains end do if (nb == 1) then - weight(:) = 1d0 - R0(:) = 1d0 - V0(:) = 0d0 + weight(:) = 1._wp + R0(:) = 1._wp + V0(:) = 0._wp else if (nb > 1) then - V0(:) = 0d0 + V0(:) = 0._wp else stop 'Invalid value of nb' end if if (polytropic) then - rhoref = 1.d0 - pref = 1.d0 + rhoref = 1._wp + pref = 1._wp end if end if end if diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp index d859245e10..e057d55bd9 100644 --- a/src/post_process/m_mpi_proxy.fpp +++ b/src/post_process/m_mpi_proxy.fpp @@ -106,8 +106,8 @@ contains ! Initially zeroing out the vectorized buffer region variables ! to avoid possible underflow from any unused allocated memory - q_cons_buffer_in = 0d0 - q_cons_buffer_out = 0d0 + q_cons_buffer_in = 0._wp + q_cons_buffer_out = 0._wp end if @@ -261,7 +261,7 @@ contains tmp_num_procs_x = num_procs_x tmp_num_procs_y = num_procs_y tmp_num_procs_z = num_procs_z - fct_min = 10d0*abs((m + 1)/tmp_num_procs_x & + fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - (n + 1)/tmp_num_procs_y) ! Searching for optimal computational domain distribution @@ -305,9 +305,9 @@ contains tmp_num_procs_x = num_procs_x tmp_num_procs_y = num_procs_y tmp_num_procs_z = num_procs_z - fct_min = 10d0*abs((m + 1)/tmp_num_procs_x & + fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - (n + 1)/tmp_num_procs_y) & - + 10d0*abs((n + 1)/tmp_num_procs_y & + + 10._wp*abs((n + 1)/tmp_num_procs_y & - (p + 1)/tmp_num_procs_z) ! Searching for optimal computational domain distribution @@ -447,7 +447,7 @@ contains ! Computing minimization variable for these initial values tmp_num_procs_x = num_procs_x tmp_num_procs_y = num_procs_y - fct_min = 10d0*abs((m + 1)/tmp_num_procs_x & + fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - (n + 1)/tmp_num_procs_y) ! Searching for optimal computational domain distribution diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 352cbef1dd..077b638d8a 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -156,11 +156,11 @@ subroutine s_perform_time_step(t_step) if (proc_rank == 0) then if (cfl_dt) then print '(" ["I3"%] Saving "I8" of "I0"")', & - int(ceiling(100d0*(real(t_step - n_start)/(n_save)))), & + int(ceiling(100._wp*(real(t_step - n_start)/(n_save)))), & t_step, n_save else print '(" ["I3"%] Saving "I8" of "I0" @ t_step = "I0"")', & - int(ceiling(100d0*(real(t_step - t_step_start)/(t_step_stop - t_step_start + 1)))), & + int(ceiling(100._wp*(real(t_step - t_step_start)/(t_step_stop - t_step_start + 1)))), & (t_step - t_step_start)/t_step_save + 1, & (t_step_stop - t_step_start)/t_step_save + 1, & t_step @@ -482,12 +482,12 @@ subroutine s_save_data(t_step, varname, pres, c, H) pres = q_prim_vf(E_idx)%sf(i, j, k) - H = ((gamma_sf(i, j, k) + 1d0)*pres + & + H = ((gamma_sf(i, j, k) + 1._wp)*pres + & pi_inf_sf(i, j, k))/rho_sf(i, j, k) call s_compute_speed_of_sound(pres, rho_sf(i, j, k), & gamma_sf(i, j, k), pi_inf_sf(i, j, k), & - H, adv, 0d0, c) + H, adv, 0._wp, c) q_sf(i, j, k) = c end do diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp index edf1e307e2..23f11a465e 100644 --- a/src/pre_process/include/2dHardcodedIC.fpp +++ b/src/pre_process/include/2dHardcodedIC.fpp @@ -13,60 +13,60 @@ select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case case (200) - if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1d0/3d0)) then + if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then ! Volume Fractions q_prim_vf(advxb)%sf(i, j, 0) = eps - q_prim_vf(advxe)%sf(i, j, 0) = 1d0 - eps + q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps ! Denssities - q_prim_vf(contxb)%sf(i, j, 0) = eps*1000d0 - q_prim_vf(contxe)%sf(i, j, 0) = (1d0 - eps)*1d0 + q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp + q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp ! Pressure - q_prim_vf(E_idx)%sf(i, j, 0) = 1000d0 + q_prim_vf(E_idx)%sf(i, j, 0) = 1000._wp end if case (202) ! Gresho vortex (Gouasmi et al 2022 JCP) - r = ((x_cc(i) - 0.5d0)**2 + (y_cc(j) - 0.5d0)**2)**0.5d0 + r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp rmax = 0.2 - gam = 1d0 + 1d0/fluid_pp(1)%gamma + gam = 1._wp + 1._wp/fluid_pp(1)%gamma umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2) - p0 = umax**2*(1d0/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5d0) + p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp) if (r < rmax) then - q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5d0)*umax/rmax - q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5d0)*umax/rmax - q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2d0) + q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax + q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax + q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp) else if (r < 2*rmax) then - q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5d0)/r)*umax*(2d0 - r/rmax) - q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5d0)/r)*umax*(2d0 - r/rmax) - q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2d0 + 4*(1 - (r/rmax) + log(r/rmax))) + q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax) + q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax) + q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax))) else - q_prim_vf(momxb)%sf(i, j, 0) = 0d0 - q_prim_vf(momxe)%sf(i, j, 0) = 0d0 + q_prim_vf(momxb)%sf(i, j, 0) = 0._wp + q_prim_vf(momxe)%sf(i, j, 0) = 0._wp q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2.)) end if case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction - r = ((x_cc(i) - 0.5d0)**2 + (y_cc(j) - 0.5d0)**2)**0.5d0 + r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp rmax = 0.2 - gam = 1d0 + 1d0/fluid_pp(1)%gamma + gam = 1._wp + 1._wp/fluid_pp(1)%gamma umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2) - p0 = umax**2*(1d0/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5d0) + p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp) if (r < rmax) then - q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5d0)*umax/rmax - q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5d0)*umax/rmax - q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2d0) + q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax + q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax + q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp) else if (r < 2*rmax) then - q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5d0)/r)*umax*(2d0 - r/rmax) - q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5d0)/r)*umax*(2d0 - r/rmax) - q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2d0 + 4*(1 - (r/rmax) + log(r/rmax))) + q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax) + q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax) + q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax))) else - q_prim_vf(momxb)%sf(i, j, 0) = 0d0 - q_prim_vf(momxe)%sf(i, j, 0) = 0d0 + q_prim_vf(momxb)%sf(i, j, 0) = 0._wp + q_prim_vf(momxe)%sf(i, j, 0) = 0._wp q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2.)) end if - q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(E_idx)%sf(i, j, 0)**(1d0/gam) + q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(E_idx)%sf(i, j, 0)**(1._wp/gam) case (204) ! Rayleigh-Taylor instability rhoH = 3 diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp index 31dbca0e99..c43cfd890a 100644 --- a/src/pre_process/m_assign_variables.fpp +++ b/src/pre_process/m_assign_variables.fpp @@ -135,35 +135,35 @@ contains ! Density q_prim_vf(1)%sf(j, k, l) = & eta*patch_icpp(patch_id)%rho & - + (1d0 - eta)*patch_icpp(smooth_patch_id)%rho + + (1._wp - eta)*patch_icpp(smooth_patch_id)%rho ! Velocity do i = 1, E_idx - mom_idx%beg q_prim_vf(i + 1)%sf(j, k, l) = & - 1d0/q_prim_vf(1)%sf(j, k, l)* & + 1._wp/q_prim_vf(1)%sf(j, k, l)* & (eta*patch_icpp(patch_id)%rho & *patch_icpp(patch_id)%vel(i) & - + (1d0 - eta)*patch_icpp(smooth_patch_id)%rho & + + (1._wp - eta)*patch_icpp(smooth_patch_id)%rho & *patch_icpp(smooth_patch_id)%vel(i)) end do ! Specific heat ratio function q_prim_vf(gamma_idx)%sf(j, k, l) = & eta*patch_icpp(patch_id)%gamma & - + (1d0 - eta)*patch_icpp(smooth_patch_id)%gamma + + (1._wp - eta)*patch_icpp(smooth_patch_id)%gamma ! Pressure q_prim_vf(E_idx)%sf(j, k, l) = & - 1d0/q_prim_vf(gamma_idx)%sf(j, k, l)* & + 1._wp/q_prim_vf(gamma_idx)%sf(j, k, l)* & (eta*patch_icpp(patch_id)%gamma & *patch_icpp(patch_id)%pres & - + (1d0 - eta)*patch_icpp(smooth_patch_id)%gamma & + + (1._wp - eta)*patch_icpp(smooth_patch_id)%gamma & *patch_icpp(smooth_patch_id)%pres) ! Liquid stiffness function q_prim_vf(pi_inf_idx)%sf(j, k, l) = & eta*patch_icpp(patch_id)%pi_inf & - + (1d0 - eta)*patch_icpp(smooth_patch_id)%pi_inf + + (1._wp - eta)*patch_icpp(smooth_patch_id)%pi_inf ! Species Concentrations #:if chemistry @@ -171,11 +171,11 @@ contains real(wp) :: sum, term ! Accumulating the species concentrations - sum = 0d0 + sum = 0._wp do i = 1, num_species term = & eta*patch_icpp(patch_id)%Y(i) & - + (1d0 - eta)*patch_icpp(smooth_patch_id)%Y(i) + + (1._wp - eta)*patch_icpp(smooth_patch_id)%Y(i) q_prim_vf(chemxb + i - 1)%sf(j, k, l) = term sum = sum + term end do @@ -197,7 +197,7 @@ contains #:endif ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(j, k, l) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(j, k, l) = patch_id end subroutine s_assign_patch_mixture_primitive_variables @@ -221,8 +221,8 @@ contains n_tait = fluid_pp(1)%gamma B_tait = fluid_pp(1)%pi_inf - n_tait = 1.d0/n_tait + 1.d0 - B_tait = B_tait*(n_tait - 1d0)/n_tait + n_tait = 1._wp/n_tait + 1._wp + B_tait = B_tait*(n_tait - 1._wp)/n_tait if (j < 177) then q_prim_vf(E_idx)%sf(j, k, l) = 0.5*q_prim_vf(E_idx)%sf(j, k, l) @@ -230,40 +230,40 @@ contains if (qbmm) then do i = 1, nb - q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l) = q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)*((p0 - fluid_pp(1)%pv)/(q_prim_vf(E_idx)%sf(j, k, l)*p0 - fluid_pp(1)%pv))**(1/3d0) + q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l) = q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)*((p0 - fluid_pp(1)%pv)/(q_prim_vf(E_idx)%sf(j, k, l)*p0 - fluid_pp(1)%pv))**(1/3._wp) end do end if - R3bar = 0d0 + R3bar = 0._wp if (qbmm) then do i = 1, nb - R3bar = R3bar + weight(i)*0.5d0*(q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l))**3d0 - R3bar = R3bar + weight(i)*0.5d0*(q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l))**3d0 + R3bar = R3bar + weight(i)*0.5_wp*(q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l))**3._wp + R3bar = R3bar + weight(i)*0.5_wp*(q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l))**3._wp end do else do i = 1, nb if (polytropic) then - R3bar = R3bar + weight(i)*(q_prim_vf(bubxb + (i - 1)*2)%sf(j, k, l))**3d0 + R3bar = R3bar + weight(i)*(q_prim_vf(bubxb + (i - 1)*2)%sf(j, k, l))**3._wp else - R3bar = R3bar + weight(i)*(q_prim_vf(bubxb + (i - 1)*4)%sf(j, k, l))**3d0 + R3bar = R3bar + weight(i)*(q_prim_vf(bubxb + (i - 1)*4)%sf(j, k, l))**3._wp end if end do end if - n0 = 3d0*q_prim_vf(alf_idx)%sf(j, k, l)/(4d0*pi*R3bar) + n0 = 3._wp*q_prim_vf(alf_idx)%sf(j, k, l)/(4._wp*pi*R3bar) - ratio = ((1d0 + B_tait)/(q_prim_vf(E_idx)%sf(j, k, l) + B_tait))**(1d0/n_tait) + ratio = ((1._wp + B_tait)/(q_prim_vf(E_idx)%sf(j, k, l) + B_tait))**(1._wp/n_tait) - nH = n0/((1d0 - q_prim_vf(alf_idx)%sf(j, k, l))*ratio + (4d0*pi/3d0)*n0*R3bar) - vfH = (4d0*pi/3d0)*nH*R3bar - rhoH = (1d0 - vfH)/ratio - deno = 1d0 - (1d0 - q_prim_vf(alf_idx)%sf(j, k, l))/rhoH + nH = n0/((1._wp - q_prim_vf(alf_idx)%sf(j, k, l))*ratio + (4._wp*pi/3._wp)*n0*R3bar) + vfH = (4._wp*pi/3._wp)*nH*R3bar + rhoH = (1._wp - vfH)/ratio + deno = 1._wp - (1._wp - q_prim_vf(alf_idx)%sf(j, k, l))/rhoH - if (deno == 0d0) then - velH = 0d0 + if (deno == 0._wp) then + velH = 0._wp else - velH = (q_prim_vf(E_idx)%sf(j, k, l) - 1d0)/(1d0 - q_prim_vf(alf_idx)%sf(j, k, l))/deno + velH = (q_prim_vf(E_idx)%sf(j, k, l) - 1._wp)/(1._wp - q_prim_vf(alf_idx)%sf(j, k, l))/deno velH = dsqrt(velH) velH = velH*deno end if @@ -339,13 +339,13 @@ contains if (mpp_lim .and. bubbles) then !adjust volume fractions, according to modeled gas void fraction - alf_sum%sf = 0d0 + alf_sum%sf = 0._wp do i = adv_idx%beg, adv_idx%end - 1 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf end do do i = adv_idx%beg, adv_idx%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1.d0 - q_prim_vf(alf_idx)%sf) & + q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf) & /alf_sum%sf end do end if @@ -367,13 +367,13 @@ contains if (mpp_lim .and. bubbles) then !adjust volume fractions, according to modeled gas void fraction - alf_sum%sf = 0d0 + alf_sum%sf = 0._wp do i = adv_idx%beg, adv_idx%end - 1 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf end do do i = adv_idx%beg, adv_idx%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1.d0 - q_prim_vf(alf_idx)%sf) & + q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf) & /alf_sum%sf end do end if @@ -412,13 +412,13 @@ contains if (mpp_lim .and. bubbles) then !adjust volume fractions, according to modeled gas void fraction - alf_sum%sf = 0d0 + alf_sum%sf = 0._wp do i = adv_idx%beg, adv_idx%end - 1 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf end do do i = adv_idx%beg, adv_idx%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1.d0 - q_prim_vf(alf_idx)%sf) & + q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf) & /alf_sum%sf end do end if @@ -431,18 +431,18 @@ contains if (qbmm) then ! Initialize the moment set if (dist_type == 1) then - q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1d0 + q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = muR q_prim_vf(bub_idx%fullmom(i, 0, 1))%sf(j, k, l) = muV q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = muR**2 + sigR**2 q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = muR*muV + rhoRV*sigR*sigV q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2 else if (dist_type == 2) then - q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1d0 - q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = dexp((sigR**2)/2d0)*muR + q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp + q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = dexp((sigR**2)/2._wp)*muR q_prim_vf(bub_idx%fullmom(i, 0, 1))%sf(j, k, l) = muV - q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = dexp((sigR**2)*2d0)*(muR**2) - q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = dexp((sigR**2)/2d0)*muR*muV + q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = dexp((sigR**2)*2._wp)*(muR**2) + q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = dexp((sigR**2)/2._wp)*muR*muV q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2 end if else @@ -457,9 +457,9 @@ contains if (adv_n) then ! Initialize number density - R3bar = 0d0 + R3bar = 0._wp do i = 1, nb - R3bar = R3bar + weight(i)*(q_prim_vf(bub_idx%rs(i))%sf(j, k, l))**3d0 + R3bar = R3bar + weight(i)*(q_prim_vf(bub_idx%rs(i))%sf(j, k, l))**3._wp end do q_prim_vf(n_idx)%sf(j, k, l) = 3*q_prim_vf(alf_idx)%sf(j, k, l)/(4*pi*R3bar) end if @@ -479,13 +479,13 @@ contains ! Pressure q_prim_vf(E_idx)%sf(j, k, l) = & (eta*patch_icpp(patch_id)%pres & - + (1d0 - eta)*orig_prim_vf(E_idx)) + + (1._wp - eta)*orig_prim_vf(E_idx)) ! Volume fractions \alpha do i = adv_idx%beg, adv_idx%end q_prim_vf(i)%sf(j, k, l) = & eta*patch_icpp(patch_id)%alpha(i - E_idx) & - + (1d0 - eta)*orig_prim_vf(i) + + (1._wp - eta)*orig_prim_vf(i) end do ! Elastic Shear Stress @@ -493,19 +493,19 @@ contains do i = 1, (stress_idx%end - stress_idx%beg) + 1 q_prim_vf(i + stress_idx%beg - 1)%sf(j, k, l) = & (eta*patch_icpp(patch_id)%tau_e(i) & - + (1d0 - eta)*orig_prim_vf(i + stress_idx%beg - 1)) + + (1._wp - eta)*orig_prim_vf(i + stress_idx%beg - 1)) end do end if if (mpp_lim .and. bubbles) then !adjust volume fractions, according to modeled gas void fraction - alf_sum%sf = 0d0 + alf_sum%sf = 0._wp do i = adv_idx%beg, adv_idx%end - 1 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf end do do i = adv_idx%beg, adv_idx%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1.d0 - q_prim_vf(alf_idx)%sf) & + q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf) & /alf_sum%sf end do end if @@ -516,13 +516,13 @@ contains do i = 1, cont_idx%end q_prim_vf(i)%sf(j, k, l) = & eta*patch_icpp(patch_id)%alpha_rho(i) & - + (1d0 - eta)*orig_prim_vf(i) + + (1._wp - eta)*orig_prim_vf(i) end do else !get mixture density from pressure via Tait EOS pi_inf = fluid_pp(1)%pi_inf gamma = fluid_pp(1)%gamma - lit_gamma = (1.d0 + gamma)/gamma + lit_gamma = (1._wp + gamma)/gamma ! \rho = (( p_l + pi_inf)/( p_ref + pi_inf))**(1/little_gam) * rhoref(1-alf) q_prim_vf(1)%sf(j, k, l) = & @@ -539,7 +539,7 @@ contains do i = 1, E_idx - mom_idx%beg q_prim_vf(i + cont_idx%end)%sf(j, k, l) = & (eta*patch_icpp(patch_id)%vel(i) & - + (1d0 - eta)*orig_prim_vf(i + cont_idx%end)) + + (1._wp - eta)*orig_prim_vf(i + cont_idx%end)) end do ! Species Concentrations @@ -548,17 +548,17 @@ contains real(wp) :: sum, term ! Accumulating the species concentrations - sum = 0d0 + sum = 0._wp do i = 1, num_species term = & eta*patch_icpp(patch_id)%Y(i) & - + (1d0 - eta)*patch_icpp(smooth_patch_id)%Y(i) + + (1._wp - eta)*patch_icpp(smooth_patch_id)%Y(i) q_prim_vf(chemxb + i - 1)%sf(j, k, l) = term sum = sum + term end do if (sum < verysmall) then - sum = 1d0 + sum = 1._wp end if ! Normalizing the species concentrations @@ -578,7 +578,7 @@ contains if (mixlayer_vel_profile) then q_prim_vf(1 + cont_idx%end)%sf(j, k, l) = & (eta*patch_icpp(patch_id)%vel(1)*tanh(y_cc(k)*mixlayer_vel_coef) & - + (1d0 - eta)*orig_prim_vf(1 + cont_idx%end)) + + (1._wp - eta)*orig_prim_vf(1 + cont_idx%end)) end if ! Set partial pressures to mixture pressure for the 6-eqn model @@ -596,27 +596,27 @@ contains if (qbmm) then ! Initialize the moment set if (dist_type == 1) then - q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1d0 + q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = muR q_prim_vf(bub_idx%fullmom(i, 0, 1))%sf(j, k, l) = muV q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = muR**2 + sigR**2 q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = muR*muV + rhoRV*sigR*sigV q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2 else if (dist_type == 2) then - q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1d0 - q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = dexp((sigR**2)/2d0)*muR + q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp + q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = dexp((sigR**2)/2._wp)*muR q_prim_vf(bub_idx%fullmom(i, 0, 1))%sf(j, k, l) = muV - q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = dexp((sigR**2)*2d0)*(muR**2) - q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = dexp((sigR**2)/2d0)*muR*muV + q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = dexp((sigR**2)*2._wp)*(muR**2) + q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = dexp((sigR**2)/2._wp)*muR*muV q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2 end if else ! q_prim_vf(bub_idx%rs(i))%sf(j,k,l) = & ! (eta * R0(i)*patch_icpp(patch_id)%r0 & - ! + (1d0-eta)*orig_prim_vf(bub_idx%rs(i))) + ! + (1._wp-eta)*orig_prim_vf(bub_idx%rs(i))) ! q_prim_vf(bub_idx%vs(i))%sf(j,k,l) = & ! (eta * V0(i)*patch_icpp(patch_id)%v0 & - ! + (1d0-eta)*orig_prim_vf(bub_idx%vs(i))) + ! + (1._wp-eta)*orig_prim_vf(bub_idx%vs(i))) q_prim_vf(bub_idx%rs(i))%sf(j, k, l) = muR q_prim_vf(bub_idx%vs(i))%sf(j, k, l) = muV @@ -630,9 +630,9 @@ contains if (adv_n) then ! Initialize number density - R3bar = 0d0 + R3bar = 0._wp do i = 1, nb - R3bar = R3bar + weight(i)*(q_prim_vf(bub_idx%rs(i))%sf(j, k, l))**3d0 + R3bar = R3bar + weight(i)*(q_prim_vf(bub_idx%rs(i))%sf(j, k, l))**3._wp end do q_prim_vf(n_idx)%sf(j, k, l) = 3*q_prim_vf(alf_idx)%sf(j, k, l)/(4*pi*R3bar) end if @@ -640,13 +640,13 @@ contains if (mpp_lim .and. bubbles) then !adjust volume fractions, according to modeled gas void fraction - alf_sum%sf = 0d0 + alf_sum%sf = 0._wp do i = adv_idx%beg, adv_idx%end - 1 alf_sum%sf = alf_sum%sf + q_prim_vf(i)%sf end do do i = adv_idx%beg, adv_idx%end - 1 - q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1.d0 - q_prim_vf(alf_idx)%sf) & + q_prim_vf(i)%sf = q_prim_vf(i)%sf*(1._wp - q_prim_vf(alf_idx)%sf) & /alf_sum%sf end do end if @@ -665,11 +665,11 @@ contains if (.not. f_is_default(sigma)) then q_prim_vf(c_idx)%sf(j, k, l) = eta*patch_icpp(patch_id)%cf_val + & - (1d0 - eta)*patch_icpp(smooth_patch_id)%cf_val + (1._wp - eta)*patch_icpp(smooth_patch_id)%cf_val end if ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(j, k, l) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(j, k, l) = patch_id end subroutine s_assign_patch_species_primitive_variables diff --git a/src/pre_process/m_check_ib_patches.fpp b/src/pre_process/m_check_ib_patches.fpp index d5d3e9bcd2..443e6d7b10 100644 --- a/src/pre_process/m_check_ib_patches.fpp +++ b/src/pre_process/m_check_ib_patches.fpp @@ -89,7 +89,7 @@ contains call s_int_to_str(patch_id, iStr) @:PROHIBIT(n == 0 .or. p > 0 & - .or. patch_ib(patch_id)%radius <= 0d0 & + .or. patch_ib(patch_id)%radius <= 0._wp & .or. f_is_default(patch_ib(patch_id)%x_centroid) & .or. f_is_default(patch_ib(patch_id)%y_centroid), & 'in circle IB patch '//trim(iStr)) @@ -107,10 +107,10 @@ contains call s_int_to_str(patch_id, iStr) @:PROHIBIT(n == 0 .or. p > 0 & - .or. patch_ib(patch_id)%c <= 0d0 & - .or. patch_ib(patch_id)%p <= 0d0 & - .or. patch_ib(patch_id)%t <= 0d0 & - .or. patch_ib(patch_id)%m <= 0d0 & + .or. patch_ib(patch_id)%c <= 0._wp & + .or. patch_ib(patch_id)%p <= 0._wp & + .or. patch_ib(patch_id)%t <= 0._wp & + .or. patch_ib(patch_id)%m <= 0._wp & .or. f_is_default(patch_ib(patch_id)%x_centroid) & .or. f_is_default(patch_ib(patch_id)%y_centroid), & 'in airfoil IB patch '//trim(iStr)) @@ -128,10 +128,10 @@ contains call s_int_to_str(patch_id, iStr) @:PROHIBIT(n == 0 .or. p == 0 & - .or. patch_ib(patch_id)%c <= 0d0 & - .or. patch_ib(patch_id)%p <= 0d0 & - .or. patch_ib(patch_id)%t <= 0d0 & - .or. patch_ib(patch_id)%m <= 0d0 & + .or. patch_ib(patch_id)%c <= 0._wp & + .or. patch_ib(patch_id)%p <= 0._wp & + .or. patch_ib(patch_id)%t <= 0._wp & + .or. patch_ib(patch_id)%m <= 0._wp & .or. f_is_default(patch_ib(patch_id)%x_centroid) & .or. f_is_default(patch_ib(patch_id)%y_centroid) & .or. f_is_default(patch_ib(patch_id)%z_centroid) & @@ -156,9 +156,9 @@ contains .or. & f_is_default(patch_ib(patch_id)%y_centroid) & .or. & - patch_ib(patch_id)%length_x <= 0d0 & + patch_ib(patch_id)%length_x <= 0._wp & .or. & - patch_ib(patch_id)%length_y <= 0d0, & + patch_ib(patch_id)%length_y <= 0._wp, & 'in rectangle IB patch '//trim(iStr)) end subroutine s_check_rectangle_ib_patch_geometry @@ -181,7 +181,7 @@ contains .or. & f_is_default(patch_ib(patch_id)%z_centroid) & .or. & - patch_ib(patch_id)%radius <= 0d0, & + patch_ib(patch_id)%radius <= 0._wp, & 'in sphere IB patch '//trim(iStr)) end subroutine s_check_sphere_ib_patch_geometry @@ -204,23 +204,23 @@ contains .or. & f_is_default(patch_ib(patch_id)%z_centroid) & .or. & - (patch_ib(patch_id)%length_x <= 0d0 .and. & - patch_ib(patch_id)%length_y <= 0d0 .and. & - patch_ib(patch_id)%length_z <= 0d0) & + (patch_ib(patch_id)%length_x <= 0._wp .and. & + patch_ib(patch_id)%length_y <= 0._wp .and. & + patch_ib(patch_id)%length_z <= 0._wp) & .or. & - patch_ib(patch_id)%radius <= 0d0, & + patch_ib(patch_id)%radius <= 0._wp, & 'in cylinder IB patch '//trim(iStr)) @:PROHIBIT( & - (patch_ib(patch_id)%length_x > 0d0 .and. & + (patch_ib(patch_id)%length_x > 0._wp .and. & ((.not. f_is_default(patch_ib(patch_id)%length_y)) .or. & (.not. f_is_default(patch_ib(patch_id)%length_z)))) & .or. & - (patch_ib(patch_id)%length_y > 0d0 .and. & + (patch_ib(patch_id)%length_y > 0._wp .and. & ((.not. f_is_default(patch_ib(patch_id)%length_x)) .or. & (.not. f_is_default(patch_ib(patch_id)%length_z)))) & .or. & - (patch_ib(patch_id)%length_z > 0d0 .and. & + (patch_ib(patch_id)%length_z > 0._wp .and. & ((.not. f_is_default(patch_ib(patch_id)%length_x)) .or. & (.not. f_is_default(patch_ib(patch_id)%length_y)))), & 'in cylinder IB patch '//trim(iStr)) diff --git a/src/pre_process/m_check_patches.fpp b/src/pre_process/m_check_patches.fpp index a9ddc3883b..03c76cd278 100644 --- a/src/pre_process/m_check_patches.fpp +++ b/src/pre_process/m_check_patches.fpp @@ -155,7 +155,7 @@ contains call s_int_to_str(patch_id, iStr) @:PROHIBIT(n > 0, "Line segment patch "//trim(iStr)//": n must be zero") - @:PROHIBIT(patch_icpp(patch_id)%length_x <= 0d0, "Line segment patch "//trim(iStr)//": length_x must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%length_x <= 0._wp, "Line segment patch "//trim(iStr)//": length_x must be greater than zero") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%x_centroid), "Line segment patch "//trim(iStr)//": x_centroid must be set") @:PROHIBIT(cyl_coord, "Line segment patch "//trim(iStr)//": cyl_coord is not supported") @@ -170,7 +170,7 @@ contains @:PROHIBIT(n == 0, "Circle patch "//trim(iStr)//": n must be zero") @:PROHIBIT(p > 0, "Circle patch "//trim(iStr)//": p must be greater than zero") - @:PROHIBIT(patch_icpp(patch_id)%radius <= 0d0, "Circle patch "//trim(iStr)//": radius must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%radius <= 0._wp, "Circle patch "//trim(iStr)//": radius must be greater than zero") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%x_centroid), "Circle patch "//trim(iStr)//": x_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%y_centroid), "Circle patch "//trim(iStr)//": y_centroid must be set") @@ -187,8 +187,8 @@ contains @:PROHIBIT(p > 0, "Rectangle patch "//trim(iStr)//": p must be zero") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%x_centroid), "Rectangle patch "//trim(iStr)//": x_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%y_centroid), "Rectangle patch "//trim(iStr)//": y_centroid must be set") - @:PROHIBIT(patch_icpp(patch_id)%length_x <= 0d0, "Rectangle patch "//trim(iStr)//": length_x must be greater than zero") - @:PROHIBIT(patch_icpp(patch_id)%length_y <= 0d0, "Rectangle patch "//trim(iStr)//": length_y must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%length_x <= 0._wp, "Rectangle patch "//trim(iStr)//": length_x must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%length_y <= 0._wp, "Rectangle patch "//trim(iStr)//": length_y must be greater than zero") end subroutine s_check_rectangle_patch_geometry @@ -220,8 +220,8 @@ contains @:PROHIBIT(p > 0, "Ellipse patch "//trim(iStr)//": p must be zero") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%x_centroid), "Ellipse patch "//trim(iStr)//": x_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%y_centroid), "Ellipse patch "//trim(iStr)//": y_centroid must be set") - @:PROHIBIT(patch_icpp(patch_id)%radii(1) <= 0d0, "Ellipse patch "//trim(iStr)//": radii(1) must be greater than zero") - @:PROHIBIT(patch_icpp(patch_id)%radii(2) <= 0d0, "Ellipse patch "//trim(iStr)//": radii(2) must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%radii(1) <= 0._wp, "Ellipse patch "//trim(iStr)//": radii(1) must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%radii(2) <= 0._wp, "Ellipse patch "//trim(iStr)//": radii(2) must be greater than zero") @:PROHIBIT(.not. f_is_default(patch_icpp(patch_id)%radii(3)), "Ellipse patch "//trim(iStr)//": radii(3) must not be set") end subroutine s_check_ellipse_patch_geometry @@ -237,9 +237,9 @@ contains @:PROHIBIT(p > 0, "Taylor Green vortex patch "//trim(iStr)//": p must be zero") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%x_centroid), "Taylor Green vortex patch "//trim(iStr)//": x_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%y_centroid), "Taylor Green vortex patch "//trim(iStr)//": y_centroid must be set") - @:PROHIBIT(patch_icpp(patch_id)%length_x <= 0d0, "Taylor Green vortex patch "//trim(iStr)//": length_x must be greater than zero") - @:PROHIBIT(patch_icpp(patch_id)%length_y <= 0d0, "Taylor Green vortex patch "//trim(iStr)//": length_y must be greater than zero") - @:PROHIBIT(patch_icpp(patch_id)%vel(2) <= 0d0, "Taylor Green vortex patch "//trim(iStr)//": vel(2) must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%length_x <= 0._wp, "Taylor Green vortex patch "//trim(iStr)//": length_x must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%length_y <= 0._wp, "Taylor Green vortex patch "//trim(iStr)//": length_y must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%vel(2) <= 0._wp, "Taylor Green vortex patch "//trim(iStr)//": vel(2) must be greater than zero") end subroutine s_check_2D_TaylorGreen_vortex_patch_geometry @@ -254,7 +254,7 @@ contains @:PROHIBIT(p > 0, "1D analytical patch "//trim(iStr)//": p must be zero") @:PROHIBIT(model_eqns /= 4 .and. model_eqns /= 2, "1D analytical patch "//trim(iStr)//": model_eqns must be either 4 or 2") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%x_centroid), "1D analytical patch "//trim(iStr)//": x_centroid must be set") - @:PROHIBIT(patch_icpp(patch_id)%length_x <= 0d0, "1D analytical patch "//trim(iStr)//": length_x must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%length_x <= 0._wp, "1D analytical patch "//trim(iStr)//": length_x must be greater than zero") end subroutine s_check_1D_analytical_patch_geometry @@ -269,8 +269,8 @@ contains @:PROHIBIT(p > 0, "2D analytical patch "//trim(iStr)//": p must be zero") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%x_centroid), "2D analytical patch "//trim(iStr)//": x_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%y_centroid), "2D analytical patch "//trim(iStr)//": y_centroid must be set") - @:PROHIBIT(patch_icpp(patch_id)%length_x <= 0d0, "2D analytical patch "//trim(iStr)//": length_x must be greater than zero") - @:PROHIBIT(patch_icpp(patch_id)%length_y <= 0d0, "2D analytical patch "//trim(iStr)//": length_y must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%length_x <= 0._wp, "2D analytical patch "//trim(iStr)//": length_x must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%length_y <= 0._wp, "2D analytical patch "//trim(iStr)//": length_y must be greater than zero") end subroutine s_check_2D_analytical_patch_geometry @@ -285,9 +285,9 @@ contains @:PROHIBIT(f_is_default(patch_icpp(patch_id)%x_centroid), "3D analytical patch "//trim(iStr)//": x_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%y_centroid), "3D analytical patch "//trim(iStr)//": y_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%z_centroid), "3D analytical patch "//trim(iStr)//": z_centroid must be set") - @:PROHIBIT(patch_icpp(patch_id)%length_x <= 0d0, "3D analytical patch "//trim(iStr)//": length_x must be greater than zero") - @:PROHIBIT(patch_icpp(patch_id)%length_y <= 0d0, "3D analytical patch "//trim(iStr)//": length_y must be greater than zero") - @:PROHIBIT(patch_icpp(patch_id)%length_z <= 0d0, "3D analytical patch "//trim(iStr)//": length_z must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%length_x <= 0._wp, "3D analytical patch "//trim(iStr)//": length_x must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%length_y <= 0._wp, "3D analytical patch "//trim(iStr)//": length_y must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%length_z <= 0._wp, "3D analytical patch "//trim(iStr)//": length_z must be greater than zero") end subroutine s_check_3D_analytical_patch_geometry @@ -299,7 +299,7 @@ contains call s_int_to_str(patch_id, iStr) @:PROHIBIT(p == 0, "Sphere patch "//trim(iStr)//": p must be greater than zero") - @:PROHIBIT(patch_icpp(patch_id)%radius <= 0d0, "Sphere patch "//trim(iStr)//": radius must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%radius <= 0._wp, "Sphere patch "//trim(iStr)//": radius must be greater than zero") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%x_centroid), "Sphere patch "//trim(iStr)//": x_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%y_centroid), "Sphere patch "//trim(iStr)//": y_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%z_centroid), "Sphere patch "//trim(iStr)//": z_centroid must be set") @@ -314,13 +314,13 @@ contains call s_int_to_str(patch_id, iStr) @:PROHIBIT(p == 0, "Spherical harmonic patch "//trim(iStr)//": p must be greater than zero") - @:PROHIBIT(patch_icpp(patch_id)%radius <= 0d0, "Spherical harmonic patch "//trim(iStr)//": radius must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%radius <= 0._wp, "Spherical harmonic patch "//trim(iStr)//": radius must be greater than zero") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%x_centroid), "Spherical harmonic patch "//trim(iStr)//": x_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%y_centroid), "Spherical harmonic patch "//trim(iStr)//": y_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%z_centroid), "Spherical harmonic patch "//trim(iStr)//": z_centroid must be set") - @:PROHIBIT(all(patch_icpp(patch_id)%epsilon /= (/1d0, 2d0, 3d0, 4d0, 5d0/)), & + @:PROHIBIT(all(patch_icpp(patch_id)%epsilon /= (/1._wp, 2._wp, 3._wp, 4._wp, 5._wp/)), & "Spherical harmonic patch "//trim(iStr)//": epsilon must be one of 1, 2, 3, 4, 5") - @:PROHIBIT(patch_icpp(patch_id)%beta < 0d0, & + @:PROHIBIT(patch_icpp(patch_id)%beta < 0._wp, & "Spherical harmonic patch "//trim(iStr)//": beta must be greater than or equal to zero") @:PROHIBIT(patch_icpp(patch_id)%beta > patch_icpp(patch_id)%epsilon, & "Spherical harmonic patch "//trim(iStr)//": beta must be less than or equal to epsilon") @@ -339,9 +339,9 @@ contains @:PROHIBIT(f_is_default(patch_icpp(patch_id)%x_centroid), "Cuboid patch "//trim(iStr)//": x_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%y_centroid), "Cuboid patch "//trim(iStr)//": y_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%z_centroid), "Cuboid patch "//trim(iStr)//": z_centroid must be set") - @:PROHIBIT(patch_icpp(patch_id)%length_x <= 0d0, "Cuboid patch "//trim(iStr)//": length_x must be greater than zero") - @:PROHIBIT(patch_icpp(patch_id)%length_y <= 0d0, "Cuboid patch "//trim(iStr)//": length_y must be greater than zero") - @:PROHIBIT(patch_icpp(patch_id)%length_z <= 0d0, "Cuboid patch "//trim(iStr)//": length_z must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%length_x <= 0._wp, "Cuboid patch "//trim(iStr)//": length_x must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%length_y <= 0._wp, "Cuboid patch "//trim(iStr)//": length_y must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%length_z <= 0._wp, "Cuboid patch "//trim(iStr)//": length_z must be greater than zero") end subroutine s_check_cuboid_patch_geometry @@ -357,20 +357,20 @@ contains @:PROHIBIT(f_is_default(patch_icpp(patch_id)%x_centroid), "Cylinder patch "//trim(iStr)//": x_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%y_centroid), "Cylinder patch "//trim(iStr)//": y_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%z_centroid), "Cylinder patch "//trim(iStr)//": z_centroid must be set") - @:PROHIBIT(patch_icpp(patch_id)%radius <= 0d0, "Cylinder patch "//trim(iStr)//": radius must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%radius <= 0._wp, "Cylinder patch "//trim(iStr)//": radius must be greater than zero") ! Check if exactly one length is defined @:PROHIBIT(count([ & - patch_icpp(patch_id)%length_x > 0d0, & - patch_icpp(patch_id)%length_y > 0d0, & - patch_icpp(patch_id)%length_z > 0d0 & + patch_icpp(patch_id)%length_x > 0._wp, & + patch_icpp(patch_id)%length_y > 0._wp, & + patch_icpp(patch_id)%length_z > 0._wp & ]) /= 1, "Cylinder patch "//trim(iStr)//": Exactly one of length_x, length_y, or length_z must be defined and positive") ! Ensure the defined length is positive @:PROHIBIT( & - (.not. f_is_default(patch_icpp(patch_id)%length_x) .and. patch_icpp(patch_id)%length_x <= 0d0) .or. & - (.not. f_is_default(patch_icpp(patch_id)%length_y) .and. patch_icpp(patch_id)%length_y <= 0d0) .or. & - (.not. f_is_default(patch_icpp(patch_id)%length_z) .and. patch_icpp(patch_id)%length_z <= 0d0), & + (.not. f_is_default(patch_icpp(patch_id)%length_x) .and. patch_icpp(patch_id)%length_x <= 0._wp) .or. & + (.not. f_is_default(patch_icpp(patch_id)%length_y) .and. patch_icpp(patch_id)%length_y <= 0._wp) .or. & + (.not. f_is_default(patch_icpp(patch_id)%length_z) .and. patch_icpp(patch_id)%length_z <= 0._wp), & "Cylinder patch "//trim(iStr)//": The defined length_{} must be greater than zero") end subroutine s_check_cylinder_patch_geometry @@ -404,9 +404,9 @@ contains @:PROHIBIT(f_is_default(patch_icpp(patch_id)%x_centroid), "Ellipsoid patch "//trim(iStr)//": x_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%y_centroid), "Ellipsoid patch "//trim(iStr)//": y_centroid must be set") @:PROHIBIT(f_is_default(patch_icpp(patch_id)%z_centroid), "Ellipsoid patch "//trim(iStr)//": z_centroid must be set") - @:PROHIBIT(patch_icpp(patch_id)%radii(1) <= 0d0, "Ellipsoid patch "//trim(iStr)//": radii(1) must be greater than zero") - @:PROHIBIT(patch_icpp(patch_id)%radii(2) <= 0d0, "Ellipsoid patch "//trim(iStr)//": radii(2) must be greater than zero") - @:PROHIBIT(patch_icpp(patch_id)%radii(3) <= 0d0, "Ellipsoid patch "//trim(iStr)//": radii(3) must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%radii(1) <= 0._wp, "Ellipsoid patch "//trim(iStr)//": radii(1) must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%radii(2) <= 0._wp, "Ellipsoid patch "//trim(iStr)//": radii(2) must be greater than zero") + @:PROHIBIT(patch_icpp(patch_id)%radii(3) <= 0._wp, "Ellipsoid patch "//trim(iStr)//": radii(3) must be greater than zero") end subroutine s_check_ellipsoid_patch_geometry @@ -474,7 +474,7 @@ contains "Smoothen enabled. Patch "//trim(iStr)//": smooth_patch_id must be less than patch_id") @:PROHIBIT(patch_icpp(patch_id)%smooth_patch_id == 0, & "Smoothen enabled. Patch "//trim(iStr)//": smooth_patch_id must be greater than zero") - @:PROHIBIT(patch_icpp(patch_id)%smooth_coeff <= 0d0, & + @:PROHIBIT(patch_icpp(patch_id)%smooth_coeff <= 0._wp, & "Smoothen enabled. Patch "//trim(iStr)//": smooth_coeff must be greater than zero") else @:PROHIBIT(patch_icpp(patch_id)%smooth_patch_id /= patch_id, & @@ -520,15 +520,15 @@ contains "Patch "//trim(iStr)//": vel(3) must not be set when p = 0") @:PROHIBIT(p > 0 .and. f_is_default(patch_icpp(patch_id)%vel(3)), & "Patch "//trim(iStr)//": vel(3) must be set when p > 0") - @:PROHIBIT(model_eqns == 1 .and. patch_icpp(patch_id)%rho <= 0d0, & + @:PROHIBIT(model_eqns == 1 .and. patch_icpp(patch_id)%rho <= 0._wp, & "Patch "//trim(iStr)//": rho must be greater than zero when model_eqns = 1") - @:PROHIBIT(model_eqns == 1 .and. patch_icpp(patch_id)%gamma <= 0d0, & + @:PROHIBIT(model_eqns == 1 .and. patch_icpp(patch_id)%gamma <= 0._wp, & "Patch "//trim(iStr)//": gamma must be greater than zero when model_eqns = 1") - @:PROHIBIT(model_eqns == 1 .and. patch_icpp(patch_id)%pi_inf < 0d0, & + @:PROHIBIT(model_eqns == 1 .and. patch_icpp(patch_id)%pi_inf < 0._wp, & "Patch "//trim(iStr)//": pi_inf must be greater than or equal to zero when model_eqns = 1") @:PROHIBIT(patch_icpp(patch_id)%geometry == 5 .and. patch_icpp(patch_id)%pi_inf > 0, & "Patch "//trim(iStr)//": pi_inf must be less than or equal to zero when geometry = 5") - @:PROHIBIT(model_eqns == 2 .and. any(patch_icpp(patch_id)%alpha_rho(1:num_fluids) < 0d0), & + @:PROHIBIT(model_eqns == 2 .and. any(patch_icpp(patch_id)%alpha_rho(1:num_fluids) < 0._wp), & "Patch "//trim(iStr)//": alpha_rho(1:num_fluids) must be greater than or equal to zero when model_eqns = 2") if (model_eqns == 2 .and. num_fluids < num_fluids_max) then @@ -541,7 +541,7 @@ contains end if if (chemistry) then - !@:ASSERT(all(patch_icpp(patch_id)%Y(1:num_species) >= 0d0), "Patch " // trim(iStr) // ".") + !@:ASSERT(all(patch_icpp(patch_id)%Y(1:num_species) >= 0._wp), "Patch " // trim(iStr) // ".") !@:ASSERT(any(patch_icpp(patch_id)%Y(1:num_species) > verysmall), "Patch " // trim(iStr) // ".") end if diff --git a/src/pre_process/m_checker.fpp b/src/pre_process/m_checker.fpp index efd1ef1904..ec5600c76c 100644 --- a/src/pre_process/m_checker.fpp +++ b/src/pre_process/m_checker.fpp @@ -87,11 +87,11 @@ contains "n must be positive (2D or 3D) for cylindrical coordinates") @:PROHIBIT(cyl_coord .and. (f_is_default(y_domain%beg) .or. f_is_default(y_domain%end)), & "y_domain%beg and y_domain%end must be set for n = 0 (2D cylindrical coordinates)") - @:PROHIBIT(cyl_coord .and. (y_domain%beg /= 0d0 .or. y_domain%end <= 0d0), & + @:PROHIBIT(cyl_coord .and. (y_domain%beg /= 0._wp .or. y_domain%end <= 0._wp), & "y_domain%beg must be 0 and y_domain%end must be positive for cylindrical coordinates") @:PROHIBIT(cyl_coord .and. p == 0 .and. ((.not. f_is_default(z_domain%beg)) .or. (.not. f_is_default(z_domain%end))), & "z_domain%beg and z_domain%end are not supported for p = 0 (2D cylindrical coordinates)") - @:PROHIBIT(cyl_coord .and. p > 0 .and. (z_domain%beg /= 0d0 .or. z_domain%end /= 2d0*pi), & + @:PROHIBIT(cyl_coord .and. p > 0 .and. (z_domain%beg /= 0._wp .or. z_domain%end /= 2._wp*pi), & "z_domain%beg must be 0 and z_domain%end must be 2*pi for 3D cylindrical coordinates") @:PROHIBIT(num_patches < 0) @@ -124,11 +124,11 @@ contains !&< Deactivate prettify @:PROHIBIT(stretch_${X}$ .and. (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, & + - 2._wp*log(cosh(0.5_wp*a_${X}$*(${X}$_b - ${X}$_a)))) / a_${X}$ <= 0._wp, & "${X}$_domain%beg is too close to ${X}$_a and ${X}$_b for the given a_${X}$") @:PROHIBIT(stretch_${X}$ .and. (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, & + - 2._wp*log(cosh(0.5_wp*a_${X}$*(${X}$_b - ${X}$_a)))) / a_${X}$ <= 0._wp, & "${X}$_domain%end is too close to ${X}$_a and ${X}$_b for the given a_${X}$") !&> #:endfor @@ -138,7 +138,7 @@ contains !! (qbmm, polydisperse, dist_type, rhoRV, and R0_type) subroutine s_check_inputs_qbmm_and_polydisperse @:PROHIBIT(qbmm .and. dist_type == dflt_int, "dist_type must be set if using QBMM") - @:PROHIBIT(qbmm .and. dist_type /= 1 .and. rhoRV > 0d0, "rhoRV cannot be used with dist_type != 1") + @:PROHIBIT(qbmm .and. dist_type /= 1 .and. rhoRV > 0._wp, "rhoRV cannot be used with dist_type != 1") @:PROHIBIT(polydisperse .and. R0_type == dflt_int, "R0 type must be set if using Polydisperse") end subroutine s_check_inputs_qbmm_and_polydisperse diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp index fd0972ccc2..c76ea65452 100644 --- a/src/pre_process/m_data_output.fpp +++ b/src/pre_process/m_data_output.fpp @@ -215,7 +215,7 @@ contains ! ================================================================== gamma = fluid_pp(1)%gamma - lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 + lit_gamma = 1._wp/fluid_pp(1)%gamma + 1._wp pi_inf = fluid_pp(1)%pi_inf qv = fluid_pp(1)%qv @@ -251,7 +251,7 @@ contains call s_convert_to_mixture_variables(q_cons_vf, j, 0, 0, rho, gamma, pi_inf, qv) - lit_gamma = 1d0/gamma + 1d0 + lit_gamma = 1._wp/gamma + 1._wp if ((i >= chemxb) .and. (i <= chemxe)) then write (2, FMT) x_cb(j), q_cons_vf(i)%sf(j, 0, 0)/rho @@ -272,7 +272,7 @@ contains call s_compute_pressure( & q_cons_vf(E_idx)%sf(j, 0, 0), & q_cons_vf(alf_idx)%sf(j, 0, 0), & - 0.5d0*(q_cons_vf(mom_idx%beg)%sf(j, 0, 0)**2.d0)/rho, & + 0.5_wp*(q_cons_vf(mom_idx%beg)%sf(j, 0, 0)**2._wp)/rho, & pi_inf, gamma, rho, qv, rhoYks, pres) write (2, FMT) x_cb(j), pres else if ((i >= bub_idx%beg) .and. (i <= bub_idx%end) .and. bubbles) then @@ -559,8 +559,8 @@ contains m_MOK = int(m_glb + 1, MPI_OFFSET_KIND) n_MOK = int(n_glb + 1, MPI_OFFSET_KIND) p_MOK = int(p_glb + 1, MPI_OFFSET_KIND) - WP_MOK = int(8d0, MPI_OFFSET_KIND) - MOK = int(1d0, MPI_OFFSET_KIND) + WP_MOK = int(8._wp, MPI_OFFSET_KIND) + MOK = int(1._wp, MPI_OFFSET_KIND) str_MOK = int(name_len, MPI_OFFSET_KIND) NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) @@ -622,8 +622,8 @@ contains m_MOK = int(m_glb + 1, MPI_OFFSET_KIND) n_MOK = int(n_glb + 1, MPI_OFFSET_KIND) p_MOK = int(p_glb + 1, MPI_OFFSET_KIND) - WP_MOK = int(8d0, MPI_OFFSET_KIND) - MOK = int(1d0, MPI_OFFSET_KIND) + WP_MOK = int(8._wp, MPI_OFFSET_KIND) + MOK = int(1._wp, MPI_OFFSET_KIND) str_MOK = int(name_len, MPI_OFFSET_KIND) NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index e73c0c6d90..b0fd8c59fc 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -305,8 +305,8 @@ contains #:for DIM in ['x', 'y', 'z'] #:for DIR in [1, 2, 3] - bc_${DIM}$%vb${DIR}$ = 0d0 - bc_${DIM}$%ve${DIR}$ = 0d0 + bc_${DIM}$%vb${DIR}$ = 0._wp + bc_${DIM}$%ve${DIR}$ = 0._wp #:endfor #:endfor @@ -314,8 +314,8 @@ contains file_per_process = .false. precision = 2 mixlayer_vel_profile = .false. - mixlayer_vel_coef = 1d0 - mixlayer_domain = 1d0 + mixlayer_vel_coef = 1._wp + mixlayer_domain = 1._wp mixlayer_perturb = .false. perturb_flow = .false. perturb_flow_fluid = dflt_int @@ -329,11 +329,11 @@ contains do i = 1, num_patches_max patch_icpp(i)%geometry = dflt_int - patch_icpp(i)%model%scale(:) = 1d0 - patch_icpp(i)%model%translate(:) = 0d0 + patch_icpp(i)%model%scale(:) = 1._wp + patch_icpp(i)%model%translate(:) = 0._wp patch_icpp(i)%model%filepath(:) = ' ' patch_icpp(i)%model%spc = 10 - patch_icpp(i)%model%threshold = 0.9d0 + patch_icpp(i)%model%threshold = 0.9_wp patch_icpp(i)%x_centroid = dflt_real patch_icpp(i)%y_centroid = dflt_real patch_icpp(i)%z_centroid = dflt_real @@ -357,10 +357,10 @@ contains patch_icpp(i)%alpha = dflt_real patch_icpp(i)%gamma = dflt_real patch_icpp(i)%pi_inf = dflt_real - patch_icpp(i)%cv = 0d0 - patch_icpp(i)%qv = 0d0 - patch_icpp(i)%qvp = 0d0 - patch_icpp(i)%tau_e = 0d0 + patch_icpp(i)%cv = 0._wp + patch_icpp(i)%qv = 0._wp + patch_icpp(i)%qvp = 0._wp + patch_icpp(i)%tau_e = 0._wp !should get all of r0's and v0's patch_icpp(i)%r0 = dflt_real patch_icpp(i)%v0 = dflt_real @@ -371,7 +371,7 @@ contains patch_icpp(i)%hcid = dflt_int if (chemistry) then - patch_icpp(i)%Y(:) = 0d0 + patch_icpp(i)%Y(:) = 0._wp end if end do @@ -399,7 +399,7 @@ contains nmom = 1 sigR = dflt_real sigV = dflt_real - rhoRV = 0d0 + rhoRV = 0._wp dist_type = dflt_int R0_type = dflt_int @@ -412,7 +412,7 @@ contains ! surface tension modeling sigma = dflt_real - pi_fac = 1d0 + pi_fac = 1._wp ! Immersed Boundaries ib = .false. @@ -446,10 +446,10 @@ contains fluid_pp(i)%M_v = dflt_real fluid_pp(i)%mu_v = dflt_real fluid_pp(i)%k_v = dflt_real - fluid_pp(i)%cv = 0d0 - fluid_pp(i)%qv = 0d0 - fluid_pp(i)%qvp = 0d0 - fluid_pp(i)%G = 0d0 + fluid_pp(i)%cv = 0._wp + fluid_pp(i)%qv = 0._wp + fluid_pp(i)%qvp = 0._wp + fluid_pp(i)%G = 0._wp end do end subroutine s_assign_default_values_to_user_inputs @@ -568,11 +568,11 @@ contains end if if (nb == 1) then - weight(:) = 1d0 - R0(:) = 1d0 - V0(:) = 1d0 + weight(:) = 1._wp + R0(:) = 1._wp + V0(:) = 1._wp else if (nb > 1) then - V0(:) = 1d0 + V0(:) = 1._wp !R0 and weight initialized in s_simpson else stop 'Invalid value of nb' @@ -581,8 +581,8 @@ contains !Initialize pref,rhoref for polytropic qbmm (done in s_initialize_nonpoly for non-polytropic) if (.not. qbmm) then if (polytropic) then - rhoref = 1.d0 - pref = 1.d0 + rhoref = 1._wp + pref = 1._wp end if end if @@ -593,9 +593,9 @@ contains if ((f_is_default(Web))) then pb0 = pref pb0 = pb0/pref - pref = 1d0 + pref = 1._wp end if - rhoref = 1d0 + rhoref = 1._wp end if end if end if @@ -678,18 +678,18 @@ contains end do if (nb == 1) then - weight(:) = 1d0 - R0(:) = 1d0 - V0(:) = 0d0 + weight(:) = 1._wp + R0(:) = 1._wp + V0(:) = 0._wp else if (nb > 1) then - V0(:) = 1d0 + V0(:) = 1._wp else stop 'Invalid value of nb' end if if (polytropic) then - rhoref = 1.d0 - pref = 1.d0 + rhoref = 1._wp + pref = 1._wp end if end if diff --git a/src/pre_process/m_grid.f90 b/src/pre_process/m_grid.f90 index 7958fe9efa..c2178a8161 100644 --- a/src/pre_process/m_grid.f90 +++ b/src/pre_process/m_grid.f90 @@ -82,12 +82,12 @@ subroutine s_generate_serial_grid x_cb(i) = x_cb(i)/a_x* & (a_x + log(cosh(a_x*(x_cb(i) - x_a))) & + log(cosh(a_x*(x_cb(i) - x_b))) & - - 2d0*log(cosh(a_x*(x_b - x_a)/2d0))) + - 2._wp*log(cosh(a_x*(x_b - x_a)/2._wp))) end do end do x_cb = x_cb*length - x_cc = (x_cb(0:m) + x_cb(-1:m - 1))/2d0 + x_cc = (x_cb(0:m) + x_cb(-1:m - 1))/2._wp dx = minval(x_cb(0:m) - x_cb(-1:m - 1)) print *, 'Stretched grid: min/max x grid: ', minval(x_cc(:)), maxval(x_cc(:)) @@ -99,7 +99,7 @@ subroutine s_generate_serial_grid ! Grid Generation in the y-direction =============================== if (n == 0) return - if (grid_geometry == 2 .and. y_domain%beg == 0.0d0) then + if (grid_geometry == 2 .and. y_domain%beg == 0.0_wp) then !IF (grid_geometry == 2) THEN dy = (y_domain%end - y_domain%beg)/real(2*n + 1, wp) @@ -108,7 +108,7 @@ subroutine s_generate_serial_grid y_cb(-1) = y_domain%beg do i = 1, n - y_cc(i) = y_domain%beg + 2d0*dy*real(i, wp) + y_cc(i) = y_domain%beg + 2._wp*dy*real(i, wp) y_cb(i - 1) = y_domain%beg + dy*real(2*i - 1, wp) end do @@ -137,12 +137,12 @@ subroutine s_generate_serial_grid y_cb(i) = y_cb(i)/a_y* & (a_y + log(cosh(a_y*(y_cb(i) - y_a))) & + log(cosh(a_y*(y_cb(i) - y_b))) & - - 2d0*log(cosh(a_y*(y_b - y_a)/2d0))) + - 2._wp*log(cosh(a_y*(y_b - y_a)/2._wp))) end do end do y_cb = y_cb*length - y_cc = (y_cb(0:n) + y_cb(-1:n - 1))/2d0 + y_cc = (y_cb(0:n) + y_cb(-1:n - 1))/2._wp dy = minval(y_cb(0:n) - y_cb(-1:n - 1)) @@ -175,12 +175,12 @@ subroutine s_generate_serial_grid z_cb(i) = z_cb(i)/a_z* & (a_z + log(cosh(a_z*(z_cb(i) - z_a))) & + log(cosh(a_z*(z_cb(i) - z_b))) & - - 2d0*log(cosh(a_z*(z_b - z_a)/2d0))) + - 2._wp*log(cosh(a_z*(z_b - z_a)/2._wp))) end do end do z_cb = z_cb*length - z_cc = (z_cb(0:p) + z_cb(-1:p - 1))/2d0 + z_cc = (z_cb(0:p) + z_cb(-1:p - 1))/2._wp dz = minval(z_cb(0:p) - z_cb(-1:p - 1)) @@ -237,7 +237,7 @@ subroutine s_generate_parallel_grid x_cb_glb(i) = x_cb_glb(i)/a_x* & (a_x + log(cosh(a_x*(x_cb_glb(i) - x_a))) & + log(cosh(a_x*(x_cb_glb(i) - x_b))) & - - 2d0*log(cosh(a_x*(x_b - x_a)/2d0))) + - 2._wp*log(cosh(a_x*(x_b - x_a)/2._wp))) end do end do @@ -248,7 +248,7 @@ subroutine s_generate_parallel_grid ! Grid generation in the y-direction if (n_glb > 0) then - if (grid_geometry == 2 .and. y_domain%beg == 0.0d0) then + if (grid_geometry == 2 .and. y_domain%beg == 0.0_wp) then dy = (y_domain%end - y_domain%beg)/real(2*n_glb + 1, wp) y_cb_glb(-1) = y_domain%beg do i = 1, n_glb @@ -274,7 +274,7 @@ subroutine s_generate_parallel_grid y_cb_glb(i) = y_cb_glb(i)/a_y* & (a_y + log(cosh(a_y*(y_cb_glb(i) - y_a))) & + log(cosh(a_y*(y_cb_glb(i) - y_b))) & - - 2d0*log(cosh(a_y*(y_b - y_a)/2d0))) + - 2._wp*log(cosh(a_y*(y_b - y_a)/2._wp))) end do end do @@ -301,7 +301,7 @@ subroutine s_generate_parallel_grid z_cb_glb(i) = z_cb_glb(i)/a_z* & (a_z + log(cosh(a_z*(z_cb_glb(i) - z_a))) & + log(cosh(a_z*(z_cb_glb(i) - z_b))) & - - 2d0*log(cosh(a_z*(z_b - z_a)/2d0))) + - 2._wp*log(cosh(a_z*(z_b - z_a)/2._wp))) end do end do diff --git a/src/pre_process/m_mpi_proxy.fpp b/src/pre_process/m_mpi_proxy.fpp index 5c7060655b..de0ad29d95 100644 --- a/src/pre_process/m_mpi_proxy.fpp +++ b/src/pre_process/m_mpi_proxy.fpp @@ -179,7 +179,7 @@ contains tmp_num_procs_x = num_procs_x tmp_num_procs_y = num_procs_y tmp_num_procs_z = num_procs_z - fct_min = 10d0*abs((m + 1)/tmp_num_procs_x & + fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - (n + 1)/tmp_num_procs_y) ! Searching for optimal computational domain distribution @@ -223,9 +223,9 @@ contains tmp_num_procs_x = num_procs_x tmp_num_procs_y = num_procs_y tmp_num_procs_z = num_procs_z - fct_min = 10d0*abs((m + 1)/tmp_num_procs_x & + fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - (n + 1)/tmp_num_procs_y) & - + 10d0*abs((n + 1)/tmp_num_procs_y & + + 10._wp*abs((n + 1)/tmp_num_procs_y & - (p + 1)/tmp_num_procs_z) ! Searching for optimal computational domain distribution @@ -357,7 +357,7 @@ contains ! Computing minimization variable for these initial values tmp_num_procs_x = num_procs_x tmp_num_procs_y = num_procs_y - fct_min = 10d0*abs((m + 1)/tmp_num_procs_x & + fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - (n + 1)/tmp_num_procs_y) ! Searching for optimal computational domain distribution diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index b2b26cecd2..30eb6f67c0 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -105,7 +105,7 @@ contains pi_inf = fluid_pp(1)%pi_inf gamma = fluid_pp(1)%gamma - lit_gamma = (1d0 + gamma)/gamma + lit_gamma = (1._wp + gamma)/gamma ! Transferring the line segment's centroid and length information x_centroid = patch_icpp(patch_id)%x_centroid @@ -113,14 +113,14 @@ contains ! Computing the beginning and end x-coordinates of the line segment ! based on its centroid and length - x_boundary%beg = x_centroid - 0.5d0*length_x - x_boundary%end = x_centroid + 0.5d0*length_x + x_boundary%beg = x_centroid - 0.5_wp*length_x + x_boundary%end = x_centroid + 0.5_wp*length_x ! Since the line segment patch does not allow for its boundaries to ! be smoothed out, the pseudo volume fraction is set to 1 to ensure ! that only the current patch contributes to the fluid state in the ! cells that this patch covers. - eta = 1d0 + eta = 1._wp ! Checking whether the line segment covers a particular cell in the ! domain and verifying whether the current patch has the permission @@ -137,7 +137,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(i, 0, 0) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(i, 0, 0) = patch_id end if end do @@ -172,16 +172,16 @@ contains ! logic_grid = 0 do k = 0, int(m*91*nturns) - th = k/real(int(m*91d0*nturns))*nturns*2.d0*pi + th = k/real(int(m*91._wp*nturns))*nturns*2._wp*pi - spiral_x_min = minval((/f_r(th, 0.0d0, mya)*cos(th), & + spiral_x_min = minval((/f_r(th, 0.0_wp, mya)*cos(th), & f_r(th, thickness, mya)*cos(th)/)) - spiral_y_min = minval((/f_r(th, 0.0d0, mya)*sin(th), & + spiral_y_min = minval((/f_r(th, 0.0_wp, mya)*sin(th), & f_r(th, thickness, mya)*sin(th)/)) - spiral_x_max = maxval((/f_r(th, 0.0d0, mya)*cos(th), & + spiral_x_max = maxval((/f_r(th, 0.0_wp, mya)*cos(th), & f_r(th, thickness, mya)*cos(th)/)) - spiral_y_max = maxval((/f_r(th, 0.0d0, mya)*sin(th), & + spiral_y_max = maxval((/f_r(th, 0.0_wp, mya)*sin(th), & f_r(th, thickness, mya)*sin(th)/)) do j = 0, n; do i = 0, m; @@ -201,7 +201,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id end if end do end do @@ -246,7 +246,7 @@ contains ! Initializing the pseudo volume fraction value to 1. The value will ! be modified as the patch is laid out on the grid, but only in the ! case that smoothing of the circular patch's boundary is enabled. - eta = 1d0 + eta = 1._wp ! Checking whether the circle covers a particular cell in the domain ! and verifying whether the current patch has permission to write to @@ -261,7 +261,7 @@ contains eta = tanh(smooth_coeff/min(dx, dy)* & (sqrt((x_cc(i) - x_centroid)**2 & + (y_cc(j) - y_centroid)**2) & - - radius))*(-0.5d0) + 0.5d0 + - radius))*(-0.5_wp) + 0.5_wp end if @@ -315,7 +315,7 @@ contains pa = patch_ib(patch_id)%p ma = patch_ib(patch_id)%m ta = patch_ib(patch_id)%t - theta = pi*patch_ib(patch_id)%theta/180d0 + theta = pi*patch_ib(patch_id)%theta/180._wp Np1 = int((pa*ca/dx)*20) Np2 = int(((ca - pa*ca)/dx)*20) @@ -330,7 +330,7 @@ contains airfoil_grid_l(1)%x = x0 airfoil_grid_l(1)%y = y0 - eta = 1d0 + eta = 1._wp do i = 1, Np1 + Np2 - 1 if (i <= Np1) then @@ -345,7 +345,7 @@ contains dycdxc = (2*ma/(1 - pa)**2)*(pa - xa) end if - yt = (5d0*ta)*(0.2969*xa**0.5d0 - 0.126*xa - 0.3516*xa**2d0 + 0.2843*xa**3 - 0.1015*xa**4) + yt = (5._wp*ta)*(0.2969*xa**0.5_wp - 0.126*xa - 0.3516*xa**2._wp + 0.2843*xa**3 - 0.1015*xa**4) sin_c = dycdxc/(1 + dycdxc**2)**0.5 cos_c = 1/(1 + dycdxc**2)**0.5 @@ -409,7 +409,7 @@ contains end if else f = (airfoil_grid_u(k)%x - x_act)/(airfoil_grid_u(k)%x - airfoil_grid_u(k - 1)%x) - if (y_act <= ((1d0 - f)*airfoil_grid_u(k)%y + f*airfoil_grid_u(k - 1)%y)) then + if (y_act <= ((1._wp - f)*airfoil_grid_u(k)%y + f*airfoil_grid_u(k - 1)%y)) then !!IB !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & !eta, q_prim_vf, patch_id_fp) @@ -431,7 +431,7 @@ contains else f = (airfoil_grid_l(k)%x - x_act)/(airfoil_grid_l(k)%x - airfoil_grid_l(k - 1)%x) - if (y_act >= ((1d0 - f)*airfoil_grid_l(k)%y + f*airfoil_grid_l(k - 1)%y)) then + if (y_act >= ((1._wp - f)*airfoil_grid_l(k)%y + f*airfoil_grid_l(k - 1)%y)) then !!IB !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & !eta, q_prim_vf, patch_id_fp) @@ -446,10 +446,10 @@ contains if (.not. f_is_default(patch_ib(patch_id)%theta)) then do i = 1, Np airfoil_grid_l(i)%x = (airfoil_grid_l(i)%x - x0)*cos(theta) + (airfoil_grid_l(i)%y - y0)*sin(theta) + x0 - airfoil_grid_l(i)%y = -1d0*(airfoil_grid_l(i)%x - x0)*sin(theta) + (airfoil_grid_l(i)%y - y0)*cos(theta) + y0 + airfoil_grid_l(i)%y = -1._wp*(airfoil_grid_l(i)%x - x0)*sin(theta) + (airfoil_grid_l(i)%y - y0)*cos(theta) + y0 airfoil_grid_u(i)%x = (airfoil_grid_u(i)%x - x0)*cos(theta) + (airfoil_grid_u(i)%y - y0)*sin(theta) + x0 - airfoil_grid_u(i)%y = -1d0*(airfoil_grid_u(i)%x - x0)*sin(theta) + (airfoil_grid_u(i)%y - y0)*cos(theta) + y0 + airfoil_grid_u(i)%y = -1._wp*(airfoil_grid_u(i)%x - x0)*sin(theta) + (airfoil_grid_u(i)%y - y0)*cos(theta) + y0 end do end if @@ -479,7 +479,7 @@ contains pa = patch_ib(patch_id)%p ma = patch_ib(patch_id)%m ta = patch_ib(patch_id)%t - theta = pi*patch_ib(patch_id)%theta/180d0 + theta = pi*patch_ib(patch_id)%theta/180._wp Np1 = int((pa*ca/dx)*20) Np2 = int(((ca - pa*ca)/dx)*20) @@ -497,7 +497,7 @@ contains z_max = z0 + lz/2 z_min = z0 - lz/2 - eta = 1d0 + eta = 1._wp do i = 1, Np1 + Np2 - 1 if (i <= Np1) then @@ -512,7 +512,7 @@ contains dycdxc = (2*ma/(1 - pa)**2)*(pa - xa) end if - yt = (5d0*ta)*(0.2969*xa**0.5d0 - 0.126*xa - 0.3516*xa**2d0 + 0.2843*xa**3 - 0.1015*xa**4) + yt = (5._wp*ta)*(0.2969*xa**0.5_wp - 0.126*xa - 0.3516*xa**2._wp + 0.2843*xa**3 - 0.1015*xa**4) sin_c = dycdxc/(1 + dycdxc**2)**0.5 cos_c = 1/(1 + dycdxc**2)**0.5 @@ -578,7 +578,7 @@ contains end if else f = (airfoil_grid_u(k)%x - x_act)/(airfoil_grid_u(k)%x - airfoil_grid_u(k - 1)%x) - if (y_act <= ((1d0 - f)*airfoil_grid_u(k)%y + f*airfoil_grid_u(k - 1)%y)) then + if (y_act <= ((1._wp - f)*airfoil_grid_u(k)%y + f*airfoil_grid_u(k - 1)%y)) then !!IB !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & !eta, q_prim_vf, patch_id_fp) @@ -600,7 +600,7 @@ contains else f = (airfoil_grid_l(k)%x - x_act)/(airfoil_grid_l(k)%x - airfoil_grid_l(k - 1)%x) - if (y_act >= ((1d0 - f)*airfoil_grid_l(k)%y + f*airfoil_grid_l(k - 1)%y)) then + if (y_act >= ((1._wp - f)*airfoil_grid_l(k)%y + f*airfoil_grid_l(k - 1)%y)) then !!IB !call s_assign_patch_primitive_variables(patch_id, i, j, 0, & !eta, q_prim_vf, patch_id_fp) @@ -617,10 +617,10 @@ contains if (.not. f_is_default(patch_ib(patch_id)%theta)) then do i = 1, Np airfoil_grid_l(i)%x = (airfoil_grid_l(i)%x - x0)*cos(theta) + (airfoil_grid_l(i)%y - y0)*sin(theta) + x0 - airfoil_grid_l(i)%y = -1d0*(airfoil_grid_l(i)%x - x0)*sin(theta) + (airfoil_grid_l(i)%y - y0)*cos(theta) + y0 + airfoil_grid_l(i)%y = -1._wp*(airfoil_grid_l(i)%x - x0)*sin(theta) + (airfoil_grid_l(i)%y - y0)*cos(theta) + y0 airfoil_grid_u(i)%x = (airfoil_grid_u(i)%x - x0)*cos(theta) + (airfoil_grid_u(i)%y - y0)*sin(theta) + x0 - airfoil_grid_u(i)%y = -1d0*(airfoil_grid_u(i)%x - x0)*sin(theta) + (airfoil_grid_u(i)%y - y0)*cos(theta) + y0 + airfoil_grid_u(i)%y = -1._wp*(airfoil_grid_u(i)%x - x0)*sin(theta) + (airfoil_grid_u(i)%y - y0)*cos(theta) + y0 end do end if @@ -654,7 +654,7 @@ contains ! Initializing the pseudo volume fraction value to 1. The value will ! be modified as the patch is laid out on the grid, but only in the ! case that smoothing of the circular patch's boundary is enabled. - eta = 1d0 + eta = 1._wp ! Checking whether the circle covers a particular cell in the domain ! and verifying whether the current patch has permission to write to @@ -665,8 +665,8 @@ contains myr = dsqrt((x_cc(i) - x_centroid)**2 & + (y_cc(j) - y_centroid)**2) - if (myr <= radius + thickness/2.d0 .and. & - myr >= radius - thickness/2.d0 .and. & + if (myr <= radius + thickness/2._wp .and. & + myr >= radius - thickness/2._wp .and. & patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then call s_assign_patch_primitive_variables(patch_id, i, j, 0, & @@ -675,10 +675,10 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id q_prim_vf(alf_idx)%sf(i, j, 0) = patch_icpp(patch_id)%alpha(1)* & - dexp(-0.5d0*((myr - radius)**2.d0)/(thickness/3.d0)**2.d0) + dexp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp) end if end do @@ -714,7 +714,7 @@ contains ! Initializing the pseudo volume fraction value to 1. The value will ! be modified as the patch is laid out on the grid, but only in the ! case that smoothing of the circular patch's boundary is enabled. - eta = 1d0 + eta = 1._wp ! write for all z @@ -728,8 +728,8 @@ contains myr = dsqrt((x_cc(i) - x_centroid)**2 & + (y_cc(j) - y_centroid)**2) - if (myr <= radius + thickness/2.d0 .and. & - myr >= radius - thickness/2.d0 .and. & + if (myr <= radius + thickness/2._wp .and. & + myr >= radius - thickness/2._wp .and. & patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then call s_assign_patch_primitive_variables(patch_id, i, j, k, & @@ -738,10 +738,10 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id q_prim_vf(alf_idx)%sf(i, j, k) = patch_icpp(patch_id)%alpha(1)* & - dexp(-0.5d0*((myr - radius)**2.d0)/(thickness/3.d0)**2.d0) + dexp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp) end if end do @@ -779,7 +779,7 @@ contains ! be modified as the patch is laid out on the grid, but only in ! the case that smoothing of the elliptical patch's boundary is ! enabled. - eta = 1d0 + eta = 1._wp ! Checking whether the ellipse covers a particular cell in the ! domain and verifying whether the current patch has permission @@ -792,11 +792,11 @@ contains eta = tanh(smooth_coeff/min(dx, dy)* & (sqrt(((x_cc(i) - x_centroid)/a)**2 + & ((y_cc(j) - y_centroid)/b)**2) & - - 1d0))*(-0.5d0) + 0.5d0 + - 1._wp))*(-0.5_wp) + 0.5_wp end if if ((((x_cc(i) - x_centroid)/a)**2 + & - ((y_cc(j) - y_centroid)/b)**2 <= 1d0 & + ((y_cc(j) - y_centroid)/b)**2 <= 1._wp & .and. & patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & .or. & @@ -809,7 +809,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id end if end do end do @@ -849,7 +849,7 @@ contains ! be modified as the patch is laid out on the grid, but only in ! the case that smoothing of the ellipsoidal patch's boundary is ! enabled. - eta = 1d0 + eta = 1._wp ! Checking whether the ellipsoid covers a particular cell in the ! domain and verifying whether the current patch has permission @@ -871,12 +871,12 @@ contains (sqrt(((x_cc(i) - x_centroid)/a)**2 + & ((cart_y - y_centroid)/b)**2 + & ((cart_z - z_centroid)/c)**2) & - - 1d0))*(-0.5d0) + 0.5d0 + - 1._wp))*(-0.5_wp) + 0.5_wp end if if ((((x_cc(i) - x_centroid)/a)**2 + & ((cart_y - y_centroid)/b)**2 + & - ((cart_z - z_centroid)/c)**2 <= 1d0 & + ((cart_z - z_centroid)/c)**2 <= 1._wp & .and. & patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) & .or. & @@ -889,7 +889,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id end if end do end do @@ -921,7 +921,7 @@ contains pi_inf = fluid_pp(1)%pi_inf gamma = fluid_pp(1)%gamma - lit_gamma = (1d0 + gamma)/gamma + lit_gamma = (1._wp + gamma)/gamma ! Transferring the rectangle's centroid and length information if (.not. ib) then @@ -938,16 +938,16 @@ contains ! Computing the beginning and the end x- and y-coordinates of the ! rectangle based on its centroid and lengths - x_boundary%beg = x_centroid - 0.5d0*length_x - x_boundary%end = x_centroid + 0.5d0*length_x - y_boundary%beg = y_centroid - 0.5d0*length_y - y_boundary%end = y_centroid + 0.5d0*length_y + x_boundary%beg = x_centroid - 0.5_wp*length_x + x_boundary%end = x_centroid + 0.5_wp*length_x + y_boundary%beg = y_centroid - 0.5_wp*length_y + y_boundary%end = y_centroid + 0.5_wp*length_y ! Since the rectangular patch does not allow for its boundaries to ! be smoothed out, the pseudo volume fraction is set to 1 to ensure ! that only the current patch contributes to the fluid state in the ! cells that this patch covers. - eta = 1d0 + eta = 1._wp ! Checking whether the rectangle covers a particular cell in the ! domain and verifying whether the current patch has the permission @@ -972,12 +972,12 @@ contains if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == 4)) then !zero density, reassign according to Tait EOS q_prim_vf(1)%sf(i, j, 0) = & - (((q_prim_vf(E_idx)%sf(i, j, 0) + pi_inf)/(pref + pi_inf))**(1d0/lit_gamma))* & - rhoref*(1d0 - q_prim_vf(alf_idx)%sf(i, j, 0)) + (((q_prim_vf(E_idx)%sf(i, j, 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))* & + rhoref*(1._wp - q_prim_vf(alf_idx)%sf(i, j, 0)) end if ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id end if end if @@ -996,12 +996,12 @@ contains if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == 4)) then !zero density, reassign according to Tait EOS q_prim_vf(1)%sf(i, j, 0) = & - (((q_prim_vf(E_idx)%sf(i, j, 0) + pi_inf)/(pref + pi_inf))**(1d0/lit_gamma))* & - rhoref*(1d0 - q_prim_vf(alf_idx)%sf(i, j, 0)) + (((q_prim_vf(E_idx)%sf(i, j, 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))* & + rhoref*(1._wp - q_prim_vf(alf_idx)%sf(i, j, 0)) end if ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id end if @@ -1043,7 +1043,7 @@ contains ! Initializing the pseudo volume fraction value to 1. The value will ! be modified as the patch is laid out on the grid, but only in the ! case that smoothing of the sweep line patch's boundary is enabled. - eta = 1d0 + eta = 1._wp ! Checking whether the region swept by the line covers a particular ! cell in the domain and verifying whether the current patch has the @@ -1058,7 +1058,7 @@ contains /sqrt(a**2 + b**2)) end if - if ((a*x_cc(i) + b*y_cc(j) + c >= 0d0 & + if ((a*x_cc(i) + b*y_cc(j) + c >= 0._wp & .and. & patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) & .or. & @@ -1070,7 +1070,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id end if end do @@ -1097,7 +1097,7 @@ contains pi_inf = fluid_pp(1)%pi_inf gamma = fluid_pp(1)%gamma - lit_gamma = (1d0 + gamma)/gamma + lit_gamma = (1._wp + gamma)/gamma ! Transferring the patch's centroid and length information x_centroid = patch_icpp(patch_id)%x_centroid @@ -1107,16 +1107,16 @@ contains ! Computing the beginning and the end x- and y-coordinates ! of the patch based on its centroid and lengths - x_boundary%beg = x_centroid - 0.5d0*length_x - x_boundary%end = x_centroid + 0.5d0*length_x - y_boundary%beg = y_centroid - 0.5d0*length_y - y_boundary%end = y_centroid + 0.5d0*length_y + x_boundary%beg = x_centroid - 0.5_wp*length_x + x_boundary%end = x_centroid + 0.5_wp*length_x + y_boundary%beg = y_centroid - 0.5_wp*length_y + y_boundary%end = y_centroid + 0.5_wp*length_y ! Since the patch doesn't allow for its boundaries to be ! smoothed out, the pseudo volume fraction is set to 1 to ! ensure that only the current patch contributes to the fluid ! state in the cells that this patch covers. - eta = 1d0 + eta = 1._wp ! U0 is the characteristic velocity of the vortex U0 = patch_icpp(patch_id)%vel(1) ! L0 is the characteristic length of the vortex @@ -1140,7 +1140,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id ! Assign Parameters ========================================================= q_prim_vf(mom_idx%beg)%sf(i, j, 0) = U0*sin(x_cc(i)/L0)*cos(y_cc(j)/L0) @@ -1177,7 +1177,7 @@ contains pi_inf = fluid_pp(1)%pi_inf gamma = fluid_pp(1)%gamma - lit_gamma = (1d0 + gamma)/gamma + lit_gamma = (1._wp + gamma)/gamma ! Transferring the patch's centroid and length information x_centroid = patch_icpp(patch_id)%x_centroid @@ -1185,14 +1185,14 @@ contains ! Computing the beginning and the end x- and y-coordinates ! of the patch based on its centroid and lengths - x_boundary%beg = x_centroid - 0.5d0*length_x - x_boundary%end = x_centroid + 0.5d0*length_x + x_boundary%beg = x_centroid - 0.5_wp*length_x + x_boundary%end = x_centroid + 0.5_wp*length_x ! Since the patch doesn't allow for its boundaries to be ! smoothed out, the pseudo volume fraction is set to 1 to ! ensure that only the current patch contributes to the fluid ! state in the cells that this patch covers. - eta = 1d0 + eta = 1._wp ! Checking whether the line segment covers a particular cell in the ! domain and verifying whether the current patch has the permission @@ -1209,7 +1209,7 @@ contains @:Hardcoded1D() ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(i, 0, 0) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(i, 0, 0) = patch_id end if end do @@ -1235,7 +1235,7 @@ contains pi_inf = fluid_pp(1)%pi_inf gamma = fluid_pp(1)%gamma - lit_gamma = (1d0 + gamma)/gamma + lit_gamma = (1._wp + gamma)/gamma ! Transferring the patch's centroid and length information x_centroid = patch_icpp(patch_id)%x_centroid @@ -1243,14 +1243,14 @@ contains ! Computing the beginning and the end x- and y-coordinates ! of the patch based on its centroid and lengths - x_boundary%beg = x_centroid - 0.5d0*length_x - x_boundary%end = x_centroid + 0.5d0*length_x + x_boundary%beg = x_centroid - 0.5_wp*length_x + x_boundary%end = x_centroid + 0.5_wp*length_x ! Since the patch doesn't allow for its boundaries to be ! smoothed out, the pseudo volume fraction is set to 1 to ! ensure that only the current patch contributes to the fluid ! state in the cells that this patch covers. - eta = 1d0 + eta = 1._wp ! Checking whether the line segment covers a particular cell in the ! domain and verifying whether the current patch has the permission @@ -1291,7 +1291,7 @@ contains pi_inf = fluid_pp(1)%pi_inf gamma = fluid_pp(1)%gamma - lit_gamma = (1d0 + gamma)/gamma + lit_gamma = (1._wp + gamma)/gamma ! Transferring the patch's centroid and length information x_centroid = patch_icpp(patch_id)%x_centroid @@ -1301,17 +1301,17 @@ contains ! Computing the beginning and the end x- and y-coordinates ! of the patch based on its centroid and lengths - x_boundary%beg = x_centroid - 0.5d0*length_x - x_boundary%end = x_centroid + 0.5d0*length_x - y_boundary%beg = y_centroid - 0.5d0*length_y - y_boundary%end = y_centroid + 0.5d0*length_y + x_boundary%beg = x_centroid - 0.5_wp*length_x + x_boundary%end = x_centroid + 0.5_wp*length_x + y_boundary%beg = y_centroid - 0.5_wp*length_y + y_boundary%end = y_centroid + 0.5_wp*length_y ! Since the patch doesn't allow for its boundaries to be ! smoothed out, the pseudo volume fraction is set to 1 to ! ensure that only the current patch contributes to the fluid ! state in the cells that this patch covers. - eta = 1d0 - l = 1d0 + eta = 1._wp + l = 1._wp U0 = 0.1 ! Checking whether the patch covers a particular cell in the ! domain and verifying whether the current patch has the @@ -1332,7 +1332,7 @@ contains @:Hardcoded2D() ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id end if end do @@ -1358,7 +1358,7 @@ contains pi_inf = fluid_pp(1)%pi_inf gamma = fluid_pp(1)%gamma - lit_gamma = (1d0 + gamma)/gamma + lit_gamma = (1._wp + gamma)/gamma ! Transferring the patch's centroid and length information x_centroid = patch_icpp(patch_id)%x_centroid @@ -1370,18 +1370,18 @@ contains ! Computing the beginning and the end x-, y- and z-coordinates of ! the patch based on its centroid and lengths - x_boundary%beg = x_centroid - 0.5d0*length_x - x_boundary%end = x_centroid + 0.5d0*length_x - y_boundary%beg = y_centroid - 0.5d0*length_y - y_boundary%end = y_centroid + 0.5d0*length_y - z_boundary%beg = z_centroid - 0.5d0*length_z - z_boundary%end = z_centroid + 0.5d0*length_z + x_boundary%beg = x_centroid - 0.5_wp*length_x + x_boundary%end = x_centroid + 0.5_wp*length_x + y_boundary%beg = y_centroid - 0.5_wp*length_y + y_boundary%end = y_centroid + 0.5_wp*length_y + z_boundary%beg = z_centroid - 0.5_wp*length_z + z_boundary%end = z_centroid + 0.5_wp*length_z ! Since the analytical patch does not allow for its boundaries to get ! smoothed out, the pseudo volume fraction is set to 1 to make sure ! that only the current patch contributes to the fluid state in the ! cells that this patch covers. - eta = 1d0 + eta = 1._wp ! Checking whether the patch covers a particular cell in the domain ! and verifying whether the current patch has permission to write to @@ -1414,7 +1414,7 @@ contains @:Hardcoded3D() ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id end if @@ -1437,7 +1437,7 @@ contains integer :: i, j, k !< generic loop iterators real(wp) :: radius, epsilon, beta - complex(wp) :: cmplx_i = (0d0, 1d0) + complex(wp) :: cmplx_i = (0._wp, 1._wp) complex(wp) :: H ! Transferring the patch's centroid and radius information @@ -1452,7 +1452,7 @@ contains ! smoothed out, the pseudo volume fraction is set to 1 to make sure ! that only the current patch contributes to the fluid state in the ! cells that this patch covers. - eta = 1d0 + eta = 1._wp ! Checking whether the patch covers a particular cell in the domain ! and verifying whether the current patch has permission to write to @@ -1478,72 +1478,72 @@ contains call s_convert_cylindrical_to_spherical_coord(x_cc(i), y_cc(j)) - if (epsilon == 1d0) then - if (beta == 0d0) then - H = 5d-1*sqrt(3d0/pi)*cos(sph_phi) - elseif (beta == 1d0) then - H = -5d-1*sqrt(3d0/(2d0*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi) + if (epsilon == 1._wp) then + if (beta == 0._wp) then + H = 5d-1*sqrt(3._wp/pi)*cos(sph_phi) + elseif (beta == 1._wp) then + H = -5d-1*sqrt(3._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi) end if - elseif (epsilon == 2d0) then - if (beta == 0d0) then - H = 25d-2*sqrt(5d0/pi)*(3d0*cos(sph_phi)**2 - 1d0) - elseif (beta == 1d0) then - H = -5d-1*sqrt(15d0/(2d0*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)*cos(sph_phi) - elseif (beta == 2d0) then - H = 25d-2*sqrt(15d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))*sin(sph_phi)**2 + elseif (epsilon == 2._wp) then + if (beta == 0._wp) then + H = 25d-2*sqrt(5._wp/pi)*(3._wp*cos(sph_phi)**2 - 1._wp) + elseif (beta == 1._wp) then + H = -5d-1*sqrt(15._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)*cos(sph_phi) + elseif (beta == 2._wp) then + H = 25d-2*sqrt(15._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))*sin(sph_phi)**2 end if - elseif (epsilon == 3d0) then - if (beta == 0d0) then - H = 25d-2*sqrt(7d0/pi)*(5d0*cos(sph_phi)**3d0 - 3d0*cos(sph_phi)) - elseif (beta == 1d0) then - H = -125d-3*sqrt(21d0/pi)*exp(cmplx_i*z_cc(k))*sin(sph_phi)* & - (5d0*cos(sph_phi)**2 - 1d0) - elseif (beta == 2d0) then - H = 25d-2*sqrt(105d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & + elseif (epsilon == 3._wp) then + if (beta == 0._wp) then + H = 25d-2*sqrt(7._wp/pi)*(5._wp*cos(sph_phi)**3._wp - 3._wp*cos(sph_phi)) + elseif (beta == 1._wp) then + H = -125d-3*sqrt(21._wp/pi)*exp(cmplx_i*z_cc(k))*sin(sph_phi)* & + (5._wp*cos(sph_phi)**2 - 1._wp) + elseif (beta == 2._wp) then + H = 25d-2*sqrt(105._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* & sin(sph_phi)**2*cos(sph_phi) - elseif (beta == 3d0) then - H = -125d-3*sqrt(35d0/pi)*exp(3d0*cmplx_i*z_cc(k))*sin(sph_phi)**3d0 + elseif (beta == 3._wp) then + H = -125d-3*sqrt(35._wp/pi)*exp(3._wp*cmplx_i*z_cc(k))*sin(sph_phi)**3._wp end if - elseif (epsilon == 4d0) then - if (beta == 0d0) then - H = 3d0/16d0*sqrt(1d0/pi)*(35d0*cos(sph_phi)**4d0 - & - 3d1*cos(sph_phi)**2 + 3d0) - elseif (beta == 1d0) then - H = -3d0/8d0*sqrt(5d0/pi)*exp(cmplx_i*z_cc(k))* & - sin(sph_phi)*(7d0*cos(sph_phi)**3d0 - 3d0*cos(sph_phi)) - elseif (beta == 2d0) then - H = 3d0/8d0*sqrt(5d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & - sin(sph_phi)**2*(7d0*cos(sph_phi)**2 - 1d0) - elseif (beta == 3d0) then - H = -3d0/8d0*sqrt(35d0/pi)*exp(3d0*cmplx_i*z_cc(k))* & - sin(sph_phi)**3d0*cos(sph_phi) - elseif (beta == 4d0) then - H = 3d0/16d0*sqrt(35d0/(2d0*pi))*exp(4d0*cmplx_i*z_cc(k))* & - sin(sph_phi)**4d0 + elseif (epsilon == 4._wp) then + if (beta == 0._wp) then + H = 3._wp/16._wp*sqrt(1._wp/pi)*(35._wp*cos(sph_phi)**4._wp - & + 3d1*cos(sph_phi)**2 + 3._wp) + elseif (beta == 1._wp) then + H = -3._wp/8._wp*sqrt(5._wp/pi)*exp(cmplx_i*z_cc(k))* & + sin(sph_phi)*(7._wp*cos(sph_phi)**3._wp - 3._wp*cos(sph_phi)) + elseif (beta == 2._wp) then + H = 3._wp/8._wp*sqrt(5._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* & + sin(sph_phi)**2*(7._wp*cos(sph_phi)**2 - 1._wp) + elseif (beta == 3._wp) then + H = -3._wp/8._wp*sqrt(35._wp/pi)*exp(3._wp*cmplx_i*z_cc(k))* & + sin(sph_phi)**3._wp*cos(sph_phi) + elseif (beta == 4._wp) then + H = 3._wp/16._wp*sqrt(35._wp/(2._wp*pi))*exp(4._wp*cmplx_i*z_cc(k))* & + sin(sph_phi)**4._wp end if - elseif (epsilon == 5d0) then - if (beta == 0d0) then - H = 1d0/16d0*sqrt(11d0/pi)*(63d0*cos(sph_phi)**5d0 - & - 7d1*cos(sph_phi)**3d0 + 15d0*cos(sph_phi)) - elseif (beta == 1d0) then - H = -1d0/16d0*sqrt(165d0/(2d0*pi))*exp(cmplx_i*z_cc(k))* & - sin(sph_phi)*(21d0*cos(sph_phi)**4d0 - 14d0*cos(sph_phi)**2 + 1d0) - elseif (beta == 2d0) then - H = 125d-3*sqrt(1155d0/(2d0*pi))*exp(2d0*cmplx_i*z_cc(k))* & - sin(sph_phi)**2*(3d0*cos(sph_phi)**3d0 - cos(sph_phi)) - elseif (beta == 3d0) then - H = -1d0/32d0*sqrt(385d0/pi)*exp(3d0*cmplx_i*z_cc(k))* & - sin(sph_phi)**3d0*(9d0*cos(sph_phi)**2 - 1d0) - elseif (beta == 4d0) then - H = 3d0/16d0*sqrt(385d0/(2d0*pi))*exp(4d0*cmplx_i*z_cc(k))* & - sin(sph_phi)**4d0*cos(sph_phi) - elseif (beta == 5d0) then - H = -3d0/32d0*sqrt(77d0/pi)*exp(5d0*cmplx_i*z_cc(k))* & - sin(sph_phi)**5d0 + elseif (epsilon == 5._wp) then + if (beta == 0._wp) then + H = 1._wp/16._wp*sqrt(11._wp/pi)*(63._wp*cos(sph_phi)**5._wp - & + 7d1*cos(sph_phi)**3._wp + 15._wp*cos(sph_phi)) + elseif (beta == 1._wp) then + H = -1._wp/16._wp*sqrt(165._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))* & + sin(sph_phi)*(21._wp*cos(sph_phi)**4._wp - 14._wp*cos(sph_phi)**2 + 1._wp) + elseif (beta == 2._wp) then + H = 125d-3*sqrt(1155._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* & + sin(sph_phi)**2*(3._wp*cos(sph_phi)**3._wp - cos(sph_phi)) + elseif (beta == 3._wp) then + H = -1._wp/32._wp*sqrt(385._wp/pi)*exp(3._wp*cmplx_i*z_cc(k))* & + sin(sph_phi)**3._wp*(9._wp*cos(sph_phi)**2 - 1._wp) + elseif (beta == 4._wp) then + H = 3._wp/16._wp*sqrt(385._wp/(2._wp*pi))*exp(4._wp*cmplx_i*z_cc(k))* & + sin(sph_phi)**4._wp*cos(sph_phi) + elseif (beta == 5._wp) then + H = -3._wp/32._wp*sqrt(77._wp/pi)*exp(5._wp*cmplx_i*z_cc(k))* & + sin(sph_phi)**5._wp end if end if - q_prim_vf(adv_idx%beg)%sf(i, j, k) = 1d0 - abs(real(H, wp)) + q_prim_vf(adv_idx%beg)%sf(i, j, k) = 1._wp - abs(real(H, wp)) end if @@ -1596,7 +1596,7 @@ contains ! Initializing the pseudo volume fraction value to 1. The value will ! be modified as the patch is laid out on the grid, but only in the ! case that smoothing of the spherical patch's boundary is enabled. - eta = 1d0 + eta = 1._wp ! Checking whether the sphere covers a particular cell in the domain ! and verifying whether the current patch has permission to write to @@ -1619,7 +1619,7 @@ contains (sqrt((x_cc(i) - x_centroid)**2 & + (cart_y - y_centroid)**2 & + (cart_z - z_centroid)**2) & - - radius))*(-0.5d0) + 0.5d0 + - radius))*(-0.5_wp) + 0.5_wp end if @@ -1684,18 +1684,18 @@ contains ! Computing the beginning and the end x-, y- and z-coordinates of ! the cuboid based on its centroid and lengths - x_boundary%beg = x_centroid - 0.5d0*length_x - x_boundary%end = x_centroid + 0.5d0*length_x - y_boundary%beg = y_centroid - 0.5d0*length_y - y_boundary%end = y_centroid + 0.5d0*length_y - z_boundary%beg = z_centroid - 0.5d0*length_z - z_boundary%end = z_centroid + 0.5d0*length_z + x_boundary%beg = x_centroid - 0.5_wp*length_x + x_boundary%end = x_centroid + 0.5_wp*length_x + y_boundary%beg = y_centroid - 0.5_wp*length_y + y_boundary%end = y_centroid + 0.5_wp*length_y + z_boundary%beg = z_centroid - 0.5_wp*length_z + z_boundary%end = z_centroid + 0.5_wp*length_z ! Since the cuboidal patch does not allow for its boundaries to get ! smoothed out, the pseudo volume fraction is set to 1 to make sure ! that only the current patch contributes to the fluid state in the ! cells that this patch covers. - eta = 1d0 + eta = 1._wp ! Checking whether the cuboid covers a particular cell in the domain ! and verifying whether the current patch has permission to write to @@ -1728,7 +1728,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id end if end do @@ -1784,17 +1784,17 @@ contains ! Computing the beginning and the end x-, y- and z-coordinates of ! the cylinder based on its centroid and lengths - x_boundary%beg = x_centroid - 0.5d0*length_x - x_boundary%end = x_centroid + 0.5d0*length_x - y_boundary%beg = y_centroid - 0.5d0*length_y - y_boundary%end = y_centroid + 0.5d0*length_y - z_boundary%beg = z_centroid - 0.5d0*length_z - z_boundary%end = z_centroid + 0.5d0*length_z + x_boundary%beg = x_centroid - 0.5_wp*length_x + x_boundary%end = x_centroid + 0.5_wp*length_x + y_boundary%beg = y_centroid - 0.5_wp*length_y + y_boundary%end = y_centroid + 0.5_wp*length_y + z_boundary%beg = z_centroid - 0.5_wp*length_z + z_boundary%end = z_centroid + 0.5_wp*length_z ! Initializing the pseudo volume fraction value to 1. The value will ! be modified as the patch is laid out on the grid, but only in the ! case that smearing of the cylindrical patch's boundary is enabled. - eta = 1d0 + eta = 1._wp ! Checking whether the cylinder covers a particular cell in the ! domain and verifying whether the current patch has the permission @@ -1817,17 +1817,17 @@ contains eta = tanh(smooth_coeff/min(dy, dz)* & (sqrt((cart_y - y_centroid)**2 & + (cart_z - z_centroid)**2) & - - radius))*(-0.5d0) + 0.5d0 + - radius))*(-0.5_wp) + 0.5_wp elseif (.not. f_is_default(length_y)) then eta = tanh(smooth_coeff/min(dx, dz)* & (sqrt((x_cc(i) - x_centroid)**2 & + (cart_z - z_centroid)**2) & - - radius))*(-0.5d0) + 0.5d0 + - radius))*(-0.5_wp) + 0.5_wp else eta = tanh(smooth_coeff/min(dx, dy)* & (sqrt((x_cc(i) - x_centroid)**2 & + (cart_y - y_centroid)**2) & - - radius))*(-0.5d0) + 0.5d0 + - radius))*(-0.5_wp) + 0.5_wp end if end if @@ -1862,7 +1862,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id end if end if @@ -1930,7 +1930,7 @@ contains ! Initializing the pseudo volume fraction value to 1. The value will ! be modified as the patch is laid out on the grid, but only in the ! case that smearing of the sweep plane patch's boundary is enabled. - eta = 1d0 + eta = 1._wp ! Checking whether the region swept by the plane covers a particular ! cell in the domain and verifying whether the current patch has the @@ -1955,7 +1955,7 @@ contains /sqrt(a**2 + b**2 + c**2)) end if - if ((a*x_cc(i) + b*cart_y + c*cart_z + d >= 0d0 & + if ((a*x_cc(i) + b*cart_y + c*cart_z + d >= 0._wp & .and. & patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) & .or. & @@ -1968,7 +1968,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1d0 - eta < 1d-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id end if end do @@ -2017,7 +2017,7 @@ contains if (proc_rank == 0) then write (*, "(A, 3(2X, F20.10))") " > Model: Min:", bbox%min(1:3) - write (*, "(A, 3(2X, F20.10))") " > Cen:", (bbox%min(1:3) + bbox%max(1:3))/2d0 + write (*, "(A, 3(2X, F20.10))") " > Cen:", (bbox%min(1:3) + bbox%max(1:3))/2._wp write (*, "(A, 3(2X, F20.10))") " > Max:", bbox%max(1:3) !call s_model_write("__out__.stl", model) @@ -2029,11 +2029,11 @@ contains if (p > 0) then grid_mm(3, :) = (/minval(z_cc) - 0d5*dz, maxval(z_cc) + 0d5*dz/) else - grid_mm(3, :) = (/0d0, 0d0/) + grid_mm(3, :) = (/0._wp, 0._wp/) end if write (*, "(A, 3(2X, F20.10))") " > Domain: Min:", grid_mm(:, 1) - write (*, "(A, 3(2X, F20.10))") " > Cen:", (grid_mm(:, 1) + grid_mm(:, 2))/2d0 + write (*, "(A, 3(2X, F20.10))") " > Cen:", (grid_mm(:, 1) + grid_mm(:, 2))/2._wp write (*, "(A, 3(2X, F20.10))") " > Max:", grid_mm(:, 2) end if @@ -2047,7 +2047,7 @@ contains nint(100*real(cell_num)/ncells), "%" end if - point = (/x_cc(i), y_cc(j), 0d0/) + point = (/x_cc(i), y_cc(j), 0._wp/) if (p > 0) then point(3) = z_cc(k) end if @@ -2060,13 +2060,13 @@ contains if (patch_icpp(patch_id)%smoothen) then if (eta > patch_icpp(patch_id)%model%threshold) then - eta = 1d0 + eta = 1._wp end if else if (eta > patch_icpp(patch_id)%model%threshold) then - eta = 1d0 + eta = 1._wp else - eta = 0d0 + eta = 0._wp end if end if @@ -2132,7 +2132,7 @@ contains !r(th) = a + b*th - b = 2.d0*a/(2.d0*pi) + b = 2._wp*a/(2._wp*pi) f_r = a + b*myth + offset end function f_r diff --git a/src/pre_process/m_perturbation.fpp b/src/pre_process/m_perturbation.fpp index 8524d20a29..0ef4e2a0cb 100644 --- a/src/pre_process/m_perturbation.fpp +++ b/src/pre_process/m_perturbation.fpp @@ -68,7 +68,7 @@ contains ! Perturb partial density fields to match perturbed volume fraction fields ! IF ((perturb_alpha >= 25d-2) .AND. (perturb_alpha <= 75d-2)) THEN - if ((perturb_alpha /= 0d0) .and. (perturb_alpha /= 1d0)) then + if ((perturb_alpha /= 0._wp) .and. (perturb_alpha /= 1._wp)) then ! Derive new partial densities do l = 1, num_fluids @@ -97,10 +97,10 @@ contains perturb_alpha = q_prim_vf(E_idx + perturb_flow_fluid)%sf(i, j, k) call random_number(rand_real) rand_real = rand_real*perturb_flow_mag - q_prim_vf(mom_idx%beg)%sf(i, j, k) = (1.d0 + rand_real)*q_prim_vf(mom_idx%beg)%sf(i, j, k) + q_prim_vf(mom_idx%beg)%sf(i, j, k) = (1._wp + rand_real)*q_prim_vf(mom_idx%beg)%sf(i, j, k) q_prim_vf(mom_idx%end)%sf(i, j, k) = rand_real*q_prim_vf(mom_idx%beg)%sf(i, j, k) if (bubbles) then - q_prim_vf(alf_idx)%sf(i, j, k) = (1.d0 + rand_real)*q_prim_vf(alf_idx)%sf(i, j, k) + q_prim_vf(alf_idx)%sf(i, j, k) = (1._wp + rand_real)*q_prim_vf(alf_idx)%sf(i, j, k) end if end do end do @@ -120,35 +120,35 @@ contains real(wp) :: uratio, Ldomain integer :: i, j, k, q - uratio = 1d0/patch_icpp(1)%vel(1) + uratio = 1._wp/patch_icpp(1)%vel(1) Ldomain = mixlayer_domain*patch_icpp(1)%length_y - wave = 0d0 - wave1 = 0d0 - wave2 = 0d0 + wave = 0._wp + wave1 = 0._wp + wave2 = 0._wp ! Compute 2D waves - call s_instability_wave(2*pi*4.0/Ldomain, 0d0, wave_tmp, 0d0) + call s_instability_wave(2*pi*4.0/Ldomain, 0._wp, wave_tmp, 0._wp) wave1 = wave1 + wave_tmp - call s_instability_wave(2*pi*2.0/Ldomain, 0d0, wave_tmp, 0d0) + call s_instability_wave(2*pi*2.0/Ldomain, 0._wp, wave_tmp, 0._wp) wave1 = wave1 + wave_tmp - call s_instability_wave(2*pi*1.0/Ldomain, 0d0, wave_tmp, 0d0) + call s_instability_wave(2*pi*1.0/Ldomain, 0._wp, wave_tmp, 0._wp) wave1 = wave1 + wave_tmp wave = wave1*0.05 if (p > 0) then ! Compute 3D waves with phase shifts. - call s_instability_wave(2*pi*4.0/Ldomain, 2*pi*4.0/Ldomain, wave_tmp, 2*pi*11d0/31d0) + call s_instability_wave(2*pi*4.0/Ldomain, 2*pi*4.0/Ldomain, wave_tmp, 2*pi*11._wp/31._wp) wave2 = wave2 + wave_tmp - call s_instability_wave(2*pi*2.0/Ldomain, 2*pi*2.0/Ldomain, wave_tmp, 2*pi*13d0/31d0) + call s_instability_wave(2*pi*2.0/Ldomain, 2*pi*2.0/Ldomain, wave_tmp, 2*pi*13._wp/31._wp) wave2 = wave2 + wave_tmp - call s_instability_wave(2*pi*1.0/Ldomain, 2*pi*1.0/Ldomain, wave_tmp, 2*pi*17d0/31d0) + call s_instability_wave(2*pi*1.0/Ldomain, 2*pi*1.0/Ldomain, wave_tmp, 2*pi*17._wp/31._wp) wave2 = wave2 + wave_tmp - call s_instability_wave(2*pi*4.0/Ldomain, -2*pi*4.0/Ldomain, wave_tmp, 2*pi*19d0/31d0) + call s_instability_wave(2*pi*4.0/Ldomain, -2*pi*4.0/Ldomain, wave_tmp, 2*pi*19._wp/31._wp) wave2 = wave2 + wave_tmp - call s_instability_wave(2*pi*2.0/Ldomain, -2*pi*2.0/Ldomain, wave_tmp, 2*pi*23d0/31d0) + call s_instability_wave(2*pi*2.0/Ldomain, -2*pi*2.0/Ldomain, wave_tmp, 2*pi*23._wp/31._wp) wave2 = wave2 + wave_tmp - call s_instability_wave(2*pi*1.0/Ldomain, -2*pi*1.0/Ldomain, wave_tmp, 2*pi*29d0/31d0) + call s_instability_wave(2*pi*1.0/Ldomain, -2*pi*1.0/Ldomain, wave_tmp, 2*pi*29._wp/31._wp) wave2 = wave2 + wave_tmp wave = wave + 0.15*wave2 end if @@ -184,14 +184,14 @@ contains real(wp) :: gam_b integer :: ii, jj - gam_b = 1d0 + 1d0/fluid_pp(num_fluids + 1)%gamma + gam_b = 1._wp + 1._wp/fluid_pp(num_fluids + 1)%gamma ! Loop ii = 1 do while (.true.) - f0 = (Ca + 2d0/Web)*(fR0/fR)**(3d0*gam_b) - 2d0/(Web*fR) + 1d0 - Ca - fP - f1 = -3d0*gam_b*(Ca + 2d0/Web)*(fR0/fR)**(3d0*gam_b + 1d0) + 2d0/(Web*fR**2d0) + f0 = (Ca + 2._wp/Web)*(fR0/fR)**(3._wp*gam_b) - 2._wp/(Web*fR) + 1._wp - Ca - fP + f1 = -3._wp*gam_b*(Ca + 2._wp/Web)*(fR0/fR)**(3._wp*gam_b + 1._wp) + 2._wp/(Web*fR**2._wp) if (abs(f0) <= 1e-10) then ! Converged @@ -205,7 +205,7 @@ contains if (ieee_is_nan(f0) .or. & ieee_is_nan(f1) .or. & ii > 1000 .or. & - fR < 0d0) then + fR < 0._wp) then print *, "Failed to compute equilibrium radius" @@ -235,20 +235,20 @@ contains integer :: i, j !< generic loop iterators xratio = mixlayer_vel_coef - uratio = 1d0/patch_icpp(1)%vel(1) + uratio = 1._wp/patch_icpp(1)%vel(1) ! Set fluid flow properties if (bubbles) then adv = patch_icpp(1)%alpha(num_fluids) else - adv = 0d0 + adv = 0._wp end if - gam = 1d0 + 1d0/fluid_pp(1)%gamma - pi_inf = fluid_pp(1)%pi_inf*(gam - 1d0)/gam*uratio**2 + gam = 1._wp + 1._wp/fluid_pp(1)%gamma + pi_inf = fluid_pp(1)%pi_inf*(gam - 1._wp)/gam*uratio**2 rho_mean = patch_icpp(1)%alpha_rho(1) p_mean = patch_icpp(1)%pres*uratio**2 - c1 = sqrt((gam*(p_mean + pi_inf))/(rho_mean*(1d0 - adv))) - mach = 1d0/c1 + c1 = sqrt((gam*(p_mean + pi_inf))/(rho_mean*(1._wp - adv))) + mach = 1._wp/c1 ! Assign mean profiles do j = 0, n + 1 @@ -257,15 +257,15 @@ contains ! Compute differential operator in y-dir ! based on 2nd order central difference - d = 0d0 - d(0, 0) = -1d0/((y_cb(0) - y_cb(-1))*xratio) - d(0, 1) = 1d0/((y_cb(0) - y_cb(-1))*xratio) + d = 0._wp + d(0, 0) = -1._wp/((y_cb(0) - y_cb(-1))*xratio) + d(0, 1) = 1._wp/((y_cb(0) - y_cb(-1))*xratio) do j = 1, n - d(j, j - 1) = -1d0/((y_cb(j) - y_cb(j - 2))*xratio) - d(j, j + 1) = 1d0/((y_cb(j) - y_cb(j - 2))*xratio) + d(j, j - 1) = -1._wp/((y_cb(j) - y_cb(j - 2))*xratio) + d(j, j + 1) = 1._wp/((y_cb(j) - y_cb(j - 2))*xratio) end do - d(n + 1, n) = -1d0/((y_cb(n) - y_cb(n - 1))*xratio) - d(n + 1, n + 1) = 1d0/((y_cb(n) - y_cb(n - 1))*xratio) + d(n + 1, n) = -1._wp/((y_cb(n) - y_cb(n - 1))*xratio) + d(n + 1, n + 1) = 1._wp/((y_cb(n) - y_cb(n - 1))*xratio) ! Compute call s_solve_linear_system(alpha, beta, u_mean, rho_mean, p_mean, d, gam, pi_inf, mach, wave, shift) @@ -301,7 +301,7 @@ contains drho_mean(j) = 0 du_mean(j) = 0 do k = 0, nbp - 1 - drho_mean(j) = 0d0 + drho_mean(j) = 0._wp du_mean(j) = du_mean(j) + d(j, k)*u_mean(k) end do end do @@ -310,9 +310,9 @@ contains ! systems of equation (i.e. we are going to solve x for Ax = lambda x). ! Here, B includes components of A without differential operator, and ! C includes components of A with differential operator. - br = 0d0 - bi = 0d0 - ci = 0d0 + br = 0._wp + bi = 0._wp + ci = 0._wp do j = 0, nbp - 1 ii = mixlayer_var(1); jj = mixlayer_var(1); br((ii - 1)*nbp + j, (jj - 1)*nbp + j) = alpha*u_mean(j); ii = mixlayer_var(1); jj = mixlayer_var(2); br((ii - 1)*nbp + j, (jj - 1)*nbp + j) = alpha*rho_mean; @@ -424,8 +424,8 @@ contains end do ! Remove unnecessary rows of the matrix A (rho, u, v, w, p at the boundaries) - fr = 0d0 - fi = 0d0 + fr = 0._wp + fi = 0._wp do ii = 1, mixlayer_nvar do jj = 1, mixlayer_nvar do k = 0, n - 1 @@ -437,8 +437,8 @@ contains end do end do - gr = 0d0 - gi = 0d0 + gr = 0._wp + gi = 0._wp do ii = 1, mixlayer_nvar do j = 0, mixlayer_nvar*n - 1 if (ii <= mixlayer_var(2)) then @@ -460,8 +460,8 @@ contains end do end do - hr = 0d0 - hi = 0d0 + hr = 0._wp + hi = 0._wp do i = 0, mixlayer_nvar*n - n_bc_skip - 1 do jj = 1, mixlayer_nvar if (jj <= mixlayer_var(2)) then @@ -516,7 +516,7 @@ contains vi = zi(:, k) ! Normalize the eigenvector by its component with the largest modulus. - norm = 0d0 + norm = 0._wp do i = 0, mixlayer_nvar*n - n_bc_skip - 1 if (dsqrt(vr(i)**2 + vi(i)**2) > norm) then idx = i @@ -533,8 +533,8 @@ contains end do ! Reassign missing values at boundaries based on the boundary condition - xbr = 0d0 - xbi = 0d0 + xbr = 0._wp + xbi = 0._wp do i = 1, mixlayer_nvar if (i <= mixlayer_var(2)) then do k = 0, n - 1 @@ -579,8 +579,8 @@ contains xbi(mixlayer_var(4)*nbp + nbp - 1) = xbi(mixlayer_var(4)*nbp + n) - xbi(mixlayer_var(2)*nbp + n)*rho_mean/mach ! Compute average to get cell-centered values - xcr = 0d0 - xci = 0d0 + xcr = 0._wp + xci = 0._wp do i = 1, mixlayer_nvar do k = 0, n xcr((i - 1)*(nbp - 1) + k) = 5d-1*(xbr((i - 1)*nbp + k) + xbr((i - 1)*nbp + k + 1)) diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index d08ea409dc..5c31bafb10 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -262,7 +262,7 @@ contains end if ! Computing cell-center locations - x_cc(0:m) = (x_cb(0:m) + x_cb(-1:(m - 1)))/2d0 + x_cc(0:m) = (x_cb(0:m) + x_cb(-1:(m - 1)))/2._wp ! Computing minimum cell-width dx = minval(x_cb(0:m) - x_cb(-1:m - 1)) @@ -294,7 +294,7 @@ contains end if ! Computing cell-center locations - y_cc(0:n) = (y_cb(0:n) + y_cb(-1:(n - 1)))/2d0 + y_cc(0:n) = (y_cb(0:n) + y_cb(-1:(n - 1)))/2._wp ! Computing minimum cell-width dy = minval(y_cb(0:n) - y_cb(-1:n - 1)) @@ -326,7 +326,7 @@ contains end if ! Computing cell-center locations - z_cc(0:p) = (z_cb(0:p) + z_cb(-1:(p - 1)))/2d0 + z_cc(0:p) = (z_cb(0:p) + z_cb(-1:(p - 1)))/2._wp ! Computing minimum cell-width dz = minval(z_cb(0:p) - z_cb(-1:p - 1)) @@ -363,7 +363,7 @@ contains ! Cell-boundary Data Consistency Check in x-direction ============== - if (any(x_cb(0:m) - x_cb(-1:m - 1) <= 0d0)) then + if (any(x_cb(0:m) - x_cb(-1:m - 1) <= 0._wp)) then call s_mpi_abort('x_cb.dat in '//trim(t_step_dir)// & ' contains non-positive cell-spacings. Exiting ...') end if @@ -374,7 +374,7 @@ contains if (n > 0) then - if (any(y_cb(0:n) - y_cb(-1:n - 1) <= 0d0)) then + if (any(y_cb(0:n) - y_cb(-1:n - 1) <= 0._wp)) then call s_mpi_abort('y_cb.dat in '//trim(t_step_dir)// & ' contains non-positive cell-spacings. '// & 'Exiting ...') @@ -386,7 +386,7 @@ contains if (p > 0) then - if (any(z_cb(0:p) - z_cb(-1:p - 1) <= 0d0)) then + if (any(z_cb(0:p) - z_cb(-1:p - 1) <= 0._wp)) then call s_mpi_abort('z_cb.dat in '//trim(t_step_dir)// & ' contains non-positive cell-spacings'// & ' .Exiting ...') @@ -571,7 +571,7 @@ contains ! Assigning local cell boundary locations x_cb(-1:m) = x_cb_glb((start_idx(1) - 1):(start_idx(1) + m)) ! Computing cell center locations - x_cc(0:m) = (x_cb(0:m) + x_cb(-1:(m - 1)))/2d0 + x_cc(0:m) = (x_cb(0:m) + x_cb(-1:(m - 1)))/2._wp ! Computing minimum cell width dx = minval(x_cb(0:m) - x_cb(-1:(m - 1))) if (num_procs > 1) call s_mpi_reduce_min(dx) @@ -596,7 +596,7 @@ contains ! Assigning local cell boundary locations y_cb(-1:n) = y_cb_glb((start_idx(2) - 1):(start_idx(2) + n)) ! Computing cell center locations - y_cc(0:n) = (y_cb(0:n) + y_cb(-1:(n - 1)))/2d0 + y_cc(0:n) = (y_cb(0:n) + y_cb(-1:(n - 1)))/2._wp ! Computing minimum cell width dy = minval(y_cb(0:n) - y_cb(-1:(n - 1))) if (num_procs > 1) call s_mpi_reduce_min(dy) @@ -621,7 +621,7 @@ contains ! Assigning local cell boundary locations z_cb(-1:p) = z_cb_glb((start_idx(3) - 1):(start_idx(3) + p)) ! Computing cell center locations - z_cc(0:p) = (z_cb(0:p) + z_cb(-1:(p - 1)))/2d0 + z_cc(0:p) = (z_cb(0:p) + z_cb(-1:(p - 1)))/2._wp ! Computing minimum cell width dz = minval(z_cb(0:p) - z_cb(-1:(p - 1))) if (num_procs > 1) call s_mpi_reduce_min(dz) @@ -694,8 +694,8 @@ contains m_MOK = int(m_glb + 1, MPI_OFFSET_KIND) n_MOK = int(n_glb + 1, MPI_OFFSET_KIND) p_MOK = int(p_glb + 1, MPI_OFFSET_KIND) - WP_MOK = int(8d0, MPI_OFFSET_KIND) - MOK = int(1d0, MPI_OFFSET_KIND) + WP_MOK = int(8._wp, MPI_OFFSET_KIND) + MOK = int(1._wp, MPI_OFFSET_KIND) str_MOK = int(name_len, MPI_OFFSET_KIND) NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) @@ -777,9 +777,9 @@ contains end if !Initialize pb based on surface tension for qbmm (polytropic) if (qbmm .and. polytropic .and. (.not. f_is_default(Web))) then - pb0 = pref + 2d0*fluid_pp(1)%ss/(R0*R0ref) + pb0 = pref + 2._wp*fluid_pp(1)%ss/(R0*R0ref) pb0 = pb0/pref - pref = 1d0 + pref = 1._wp end if call s_initialize_data_output_module() call s_initialize_variables_conversion_module() @@ -876,7 +876,7 @@ contains end if if (proc_rank == 0) then - time_final = 0d0 + time_final = 0._wp if (num_procs == 1) then time_final = time_avg print *, "Elapsed Time", time_final diff --git a/src/simulation/include/inline_riemann.fpp b/src/simulation/include/inline_riemann.fpp index 761ab07636..cbceb1f21b 100644 --- a/src/simulation/include/inline_riemann.fpp +++ b/src/simulation/include/inline_riemann.fpp @@ -1,9 +1,9 @@ #:def arithmetic_avg() rho_avg = 5d-1*(rho_L + rho_R) - vel_avg_rms = 0d0 + vel_avg_rms = 0._wp !$acc loop seq do i = 1, num_dims - vel_avg_rms = vel_avg_rms + (5d-1*(vel_L(i) + vel_R(i)))**2d0 + vel_avg_rms = vel_avg_rms + (5d-1*(vel_L(i) + vel_R(i)))**2._wp end do H_avg = 5d-1*(H_L + H_R) @@ -13,11 +13,11 @@ #:def roe_avg() rho_avg = sqrt(rho_L*rho_R) - vel_avg_rms = 0d0 + vel_avg_rms = 0._wp !$acc loop seq do i = 1, num_dims - vel_avg_rms = vel_avg_rms + (sqrt(rho_L)*vel_L(i) + sqrt(rho_R)*vel_R(i))**2d0/ & - (sqrt(rho_L) + sqrt(rho_R))**2d0 + vel_avg_rms = vel_avg_rms + (sqrt(rho_L)*vel_L(i) + sqrt(rho_R)*vel_R(i))**2._wp/ & + (sqrt(rho_L) + sqrt(rho_R))**2._wp end do H_avg = (sqrt(rho_L)*H_L + sqrt(rho_R)*H_R)/ & @@ -27,8 +27,8 @@ (sqrt(rho_L) + sqrt(rho_R)) rho_avg = sqrt(rho_L*rho_R) - vel_avg_rms = (sqrt(rho_L)*vel_L(1) + sqrt(rho_R)*vel_R(1))**2d0/ & - (sqrt(rho_L) + sqrt(rho_R))**2d0 + vel_avg_rms = (sqrt(rho_L)*vel_L(1) + sqrt(rho_R)*vel_R(1))**2._wp/ & + (sqrt(rho_L) + sqrt(rho_R))**2._wp #:enddef roe_avg @@ -46,14 +46,14 @@ #:def compute_low_Mach_correction() - zcoef = min(1d0, max(vel_L_rms**5d-1/c_L, vel_R_rms**5d-1/c_R)) - pcorr = 0d0 + zcoef = min(1._wp, max(vel_L_rms**5d-1/c_L, vel_R_rms**5d-1/c_R)) + pcorr = 0._wp if (low_Mach == 1) then pcorr = rho_L*rho_R* & (s_L - vel_L(dir_idx(1)))*(s_R - vel_R(dir_idx(1)))*(vel_R(dir_idx(1)) - vel_L(dir_idx(1)))/ & (rho_R*(s_R - vel_R(dir_idx(1))) - rho_L*(s_L - vel_L(dir_idx(1))))* & - (zcoef - 1d0) + (zcoef - 1._wp) else if (low_Mach == 2) then vel_L_tmp = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_L(dir_idx(1)) - vel_R(dir_idx(1)))) vel_R_tmp = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_R(dir_idx(1)) - vel_L(dir_idx(1)))) diff --git a/src/simulation/m_acoustic_src.fpp b/src/simulation/m_acoustic_src.fpp index 406400390b..dfe2f8a163 100644 --- a/src/simulation/m_acoustic_src.fpp +++ b/src/simulation/m_acoustic_src.fpp @@ -128,12 +128,12 @@ contains element_on(i) = acoustic(i)%element_on end if if (f_is_default(acoustic(i)%rotate_angle)) then - rotate_angle(i) = 0d0 + rotate_angle(i) = 0._wp else rotate_angle(i) = acoustic(i)%rotate_angle end if if (f_is_default(acoustic(i)%delay)) then ! m_checker guarantees acoustic(i)%delay is set for pulse = 2 (Gaussian) - delay(i) = 0d0 ! Defaults to zero for sine and square waves + delay(i) = 0._wp ! Defaults to zero for sine and square waves else delay(i) = acoustic(i)%delay end if @@ -188,11 +188,11 @@ contains do l = 0, p do k = 0, n do j = 0, m - mass_src(j, k, l) = 0d0 - mom_src(1, j, k, l) = 0d0 - e_src(j, k, l) = 0d0 - if (n > 0) mom_src(2, j, k, l) = 0d0 - if (p > 0) mom_src(3, j, k, l) = 0d0 + mass_src(j, k, l) = 0._wp + mom_src(1, j, k, l) = 0._wp + e_src(j, k, l) = 0._wp + if (n > 0) mom_src(2, j, k, l) = 0._wp + if (p > 0) mom_src(3, j, k, l) = 0._wp end do end do end do @@ -215,9 +215,9 @@ contains l = source_spatials(ai)%coord(3, i) ! Compute speed of sound - myRho = 0d0 - B_tait = 0d0 - small_gamma = 0d0 + myRho = 0._wp + B_tait = 0._wp + small_gamma = 0._wp !$acc loop do q = 1, num_fluids @@ -249,8 +249,8 @@ contains end do end if - small_gamma = 1d0/small_gamma + 1d0 - c = dsqrt(small_gamma*(q_prim_vf(E_idx)%sf(j, k, l) + ((small_gamma - 1d0)/small_gamma)*B_tait)/myRho) + small_gamma = 1._wp/small_gamma + 1._wp + c = dsqrt(small_gamma*(q_prim_vf(E_idx)%sf(j, k, l) + ((small_gamma - 1._wp)/small_gamma)*B_tait)/myRho) ! Wavelength to frequency conversion if (pulse(ai) == 1 .or. pulse(ai) == 3) frequency_local = f_frequency_local(freq_conv_flag, ai, c) @@ -261,13 +261,13 @@ contains mom_src_diff = source_temporal*source_spatials(ai)%val(i) if (dipole(ai)) then ! Double amplitude & No momentum source term (only works for Planar) - mass_src(j, k, l) = mass_src(j, k, l) + 2d0*mom_src_diff/c - if (model_eqns /= 4) E_src(j, k, l) = E_src(j, k, l) + 2d0*mom_src_diff*c/(small_gamma - 1d0) + mass_src(j, k, l) = mass_src(j, k, l) + 2._wp*mom_src_diff/c + if (model_eqns /= 4) E_src(j, k, l) = E_src(j, k, l) + 2._wp*mom_src_diff*c/(small_gamma - 1._wp) cycle end if if (n == 0) then ! 1D - mom_src(1, j, k, l) = mom_src(1, j, k, l) + mom_src_diff*sign(1d0, dir(ai)) ! Left or right-going wave + mom_src(1, j, k, l) = mom_src(1, j, k, l) + mom_src_diff*sign(1._wp, dir(ai)) ! Left or right-going wave elseif (p == 0) then ! 2D if (support(ai) < 5) then ! Planar @@ -301,7 +301,7 @@ contains ! Update energy source term if (model_eqns /= 4) then - E_src(j, k, l) = E_src(j, k, l) + mass_src_diff*c**2d0/(small_gamma - 1d0) + E_src(j, k, l) = E_src(j, k, l) + mass_src_diff*c**2._wp/(small_gamma - 1._wp) end if end do @@ -348,40 +348,40 @@ contains integer, parameter :: mass_label = 1 if (n == 0) then - foc_length_factor = 1d0 + foc_length_factor = 1._wp elseif (p == 0 .and. (.not. cyl_coord)) then ! 2D axisymmetric case is physically 3D - foc_length_factor = foc_length(ai)**(-0.85d0); ! Empirical correction + foc_length_factor = foc_length(ai)**(-0.85_wp); ! Empirical correction else foc_length_factor = 1/foc_length(ai); end if - source = 0d0 + source = 0._wp if (pulse(ai) == 1) then ! Sine wave if ((sim_time - delay(ai))*frequency_local > npulse(ai)) return - omega = 2d0*pi*frequency_local + omega = 2._wp*pi*frequency_local source = mag(ai)*sin((sim_time - delay(ai))*omega) if (term_index == mass_label) then - source = source/c + foc_length_factor*mag(ai)*(cos((sim_time - delay(ai))*omega) - 1d0)/omega + source = source/c + foc_length_factor*mag(ai)*(cos((sim_time - delay(ai))*omega) - 1._wp)/omega end if elseif (pulse(ai) == 2) then ! Gaussian pulse - source = mag(ai)*dexp(-0.5d0*((sim_time - delay(ai))**2d0)/(gauss_sigma_time_local**2d0)) + source = mag(ai)*dexp(-0.5_wp*((sim_time - delay(ai))**2._wp)/(gauss_sigma_time_local**2._wp)) if (term_index == mass_label) then source = source/c - & foc_length_factor*mag(ai)*dsqrt(pi/2)*gauss_sigma_time_local* & - (erf((sim_time - delay(ai))/(dsqrt(2d0)*gauss_sigma_time_local)) + 1) + (erf((sim_time - delay(ai))/(dsqrt(2._wp)*gauss_sigma_time_local)) + 1) end if elseif (pulse(ai) == 3) then ! Square wave if ((sim_time - delay(ai))*frequency_local > npulse(ai)) return - omega = 2d0*pi*frequency_local + omega = 2._wp*pi*frequency_local sine_wave = sin((sim_time - delay(ai))*omega) - source = mag(ai)*sign(1d0, sine_wave) + source = mag(ai)*sign(1._wp, sine_wave) ! Prevent max-norm differences due to compilers to pass CI if (abs(sine_wave) < 1d-2) then @@ -534,17 +534,17 @@ contains real(wp) :: dist - source = 0d0 + source = 0._wp if (support(ai) == 1) then ! 1D - source = 1d0/(dsqrt(2d0*pi)*sig/2d0)*dexp(-0.5d0*(r(1)/(sig/2d0))**2d0) + source = 1._wp/(dsqrt(2._wp*pi)*sig/2._wp)*dexp(-0.5_wp*(r(1)/(sig/2._wp))**2._wp) elseif (support(ai) == 2 .or. support(ai) == 3) then ! 2D or 3D ! If we let unit vector e = (cos(dir), sin(dir)), dist = r(1)*cos(dir(ai)) + r(2)*sin(dir(ai)) ! dot(r,e) - if ((r(1) - dist*cos(dir(ai)))**2d0 + (r(2) - dist*sin(dir(ai)))**2d0 < 0.25d0*length(ai)**2d0) then ! |r - dist*e| < length/2 - if (support(ai) /= 3 .or. abs(r(3)) < 0.25d0*height(ai)) then ! additional height constraint for 3D - source = 1d0/(dsqrt(2d0*pi)*sig/2d0)*dexp(-0.5d0*(dist/(sig/2d0))**2d0) + if ((r(1) - dist*cos(dir(ai)))**2._wp + (r(2) - dist*sin(dir(ai)))**2._wp < 0.25_wp*length(ai)**2._wp) then ! |r - dist*e| < length/2 + if (support(ai) /= 3 .or. abs(r(3)) < 0.25_wp*height(ai)) then ! additional height constraint for 3D + source = 1._wp/(dsqrt(2._wp*pi)*sig/2._wp)*dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp) end if end if end if @@ -564,29 +564,29 @@ contains real(wp) :: current_angle, angle_half_aperture, dist, norm - source = 0d0 ! If not affected by transducer - angle = 0d0 - xyz_to_r_ratios = 0d0 + source = 0._wp ! If not affected by transducer + angle = 0._wp + xyz_to_r_ratios = 0._wp if (support(ai) == 5 .or. support(ai) == 6) then ! 2D or 2D axisymmetric current_angle = -atan(r(2)/(foc_length(ai) - r(1))) - angle_half_aperture = asin((aperture(ai)/2d0)/(foc_length(ai))) + angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai))) if (abs(current_angle) < angle_half_aperture .and. r(1) < foc_length(ai)) then - dist = foc_length(ai) - dsqrt(r(2)**2d0 + (foc_length(ai) - r(1))**2d0) - source = 1d0/(dsqrt(2d0*pi)*sig/2d0)*dexp(-0.5d0*(dist/(sig/2d0))**2d0) + dist = foc_length(ai) - dsqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp) + source = 1._wp/(dsqrt(2._wp*pi)*sig/2._wp)*dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp) angle = -atan(r(2)/(foc_length(ai) - r(1))) end if elseif (support(ai) == 7) then ! 3D current_angle = -atan(dsqrt(r(2)**2 + r(3)**2)/(foc_length(ai) - r(1))) - angle_half_aperture = asin((aperture(ai)/2d0)/(foc_length(ai))) + angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai))) if (abs(current_angle) < angle_half_aperture .and. r(1) < foc_length(ai)) then - dist = foc_length(ai) - dsqrt(r(2)**2d0 + r(3)**2d0 + (foc_length(ai) - r(1))**2d0) - source = 1d0/(dsqrt(2d0*pi)*sig/2d0)*dexp(-0.5d0*(dist/(sig/2d0))**2d0) + dist = foc_length(ai) - dsqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp) + source = 1._wp/(dsqrt(2._wp*pi)*sig/2._wp)*dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp) - norm = dsqrt(r(2)**2d0 + r(3)**2d0 + (foc_length(ai) - r(1))**2d0) + norm = dsqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp) xyz_to_r_ratios(1) = -(r(1) - foc_length(ai))/norm xyz_to_r_ratios(2) = -r(2)/norm xyz_to_r_ratios(3) = -r(3)/norm @@ -621,22 +621,22 @@ contains elem_max = element_on(ai) end if - source = 0d0 ! If not affected by any transducer element - angle = 0d0 - xyz_to_r_ratios = 0d0 + source = 0._wp ! If not affected by any transducer element + angle = 0._wp + xyz_to_r_ratios = 0._wp if (support(ai) == 9 .or. support(ai) == 10) then ! 2D or 2D axisymmetric current_angle = -atan(r(2)/(foc_length(ai) - r(1))) - angle_half_aperture = asin((aperture(ai)/2d0)/(foc_length(ai))) - angle_per_elem = (2d0*angle_half_aperture - (num_elements(ai) - 1d0)*element_spacing_angle(ai))/num_elements(ai) - dist = foc_length(ai) - dsqrt(r(2)**2d0 + (foc_length(ai) - r(1))**2d0) + angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai))) + angle_per_elem = (2._wp*angle_half_aperture - (num_elements(ai) - 1._wp)*element_spacing_angle(ai))/num_elements(ai) + dist = foc_length(ai) - dsqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp) do elem = elem_min, elem_max - angle_max = angle_half_aperture - (element_spacing_angle(ai) + angle_per_elem)*(elem - 1d0) + angle_max = angle_half_aperture - (element_spacing_angle(ai) + angle_per_elem)*(elem - 1._wp) angle_min = angle_max - angle_per_elem if (current_angle > angle_min .and. current_angle < angle_max .and. r(1) < foc_length(ai)) then - source = dexp(-0.5d0*(dist/(sig/2d0))**2d0)/(dsqrt(2d0*pi)*sig/2d0) + source = dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(dsqrt(2._wp*pi)*sig/2._wp) angle = current_angle exit ! Assume elements don't overlap end if @@ -646,10 +646,10 @@ contains poly_side_length = aperture(ai)*sin(pi/num_elements(ai)) aperture_element_3D = poly_side_length*element_polygon_ratio(ai) f = foc_length(ai) - half_apert = aperture(ai)/2d0 + half_apert = aperture(ai)/2._wp do elem = elem_min, elem_max - angle_elem = 2d0*pi*real(elem, wp)/real(num_elements(ai), wp) + rotate_angle(ai) + angle_elem = 2._wp*pi*real(elem, wp)/real(num_elements(ai), wp) + rotate_angle(ai) ! Point 2 is the elem center x2 = f - dsqrt(f**2 - half_apert**2) @@ -658,17 +658,17 @@ contains ! Construct a plane normal to the line from the focal point to the elem center, ! Point 3 is the intercept of the plane and the line from the focal point to the current location - C = f**2d0/((r(1) - f)*(x2 - f) + r(2)*y2 + r(3)*z2) ! Constant for intermediate step + C = f**2._wp/((r(1) - f)*(x2 - f) + r(2)*y2 + r(3)*z2) ! Constant for intermediate step x3 = C*(r(1) - f) + f y3 = C*r(2) z3 = C*r(3) - dist_interp_to_elem_center = dsqrt((x2 - x3)**2d0 + (y2 - y3)**2d0 + (z2 - z3)**2d0) - if ((dist_interp_to_elem_center < aperture_element_3D/2d0) .and. (r(1) < f)) then - dist = dsqrt((x3 - r(1))**2d0 + (y3 - r(2))**2d0 + (z3 - r(3))**2d0) - source = dexp(-0.5d0*(dist/(sig/2d0))**2d0)/(dsqrt(2d0*pi)*sig/2d0) + dist_interp_to_elem_center = dsqrt((x2 - x3)**2._wp + (y2 - y3)**2._wp + (z2 - z3)**2._wp) + if ((dist_interp_to_elem_center < aperture_element_3D/2._wp) .and. (r(1) < f)) then + dist = dsqrt((x3 - r(1))**2._wp + (y3 - r(2))**2._wp + (z3 - r(3))**2._wp) + source = dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(dsqrt(2._wp*pi)*sig/2._wp) - norm = dsqrt(r(2)**2d0 + r(3)**2d0 + (f - r(1))**2d0) + norm = dsqrt(r(2)**2._wp + r(3)**2._wp + (f - r(1))**2._wp) xyz_to_r_ratios(1) = -(r(1) - f)/norm xyz_to_r_ratios(2) = -r(2)/norm xyz_to_r_ratios(3) = -r(3)/norm diff --git a/src/simulation/m_body_forces.fpp b/src/simulation/m_body_forces.fpp index f7b2962bee..8a807740ca 100644 --- a/src/simulation/m_body_forces.fpp +++ b/src/simulation/m_body_forces.fpp @@ -91,7 +91,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhoM(j, k, l) = 0d0 + rhoM(j, k, l) = 0._wp do i = 1, num_fluids rhoM(j, k, l) = rhoM(j, k, l) + & q_cons_vf(contxb + i - 1)%sf(j, k, l) @@ -122,7 +122,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - rhs_vf(i)%sf(j, k, l) = 0d0 + rhs_vf(i)%sf(j, k, l) = 0._wp end do end do end do diff --git a/src/simulation/m_boundary_conditions.fpp b/src/simulation/m_boundary_conditions.fpp index 698d5c63ef..a15b144478 100644 --- a/src/simulation/m_boundary_conditions.fpp +++ b/src/simulation/m_boundary_conditions.fpp @@ -920,7 +920,7 @@ contains do j = 1, buff_size if (i == momxb) then q_prim_vf(i)%sf(-j, k, l) = & - -q_prim_vf(i)%sf(j - 1, k, l) + 2d0*bc_x%vb1 + -q_prim_vf(i)%sf(j - 1, k, l) + 2._wp*bc_x%vb1 else q_prim_vf(i)%sf(-j, k, l) = & q_prim_vf(i)%sf(0, k, l) @@ -939,7 +939,7 @@ contains do j = 1, buff_size if (i == momxb) then q_prim_vf(i)%sf(m + j, k, l) = & - -q_prim_vf(i)%sf(m - (j - 1), k, l) + 2d0*bc_x%ve1 + -q_prim_vf(i)%sf(m - (j - 1), k, l) + 2._wp*bc_x%ve1 else q_prim_vf(i)%sf(m + j, k, l) = & q_prim_vf(i)%sf(m, k, l) @@ -963,7 +963,7 @@ contains do l = -buff_size, m + buff_size if (i == momxb + 1) then q_prim_vf(i)%sf(l, -j, k) = & - -q_prim_vf(i)%sf(l, j - 1, k) + 2d0*bc_y%vb2 + -q_prim_vf(i)%sf(l, j - 1, k) + 2._wp*bc_y%vb2 else q_prim_vf(i)%sf(l, -j, k) = & q_prim_vf(i)%sf(l, 0, k) @@ -982,7 +982,7 @@ contains do l = -buff_size, m + buff_size if (i == momxb + 1) then q_prim_vf(i)%sf(l, n + j, k) = & - -q_prim_vf(i)%sf(l, n - (j - 1), k) + 2d0*bc_y%ve2 + -q_prim_vf(i)%sf(l, n - (j - 1), k) + 2._wp*bc_y%ve2 else q_prim_vf(i)%sf(l, n + j, k) = & q_prim_vf(i)%sf(l, n, k) @@ -1006,7 +1006,7 @@ contains do k = -buff_size, m + buff_size if (i == momxe) then q_prim_vf(i)%sf(k, l, -j) = & - -q_prim_vf(i)%sf(k, l, j - 1) + 2d0*bc_z%vb3 + -q_prim_vf(i)%sf(k, l, j - 1) + 2._wp*bc_z%vb3 else q_prim_vf(i)%sf(k, l, -j) = & q_prim_vf(i)%sf(k, l, 0) @@ -1025,7 +1025,7 @@ contains do k = -buff_size, m + buff_size if (i == momxe) then q_prim_vf(i)%sf(k, l, p + j) = & - -q_prim_vf(i)%sf(k, l, p - (j - 1)) + 2d0*bc_z%ve3 + -q_prim_vf(i)%sf(k, l, p - (j - 1)) + 2._wp*bc_z%ve3 else q_prim_vf(i)%sf(k, l, p + j) = & q_prim_vf(i)%sf(k, l, p) @@ -1062,13 +1062,13 @@ contains do j = 1, buff_size if (i == momxb) then q_prim_vf(i)%sf(-j, k, l) = & - -q_prim_vf(i)%sf(j - 1, k, l) + 2d0*bc_x%vb1 + -q_prim_vf(i)%sf(j - 1, k, l) + 2._wp*bc_x%vb1 elseif (i == momxb + 1 .and. num_dims > 1) then q_prim_vf(i)%sf(-j, k, l) = & - -q_prim_vf(i)%sf(j - 1, k, l) + 2d0*bc_x%vb2 + -q_prim_vf(i)%sf(j - 1, k, l) + 2._wp*bc_x%vb2 elseif (i == momxb + 2 .and. num_dims > 2) then q_prim_vf(i)%sf(-j, k, l) = & - -q_prim_vf(i)%sf(j - 1, k, l) + 2d0*bc_x%vb3 + -q_prim_vf(i)%sf(j - 1, k, l) + 2._wp*bc_x%vb3 else q_prim_vf(i)%sf(-j, k, l) = & q_prim_vf(i)%sf(0, k, l) @@ -1087,13 +1087,13 @@ contains do j = 1, buff_size if (i == momxb) then q_prim_vf(i)%sf(m + j, k, l) = & - -q_prim_vf(i)%sf(m - (j - 1), k, l) + 2d0*bc_x%ve1 + -q_prim_vf(i)%sf(m - (j - 1), k, l) + 2._wp*bc_x%ve1 elseif (i == momxb + 1 .and. num_dims > 1) then q_prim_vf(i)%sf(m + j, k, l) = & - -q_prim_vf(i)%sf(m - (j - 1), k, l) + 2d0*bc_x%ve2 + -q_prim_vf(i)%sf(m - (j - 1), k, l) + 2._wp*bc_x%ve2 elseif (i == momxb + 2 .and. num_dims > 2) then q_prim_vf(i)%sf(m + j, k, l) = & - -q_prim_vf(i)%sf(m - (j - 1), k, l) + 2d0*bc_x%ve3 + -q_prim_vf(i)%sf(m - (j - 1), k, l) + 2._wp*bc_x%ve3 else q_prim_vf(i)%sf(m + j, k, l) = & q_prim_vf(i)%sf(m, k, l) @@ -1117,13 +1117,13 @@ contains do l = -buff_size, m + buff_size if (i == momxb) then q_prim_vf(i)%sf(l, -j, k) = & - -q_prim_vf(i)%sf(l, j - 1, k) + 2d0*bc_y%vb1 + -q_prim_vf(i)%sf(l, j - 1, k) + 2._wp*bc_y%vb1 elseif (i == momxb + 1 .and. num_dims > 1) then q_prim_vf(i)%sf(l, -j, k) = & - -q_prim_vf(i)%sf(l, j - 1, k) + 2d0*bc_y%vb2 + -q_prim_vf(i)%sf(l, j - 1, k) + 2._wp*bc_y%vb2 elseif (i == momxb + 2 .and. num_dims > 2) then q_prim_vf(i)%sf(l, -j, k) = & - -q_prim_vf(i)%sf(l, j - 1, k) + 2d0*bc_y%vb3 + -q_prim_vf(i)%sf(l, j - 1, k) + 2._wp*bc_y%vb3 else q_prim_vf(i)%sf(l, -j, k) = & q_prim_vf(i)%sf(l, 0, k) @@ -1142,13 +1142,13 @@ contains do l = -buff_size, m + buff_size if (i == momxb) then q_prim_vf(i)%sf(l, n + j, k) = & - -q_prim_vf(i)%sf(l, n - (j - 1), k) + 2d0*bc_y%ve1 + -q_prim_vf(i)%sf(l, n - (j - 1), k) + 2._wp*bc_y%ve1 elseif (i == momxb + 1 .and. num_dims > 1) then q_prim_vf(i)%sf(l, n + j, k) = & - -q_prim_vf(i)%sf(l, n - (j - 1), k) + 2d0*bc_y%ve2 + -q_prim_vf(i)%sf(l, n - (j - 1), k) + 2._wp*bc_y%ve2 elseif (i == momxb + 2 .and. num_dims > 2) then q_prim_vf(i)%sf(l, n + j, k) = & - -q_prim_vf(i)%sf(l, n - (j - 1), k) + 2d0*bc_y%ve3 + -q_prim_vf(i)%sf(l, n - (j - 1), k) + 2._wp*bc_y%ve3 else q_prim_vf(i)%sf(l, n + j, k) = & q_prim_vf(i)%sf(l, n, k) @@ -1172,13 +1172,13 @@ contains do k = -buff_size, m + buff_size if (i == momxb) then q_prim_vf(i)%sf(k, l, -j) = & - -q_prim_vf(i)%sf(k, l, j - 1) + 2d0*bc_z%vb1 + -q_prim_vf(i)%sf(k, l, j - 1) + 2._wp*bc_z%vb1 elseif (i == momxb + 1 .and. num_dims > 1) then q_prim_vf(i)%sf(k, l, -j) = & - -q_prim_vf(i)%sf(k, l, j - 1) + 2d0*bc_z%vb2 + -q_prim_vf(i)%sf(k, l, j - 1) + 2._wp*bc_z%vb2 elseif (i == momxb + 2 .and. num_dims > 2) then q_prim_vf(i)%sf(k, l, -j) = & - -q_prim_vf(i)%sf(k, l, j - 1) + 2d0*bc_z%vb3 + -q_prim_vf(i)%sf(k, l, j - 1) + 2._wp*bc_z%vb3 else q_prim_vf(i)%sf(k, l, -j) = & q_prim_vf(i)%sf(k, l, 0) @@ -1197,13 +1197,13 @@ contains do k = -buff_size, m + buff_size if (i == momxb) then q_prim_vf(i)%sf(k, l, p + j) = & - -q_prim_vf(i)%sf(k, l, p - (j - 1)) + 2d0*bc_z%ve1 + -q_prim_vf(i)%sf(k, l, p - (j - 1)) + 2._wp*bc_z%ve1 elseif (i == momxb + 1 .and. num_dims > 1) then q_prim_vf(i)%sf(k, l, p + j) = & - -q_prim_vf(i)%sf(k, l, p - (j - 1)) + 2d0*bc_z%ve2 + -q_prim_vf(i)%sf(k, l, p - (j - 1)) + 2._wp*bc_z%ve2 elseif (i == momxb + 2 .and. num_dims > 2) then q_prim_vf(i)%sf(k, l, p + j) = & - -q_prim_vf(i)%sf(k, l, p - (j - 1)) + 2d0*bc_z%ve3 + -q_prim_vf(i)%sf(k, l, p - (j - 1)) + 2._wp*bc_z%ve3 else q_prim_vf(i)%sf(k, l, p + j) = & q_prim_vf(i)%sf(k, l, p) diff --git a/src/simulation/m_bubbles.fpp b/src/simulation/m_bubbles.fpp index 92cc0c47d1..e2b0c8a2fd 100644 --- a/src/simulation/m_bubbles.fpp +++ b/src/simulation/m_bubbles.fpp @@ -21,9 +21,9 @@ module m_bubbles implicit none - real(kind(0.d0)) :: chi_vw !< Bubble wall properties (Ando 2010) - real(kind(0.d0)) :: k_mw !< Bubble wall properties (Ando 2010) - real(kind(0.d0)) :: rho_mw !< Bubble wall properties (Ando 2010) + real(wp) :: chi_vw !< Bubble wall properties (Ando 2010) + real(wp) :: k_mw !< Bubble wall properties (Ando 2010) + real(wp) :: rho_mw !< Bubble wall properties (Ando 2010) !$acc declare create(chi_vw, k_mw, rho_mw) #ifdef CRAY_ACC_WAR @@ -111,12 +111,12 @@ contains do l = 0, p do k = 0, n do j = 0, m - nR3bar = 0d0 + nR3bar = 0._wp !$acc loop seq do i = 1, nb - nR3bar = nR3bar + weight(i)*(q_cons_vf(rs(i))%sf(j, k, l))**3d0 + nR3bar = nR3bar + weight(i)*(q_cons_vf(rs(i))%sf(j, k, l))**3._wp end do - q_cons_vf(alf_idx)%sf(j, k, l) = (4d0*pi*nR3bar)/(3d0*q_cons_vf(n_idx)%sf(j, k, l)**2d0) + q_cons_vf(alf_idx)%sf(j, k, l) = (4._wp*pi*nR3bar)/(3._wp*q_cons_vf(n_idx)%sf(j, k, l)**2._wp) end do end do end do @@ -137,7 +137,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - divu%sf(j, k, l) = 0d0 + divu%sf(j, k, l) = 0._wp divu%sf(j, k, l) = & 5d-1/dx(j)*(q_prim_vf(contxe + idir)%sf(j + 1, k, l) - & q_prim_vf(contxe + idir)%sf(j - 1, k, l)) @@ -214,14 +214,14 @@ contains do l = 0, p do k = 0, n do j = 0, m - bub_adv_src(j, k, l) = 0d0 + bub_adv_src(j, k, l) = 0._wp !$acc loop seq do q = 1, nb - bub_r_src(j, k, l, q) = 0d0 - bub_v_src(j, k, l, q) = 0d0 - bub_p_src(j, k, l, q) = 0d0 - bub_m_src(j, k, l, q) = 0d0 + bub_r_src(j, k, l, q) = 0._wp + bub_v_src(j, k, l, q) = 0._wp + bub_p_src(j, k, l, q) = 0._wp + bub_m_src(j, k, l, q) = 0._wp end do end do end do @@ -241,25 +241,25 @@ contains Vtmp(q) = q_prim_vf(vs(q))%sf(j, k, l) end do - R3 = 0d0 + R3 = 0._wp !$acc loop seq do q = 1, nb - R3 = R3 + weight(q)*Rtmp(q)**3.d0 + R3 = R3 + weight(q)*Rtmp(q)**3._wp end do - nbub = (3.d0/(4.d0*pi))*q_prim_vf(alf_idx)%sf(j, k, l)/R3 + nbub = (3._wp/(4._wp*pi))*q_prim_vf(alf_idx)%sf(j, k, l)/R3 end if if (.not. adap_dt) then - R2Vav = 0d0 + R2Vav = 0._wp !$acc loop seq do q = 1, nb - R2Vav = R2Vav + weight(q)*Rtmp(q)**2.d0*Vtmp(q) + R2Vav = R2Vav + weight(q)*Rtmp(q)**2._wp*Vtmp(q) end do - bub_adv_src(j, k, l) = 4.d0*pi*nbub*R2Vav + bub_adv_src(j, k, l) = 4._wp*pi*nbub*R2Vav end if !$acc loop seq @@ -271,9 +271,9 @@ contains myalpha(ii) = q_cons_vf(advxb + ii - 1)%sf(j, k, l) end do - myRho = 0d0 - n_tait = 0d0 - B_tait = 0d0 + myRho = 0._wp + n_tait = 0._wp + B_tait = 0._wp if (mpp_lim .and. (num_fluids > 2)) then !$acc loop seq @@ -295,7 +295,7 @@ contains B_tait = pi_infs(1)/pi_fac end if - n_tait = 1.d0/n_tait + 1.d0 !make this the usual little 'gamma' + n_tait = 1._wp/n_tait + 1._wp !make this the usual little 'gamma' B_tait = B_tait*(n_tait - 1)/n_tait ! make this the usual pi_inf myRho = q_prim_vf(1)%sf(j, k, l) @@ -312,9 +312,9 @@ contains pbdot = f_bpres_dot(vflux, myR, myV, pb, mv, q) bub_p_src(j, k, l, q) = nbub*pbdot - bub_m_src(j, k, l, q) = nbub*vflux*4.d0*pi*(myR**2.d0) + bub_m_src(j, k, l, q) = nbub*vflux*4._wp*pi*(myR**2._wp) else - pb = 0d0; mv = 0d0; vflux = 0d0; pbdot = 0d0 + pb = 0._wp; mv = 0._wp; vflux = 0._wp; pbdot = 0._wp end if ! Adaptive time stepping @@ -325,10 +325,10 @@ contains bub_adv_src(j, k, l), divu%sf(j, k, l), h) ! Advancing one step - t_new = 0d0 + t_new = 0._wp do while (.true.) - if (t_new + h > 0.5d0*dt) then - h = 0.5d0*dt - t_new + if (t_new + h > 0.5_wp*dt) then + h = 0.5_wp*dt - t_new end if ! Advancing one sub-step @@ -342,26 +342,26 @@ contains ! Advance one sub-step by advancing two half steps call s_advance_substep(myRho, myP, myR, myV, R0(q), & pb, pbdot, alf, n_tait, B_tait, & - bub_adv_src(j, k, l), divu%sf(j, k, l), 0.5d0*h, & + bub_adv_src(j, k, l), divu%sf(j, k, l), 0.5_wp*h, & myR_tmp2, myV_tmp2, err2) call s_advance_substep(myRho, myP, myR_tmp2(4), myV_tmp2(4), R0(q), & pb, pbdot, alf, n_tait, B_tait, & - bub_adv_src(j, k, l), divu%sf(j, k, l), 0.5d0*h, & + bub_adv_src(j, k, l), divu%sf(j, k, l), 0.5_wp*h, & myR_tmp2, myV_tmp2, err3) err4 = abs((myR_tmp1(4) - myR_tmp2(4))/myR_tmp1(4)) err5 = abs((myV_tmp1(4) - myV_tmp2(4))/myV_tmp1(4)) - if (abs(myV_tmp1(4)) < 1e-12) err5 = 0d0 + if (abs(myV_tmp1(4)) < 1e-12) err5 = 0._wp ! Determine acceptance/rejection and update step size ! Rule 1: err1, err2, err3 < tol - ! Rule 2: myR_tmp1(4) > 0d0 + ! Rule 2: myR_tmp1(4) > 0._wp ! Rule 3: abs((myR_tmp1(4) - myR_tmp2(4))/myR) < tol ! Rule 4: abs((myV_tmp1(4) - myV_tmp2(4))/myV) < tol if ((err1 <= 1d-4) .and. (err2 <= 1d-4) .and. (err3 <= 1d-4) & .and. (err4 < 1d-4) .and. (err5 < 1d-4) & - .and. myR_tmp1(4) > 0d0) then + .and. myR_tmp1(4) > 0._wp) then ! Accepted. Finalize the sub-step t_new = t_new + h @@ -371,22 +371,22 @@ contains myV = myV_tmp1(4) ! Update step size for the next sub-step - h = h*min(2d0, max(0.5d0, (1d-4/err1)**(1d0/3d0))) + h = h*min(2._wp, max(0.5_wp, (1d-4/err1)**(1._wp/3._wp))) exit else ! Rejected. Update step size for the next try on sub-step if (err2 <= 1d-4) then - h = 0.5d0*h + h = 0.5_wp*h else - h = 0.25d0*h + h = 0.25_wp*h end if end if end do ! Exit the loop if the final time reached dt - if (t_new == 0.5d0*dt) exit + if (t_new == 0.5_wp*dt) exit end do @@ -402,12 +402,12 @@ contains end if if (alf < 1.d-11) then - bub_adv_src(j, k, l) = 0d0 - bub_r_src(j, k, l, q) = 0d0 - bub_v_src(j, k, l, q) = 0d0 + bub_adv_src(j, k, l) = 0._wp + bub_r_src(j, k, l, q) = 0._wp + bub_v_src(j, k, l, q) = 0._wp if (.not. polytropic) then - bub_p_src(j, k, l, q) = 0d0 - bub_m_src(j, k, l, q) = 0d0 + bub_p_src(j, k, l, q) = 0._wp + bub_m_src(j, k, l, q) = 0._wp end if end if end do @@ -474,8 +474,8 @@ contains f_bub_adv_src, f_divu) ! Compute d0 = ||y0|| and d1 = ||f(x0,y0)|| - d0 = DSQRT((myR_tmp(1)**2d0 + myV_tmp(1)**2d0)/2d0) - d1 = DSQRT((myV_tmp(1)**2d0 + myA_tmp(1)**2d0)/2d0) + d0 = DSQRT((myR_tmp(1)**2._wp + myV_tmp(1)**2._wp)/2._wp) + d1 = DSQRT((myV_tmp(1)**2._wp + myA_tmp(1)**2._wp)/2._wp) if (d0 < 1d-5 .or. d1 < 1d-5) then h0 = 1d-6 else @@ -490,18 +490,18 @@ contains f_bub_adv_src, f_divu) ! Compute d2 = ||f(x0+h0,y0+h0*f(x0,y0))-f(x0,y0)||/h0 - d2 = DSQRT(((myV_tmp(2) - myV_tmp(1))**2d0 + (myA_tmp(2) - myA_tmp(1))**2d0)/2d0)/h0 + d2 = DSQRT(((myV_tmp(2) - myV_tmp(1))**2._wp + (myA_tmp(2) - myA_tmp(1))**2._wp)/2._wp)/h0 ! Set h1 = (0.01/max(d1,d2))^{1/(p+1)} ! if max(d1,d2) < 1e-15, h1 = max(1e-6, h0*1e-3) if (max(d1, d2) < 1d-15) then h1 = max(1d-6, h0*1d-3) else - h1 = (1d-2/max(d1, d2))**(1d0/3d0) + h1 = (1d-2/max(d1, d2))**(1._wp/3._wp) end if ! Set h = min(100*h0,h1) - h = min(100d0*h0, h1) + h = min(100._wp*h0, h1) end subroutine s_initialize_adap_dt @@ -548,25 +548,25 @@ contains f_bub_adv_src, f_divu) ! Stage 2 - myR_tmp(3) = myR_tmp(1) + (h/4d0)*(myV_tmp(1) + myV_tmp(2)) - myV_tmp(3) = myV_tmp(1) + (h/4d0)*(myA_tmp(1) + myA_tmp(2)) + myR_tmp(3) = myR_tmp(1) + (h/4._wp)*(myV_tmp(1) + myV_tmp(2)) + myV_tmp(3) = myV_tmp(1) + (h/4._wp)*(myA_tmp(1) + myA_tmp(2)) myA_tmp(3) = f_rddot(fRho, fP, myR_tmp(3), myV_tmp(3), fR0, & fpb, fpbdot, alf, fntait, fBtait, & f_bub_adv_src, f_divu) ! Stage 3 - myR_tmp(4) = myR_tmp(1) + (h/6d0)*(myV_tmp(1) + myV_tmp(2) + 4d0*myV_tmp(3)) - myV_tmp(4) = myV_tmp(1) + (h/6d0)*(myA_tmp(1) + myA_tmp(2) + 4d0*myA_tmp(3)) + myR_tmp(4) = myR_tmp(1) + (h/6._wp)*(myV_tmp(1) + myV_tmp(2) + 4._wp*myV_tmp(3)) + myV_tmp(4) = myV_tmp(1) + (h/6._wp)*(myA_tmp(1) + myA_tmp(2) + 4._wp*myA_tmp(3)) myA_tmp(4) = f_rddot(fRho, fP, myR_tmp(4), myV_tmp(4), fR0, & fpb, fpbdot, alf, fntait, fBtait, & f_bub_adv_src, f_divu) ! Estimate error - err_R = (-5d0*h/24d0)*(myV_tmp(2) + myV_tmp(3) - 2d0*myV_tmp(4)) & + err_R = (-5._wp*h/24._wp)*(myV_tmp(2) + myV_tmp(3) - 2._wp*myV_tmp(4)) & /max(abs(myR_tmp(1)), abs(myR_tmp(4))) - err_V = (-5d0*h/24d0)*(myA_tmp(2) + myA_tmp(3) - 2d0*myA_tmp(4)) & + err_V = (-5._wp*h/24._wp)*(myA_tmp(2) + myA_tmp(3) - 2._wp*myA_tmp(4)) & /max(abs(myV_tmp(1)), abs(myV_tmp(4))) - err = DSQRT((err_R**2d0 + err_V**2d0)/2d0) + err = DSQRT((err_R**2._wp + err_V**2._wp)/2._wp) end subroutine s_advance_substep @@ -582,9 +582,9 @@ contains real(wp) :: f_cpbw if (polytropic) then - f_cpbw = (Ca + 2.d0/Web/fR0)*((fR0/fR)**(3.d0*gam)) - Ca - 4.d0*Re_inv*fV/fR - 2.d0/(fR*Web) + f_cpbw = (Ca + 2._wp/Web/fR0)*((fR0/fR)**(3._wp*gam)) - Ca - 4._wp*Re_inv*fV/fR - 2._wp/(fR*Web) else - f_cpbw = fpb - 1.d0 - 4.d0*Re_inv*fV/fR - 2.d0/(fR*Web) + f_cpbw = fpb - 1._wp - 4._wp*Re_inv*fV/fR - 2._wp/(fR*Web) end if end function f_cpbw @@ -601,11 +601,11 @@ contains real(wp) :: tmp1, tmp2, tmp3 real(wp) :: f_H - tmp1 = (fntait - 1.d0)/fntait - tmp2 = (fCpbw/(1.d0 + fBtait) + 1.d0)**tmp1 - tmp3 = (fCpinf/(1.d0 + fBtait) + 1.d0)**tmp1 + tmp1 = (fntait - 1._wp)/fntait + tmp2 = (fCpbw/(1._wp + fBtait) + 1._wp)**tmp1 + tmp3 = (fCpinf/(1._wp + fBtait) + 1._wp)**tmp1 - f_H = (tmp2 - tmp3)*fntait*(1.d0 + fBtait)/(fntait - 1.d0) + f_H = (tmp2 - tmp3)*fntait*(1._wp + fBtait)/(fntait - 1._wp) end function f_H @@ -622,10 +622,10 @@ contains real(wp) :: f_cgas ! get sound speed for Gilmore equations "C" -> c_gas - tmp = (fCpinf/(1.d0 + fBtait) + 1.d0)**((fntait - 1.d0)/fntait) - tmp = fntait*(1.d0 + fBtait)*tmp + tmp = (fCpinf/(1._wp + fBtait) + 1._wp)**((fntait - 1._wp)/fntait) + tmp = fntait*(1._wp + fBtait)*tmp - f_cgas = dsqrt(tmp + (fntait - 1.d0)*fH) + f_cgas = dsqrt(tmp + (fntait - 1._wp)*fH) end function f_cgas @@ -649,7 +649,7 @@ contains if (mpp_lim) then c2_liquid = fntait*(fP + fBtait)/fRho else - c2_liquid = fntait*(fP + fBtait)/(fRho*(1.d0 - falf)) + c2_liquid = fntait*(fP + fBtait)/(fRho*(1._wp - falf)) end if ! \dot{Cp_inf} = rho sound^2 (alf_src - divu) @@ -676,23 +676,23 @@ contains real(wp) :: f_Hdot if (polytropic) then - tmp1 = (fR0/fR)**(3.d0*gam) - tmp1 = -3.d0*gam*(Ca + 2d0/Web/fR0)*tmp1*fV/fR + tmp1 = (fR0/fR)**(3._wp*gam) + tmp1 = -3._wp*gam*(Ca + 2._wp/Web/fR0)*tmp1*fV/fR else tmp1 = fpbdot end if - tmp2 = (2.d0/Web + 4.d0*Re_inv*fV)*fV/(fR**2.d0) + tmp2 = (2._wp/Web + 4._wp*Re_inv*fV)*fV/(fR**2._wp) f_Hdot = & - (fCpbw/(1.d0 + fBtait) + 1.d0)**(-1.d0/fntait)*(tmp1 + tmp2) & - - (fCpinf/(1.d0 + fBtait) + 1.d0)**(-1.d0/fntait)*fCpinf_dot + (fCpbw/(1._wp + fBtait) + 1._wp)**(-1._wp/fntait)*(tmp1 + tmp2) & + - (fCpinf/(1._wp + fBtait) + 1._wp)**(-1._wp/fntait)*fCpinf_dot ! Hdot = (Cpbw/(1+B) + 1)^(-1/n_tait)*(-3 gam)*(R0/R)^(3gam) V/R - !f_Hdot = ((fCpbw/(1d0+fBtait)+1.d0)**(-1.d0/fntait))*(-3.d0)*gam * & - ! ( (fR0/fR)**(3.d0*gam ))*(fV/fR) + !f_Hdot = ((fCpbw/(1._wp+fBtait)+1._wp)**(-1._wp/fntait))*(-3._wp)*gam * & + ! ( (fR0/fR)**(3._wp*gam ))*(fV/fR) ! Hdot = Hdot - (Cpinf/(1+B) + 1)^(-1/n_tait) Cpinfdot - !f_Hdot = f_Hdot - ((fCpinf/(1.d0+fBtait)+1.d0)**(-1.d0/fntait))*fCpinf_dot + !f_Hdot = f_Hdot - ((fCpinf/(1._wp+fBtait)+1._wp)**(-1._wp/fntait))*fCpinf_dot end function f_Hdot @@ -730,7 +730,7 @@ contains ! Keller-Miksis bubbles fCpinf = fP fCpbw = f_cpbw_KM(fR0, fR, fV, fpb) - c_liquid = dsqrt(fntait*(fP + fBtait)/(fRho*(1.d0 - alf))) + c_liquid = dsqrt(fntait*(fP + fBtait)/(fRho*(1._wp - alf))) f_rddot = f_rddot_KM(fpbdot, fCpinf, fCpbw, fRho, fR, fV, fR0, c_liquid) else if (bubble_model == 3) then ! Rayleigh-Plesset bubbles @@ -757,7 +757,7 @@ contains !! rddot = (1/r) ( -3/2 rdot^2 + (tmp1 - Cp)/rho ) !! rddot = (1/r) ( tmp2 ) - f_rddot_RP = (-1.5d0*(fV**2d0) + (fCpbw - fCp)/fRho)/fR + f_rddot_RP = (-1.5_wp*(fV**2._wp) + (fCpbw - fCp)/fRho)/fR end function f_rddot_RP @@ -779,12 +779,12 @@ contains real(wp) :: f_rddot_G tmp1 = fV/fcgas - tmp2 = 1.d0 + 4.d0*Re_inv/fcgas/fR*(fCpbw/(1.d0 + fBtait) + 1.d0) & - **(-1.d0/fntait) - tmp3 = 1.5d0*fV**2d0*(tmp1/3.d0 - 1.d0) + fH*(1.d0 + tmp1) & - + fR*fHdot*(1.d0 - tmp1)/fcgas + tmp2 = 1._wp + 4._wp*Re_inv/fcgas/fR*(fCpbw/(1._wp + fBtait) + 1._wp) & + **(-1._wp/fntait) + tmp3 = 1.5_wp*fV**2._wp*(tmp1/3._wp - 1._wp) + fH*(1._wp + tmp1) & + + fR*fHdot*(1._wp - tmp1)/fcgas - f_rddot_G = tmp3/(fR*(1.d0 - tmp1)*tmp2) + f_rddot_G = tmp3/(fR*(1._wp - tmp1)*tmp2) end function f_rddot_G @@ -800,15 +800,15 @@ contains real(wp) :: f_cpbw_KM if (polytropic) then - f_cpbw_KM = Ca*((fR0/fR)**(3.d0*gam)) - Ca + 1d0 + f_cpbw_KM = Ca*((fR0/fR)**(3._wp*gam)) - Ca + 1._wp if (.not. f_is_default(Web)) f_cpbw_KM = f_cpbw_KM + & - (2.d0/(Web*fR0))*((fR0/fR)**(3.d0*gam)) + (2._wp/(Web*fR0))*((fR0/fR)**(3._wp*gam)) else f_cpbw_KM = fpb end if - if (.not. f_is_default(Web)) f_cpbw_KM = f_cpbw_KM - 2.d0/(fR*Web) - if (.not. f_is_default(Re_inv)) f_cpbw_KM = f_cpbw_KM - 4.d0*Re_inv*fV/fR + if (.not. f_is_default(Web)) f_cpbw_KM = f_cpbw_KM - 2._wp/(fR*Web) + if (.not. f_is_default(Re_inv)) f_cpbw_KM = f_cpbw_KM - 4._wp*Re_inv*fV/fR end function f_cpbw_KM @@ -830,25 +830,25 @@ contains real(wp) :: f_rddot_KM if (polytropic) then - cdot_star = -3d0*gam*Ca*((fR0/fR)**(3d0*gam))*fV/fR + cdot_star = -3._wp*gam*Ca*((fR0/fR)**(3._wp*gam))*fV/fR if (.not. f_is_default(Web)) cdot_star = cdot_star - & - 3d0*gam*(2d0/(Web*fR0))*((fR0/fR)**(3d0*gam))*fV/fR + 3._wp*gam*(2._wp/(Web*fR0))*((fR0/fR)**(3._wp*gam))*fV/fR else cdot_star = fpbdot end if - if (.not. f_is_default(Web)) cdot_star = cdot_star + (2d0/Web)*fV/(fR**2d0) - if (.not. f_is_default(Re_inv)) cdot_star = cdot_star + 4d0*Re_inv*((fV/fR)**2d0) + if (.not. f_is_default(Web)) cdot_star = cdot_star + (2._wp/Web)*fV/(fR**2._wp) + if (.not. f_is_default(Re_inv)) cdot_star = cdot_star + 4._wp*Re_inv*((fV/fR)**2._wp) tmp1 = fV/fC - tmp2 = 1.5d0*(fV**2d0)*(tmp1/3d0 - 1d0) + & - (1d0 + tmp1)*(fCpbw - fCp)/fRho + & + tmp2 = 1.5_wp*(fV**2._wp)*(tmp1/3._wp - 1._wp) + & + (1._wp + tmp1)*(fCpbw - fCp)/fRho + & cdot_star*fR/(fRho*fC) if (f_is_default(Re_inv)) then - f_rddot_KM = tmp2/(fR*(1d0 - tmp1)) + f_rddot_KM = tmp2/(fR*(1._wp - tmp1)) else - f_rddot_KM = tmp2/(fR*(1d0 - tmp1) + 4d0*Re_inv/(fRho*fC)) + f_rddot_KM = tmp2/(fR*(1._wp - tmp1) + 4._wp*Re_inv/(fRho*fC)) end if end function f_rddot_KM @@ -858,17 +858,17 @@ contains !! @param iR0 Current bubble size index subroutine s_bwproperty(pb, iR0) !$acc routine seq - real(kind(0.d0)), intent(in) :: pb + real(wp), intent(in) :: pb integer, intent(in) :: iR0 - real(kind(0.d0)) :: x_vw + real(wp) :: x_vw ! mass fraction of vapor - chi_vw = 1.d0/(1.d0 + R_v/R_n*(pb/pv - 1.d0)) + chi_vw = 1._wp/(1._wp + R_v/R_n*(pb/pv - 1._wp)) ! mole fraction of vapor & thermal conductivity of gas mixture x_vw = M_n*chi_vw/(M_v + (M_n - M_v)*chi_vw) - k_mw = x_vw*k_v(iR0)/(x_vw + (1.d0 - x_vw)*phi_vn) & - + (1.d0 - x_vw)*k_n(iR0)/(x_vw*phi_nv + 1.d0 - x_vw) + k_mw = x_vw*k_v(iR0)/(x_vw + (1._wp - x_vw)*phi_vn) & + + (1._wp - x_vw)*k_n(iR0)/(x_vw*phi_nv + 1._wp - x_vw) ! gas mixture density rho_mw = pv/(chi_vw*R_v*Tw) @@ -881,20 +881,20 @@ contains !! @param iR0 Bubble size index function f_vflux(fR, fV, fmass_v, iR0) !$acc routine seq - real(kind(0.d0)), intent(in) :: fR - real(kind(0.d0)), intent(in) :: fV - real(kind(0.d0)), intent(in) :: fmass_v + real(wp), intent(in) :: fR + real(wp), intent(in) :: fV + real(wp), intent(in) :: fmass_v integer, intent(in) :: iR0 - real(kind(0.d0)) :: chi_bar - real(kind(0.d0)) :: grad_chi - real(kind(0.d0)) :: f_vflux + real(wp) :: chi_bar + real(wp) :: grad_chi + real(wp) :: f_vflux if (thermal == 3) then !transfer ! constant transfer model chi_bar = fmass_v/(fmass_v + mass_n0(iR0)) grad_chi = -Re_trans_c(iR0)*(chi_bar - chi_vw) - f_vflux = rho_mw*grad_chi/Pe_c/(1.d0 - chi_vw)/fR + f_vflux = rho_mw*grad_chi/Pe_c/(1._wp - chi_vw)/fR else ! polytropic f_vflux = pv*fV/(R_v*Tw) @@ -912,26 +912,26 @@ contains !! @param iR0 Bubble size index function f_bpres_dot(fvflux, fR, fV, fpb, fmass_v, iR0) !$acc routine seq - real(kind(0.d0)), intent(in) :: fvflux - real(kind(0.d0)), intent(in) :: fR - real(kind(0.d0)), intent(in) :: fV - real(kind(0.d0)), intent(in) :: fpb - real(kind(0.d0)), intent(in) :: fmass_v + real(wp), intent(in) :: fvflux + real(wp), intent(in) :: fR + real(wp), intent(in) :: fV + real(wp), intent(in) :: fpb + real(wp), intent(in) :: fmass_v integer, intent(in) :: iR0 - real(kind(0.d0)) :: T_bar - real(kind(0.d0)) :: grad_T - real(kind(0.d0)) :: tmp1, tmp2 - real(kind(0.d0)) :: f_bpres_dot + real(wp) :: T_bar + real(wp) :: grad_T + real(wp) :: tmp1, tmp2 + real(wp) :: f_bpres_dot if (thermal == 3) then T_bar = Tw*(fpb/pb0(iR0))*(fR/R0(iR0))**3 & *(mass_n0(iR0) + mass_v0(iR0))/(mass_n0(iR0) + fmass_v) grad_T = -Re_trans_T(iR0)*(T_bar - Tw) - f_bpres_dot = 3.d0*gamma_m*(-fV*fpb + fvflux*R_v*Tw & + f_bpres_dot = 3._wp*gamma_m*(-fV*fpb + fvflux*R_v*Tw & + pb0(iR0)*k_mw*grad_T/Pe_T(iR0)/fR)/fR else - f_bpres_dot = -3.d0*gamma_m*fV/fR*(fpb - pv) + f_bpres_dot = -3._wp*gamma_m*fV/fR*(fpb - pv) end if end function f_bpres_dot diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index a5dcdbbb53..b0508b8ff0 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -449,7 +449,7 @@ contains call s_associate_cbc_coefficients_pointers(cbc_dir_in, cbc_loc_in) ! Determining the cell-boundary locations in the s-direction - s_cb(0) = 0d0 + s_cb(0) = 0._wp do i = 0, buff_size s_cb(i + 1) = s_cb(i) + ds(i) @@ -460,8 +460,8 @@ contains if (cbc_dir_in == ${CBC_DIR}$) then if (weno_order == 1) then - fd_coef_${XYZ}$ (:, cbc_loc_in) = 0d0 - fd_coef_${XYZ}$ (0, cbc_loc_in) = -2d0/(ds(0) + ds(1)) + fd_coef_${XYZ}$ (:, cbc_loc_in) = 0._wp + fd_coef_${XYZ}$ (0, cbc_loc_in) = -2._wp/(ds(0) + ds(1)) fd_coef_${XYZ}$ (1, cbc_loc_in) = -fd_coef_${XYZ}$ (0, cbc_loc_in) ! ================================================================== @@ -469,10 +469,10 @@ contains ! Computing CBC2 Coefficients ====================================== elseif (weno_order == 3) then - fd_coef_${XYZ}$ (:, cbc_loc_in) = 0d0 - fd_coef_${XYZ}$ (0, cbc_loc_in) = -6d0/(3d0*ds(0) + 2d0*ds(1) - ds(2)) - fd_coef_${XYZ}$ (1, cbc_loc_in) = -4d0*fd_coef_${XYZ}$ (0, cbc_loc_in)/3d0 - fd_coef_${XYZ}$ (2, cbc_loc_in) = fd_coef_${XYZ}$ (0, cbc_loc_in)/3d0 + fd_coef_${XYZ}$ (:, cbc_loc_in) = 0._wp + fd_coef_${XYZ}$ (0, cbc_loc_in) = -6._wp/(3._wp*ds(0) + 2._wp*ds(1) - ds(2)) + fd_coef_${XYZ}$ (1, cbc_loc_in) = -4._wp*fd_coef_${XYZ}$ (0, cbc_loc_in)/3._wp + fd_coef_${XYZ}$ (2, cbc_loc_in) = fd_coef_${XYZ}$ (0, cbc_loc_in)/3._wp pi_coef_${XYZ}$ (0, 0, cbc_loc_in) = (s_cb(0) - s_cb(1))/(s_cb(0) - s_cb(2)) @@ -481,14 +481,14 @@ contains ! Computing CBC4 Coefficients ====================================== else - fd_coef_${XYZ}$ (:, cbc_loc_in) = 0d0 - fd_coef_${XYZ}$ (0, cbc_loc_in) = -50d0/(25d0*ds(0) + 2d0*ds(1) & + fd_coef_${XYZ}$ (:, cbc_loc_in) = 0._wp + fd_coef_${XYZ}$ (0, cbc_loc_in) = -50._wp/(25._wp*ds(0) + 2._wp*ds(1) & - 1d1*ds(2) + 1d1*ds(3) & - - 3d0*ds(4)) - fd_coef_${XYZ}$ (1, cbc_loc_in) = -48d0*fd_coef_${XYZ}$ (0, cbc_loc_in)/25d0 - fd_coef_${XYZ}$ (2, cbc_loc_in) = 36d0*fd_coef_${XYZ}$ (0, cbc_loc_in)/25d0 - fd_coef_${XYZ}$ (3, cbc_loc_in) = -16d0*fd_coef_${XYZ}$ (0, cbc_loc_in)/25d0 - fd_coef_${XYZ}$ (4, cbc_loc_in) = 3d0*fd_coef_${XYZ}$ (0, cbc_loc_in)/25d0 + - 3._wp*ds(4)) + fd_coef_${XYZ}$ (1, cbc_loc_in) = -48._wp*fd_coef_${XYZ}$ (0, cbc_loc_in)/25._wp + fd_coef_${XYZ}$ (2, cbc_loc_in) = 36._wp*fd_coef_${XYZ}$ (0, cbc_loc_in)/25._wp + fd_coef_${XYZ}$ (3, cbc_loc_in) = -16._wp*fd_coef_${XYZ}$ (0, cbc_loc_in)/25._wp + fd_coef_${XYZ}$ (4, cbc_loc_in) = 3._wp*fd_coef_${XYZ}$ (0, cbc_loc_in)/25._wp pi_coef_${XYZ}$ (0, 0, cbc_loc_in) = & ((s_cb(0) - s_cb(1))*(s_cb(1) - s_cb(2))* & @@ -778,10 +778,10 @@ contains vel(i) = q_prim_rs${XYZ}$_vf(0, k, r, contxe + i) end do - vel_K_sum = 0d0 + vel_K_sum = 0._wp !$acc loop seq do i = 1, num_dims - vel_K_sum = vel_K_sum + vel(i)**2d0 + vel_K_sum = vel_K_sum + vel(i)**2._wp end do pres = q_prim_rs${XYZ}$_vf(0, k, r, E_idx) @@ -814,18 +814,18 @@ contains !$acc loop seq do i = 1, contxe - dalpha_rho_ds(i) = 0d0 + dalpha_rho_ds(i) = 0._wp end do !$acc loop seq do i = 1, num_dims - dvel_ds(i) = 0d0 + dvel_ds(i) = 0._wp end do - dpres_ds = 0d0 + dpres_ds = 0._wp !$acc loop seq do i = 1, advxe - E_idx - dadv_ds(i) = 0d0 + dadv_ds(i) = 0._wp end do !$acc loop seq @@ -896,12 +896,12 @@ contains !$acc loop seq do i = 1, num_dims dvel_dt(dir_idx(i)) = dir_flg(dir_idx(i))* & - (L(1) - L(advxe))/(2d0*rho*c) + & - (dir_flg(dir_idx(i)) - 1d0)* & + (L(1) - L(advxe))/(2._wp*rho*c) + & + (dir_flg(dir_idx(i)) - 1._wp)* & L(momxb + i - 1) end do - vel_dv_dt_sum = 0d0 + vel_dv_dt_sum = 0._wp !$acc loop seq do i = 1, num_dims vel_dv_dt_sum = vel_dv_dt_sum + vel(i)*dvel_dt(i) @@ -920,7 +920,7 @@ contains end do end if - drho_dt = 0d0; dgamma_dt = 0d0; dpi_inf_dt = 0d0; dqv_dt = 0d0 + drho_dt = 0._wp; dgamma_dt = 0._wp; dpi_inf_dt = 0._wp; dqv_dt = 0._wp if (model_eqns == 1) then drho_dt = dalpha_rho_dt(1) @@ -962,14 +962,14 @@ contains if (riemann_solver == 1) then !$acc loop seq do i = advxb, advxe - flux_rs${XYZ}$_vf(-1, k, r, i) = 0d0 + flux_rs${XYZ}$_vf(-1, k, r, i) = 0._wp end do !$acc loop seq do i = advxb, advxe flux_src_rs${XYZ}$_vf(-1, k, r, i) = & - 1d0/max(abs(vel(dir_idx(1))), sgm_eps) & - *sign(1d0, vel(dir_idx(1))) & + 1._wp/max(abs(vel(dir_idx(1))), sgm_eps) & + *sign(1._wp, vel(dir_idx(1))) & *(flux_rs${XYZ}$_vf(0, k, r, i) & + vel(dir_idx(1)) & *flux_src_rs${XYZ}$_vf(0, k, r, i) & @@ -1039,13 +1039,13 @@ contains if (cbc_dir == 1) then is1%beg = 0; is1%end = buff_size; is2 = iy; is3 = iz - dir_idx = (/1, 2, 3/); dir_flg = (/1d0, 0d0, 0d0/) + dir_idx = (/1, 2, 3/); dir_flg = (/1._wp, 0._wp, 0._wp/) elseif (cbc_dir == 2) then is1%beg = 0; is1%end = buff_size; is2 = ix; is3 = iz - dir_idx = (/2, 1, 3/); dir_flg = (/0d0, 1d0, 0d0/) + dir_idx = (/2, 1, 3/); dir_flg = (/0._wp, 1._wp, 0._wp/) else is1%beg = 0; is1%end = buff_size; is2 = iy; is3 = ix - dir_idx = (/3, 1, 2/); dir_flg = (/0d0, 0d0, 1d0/) + dir_idx = (/3, 1, 2/); dir_flg = (/0._wp, 0._wp, 1._wp/) end if dj = max(0, cbc_loc) @@ -1073,7 +1073,7 @@ contains do j = 0, buff_size q_prim_rsx_vf(j, k, r, momxb) = & q_prim_vf(momxb)%sf(dj*(m - 2*j) + j, k, r)* & - sign(1d0, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, wp)) end do end do end do @@ -1085,7 +1085,7 @@ contains do j = -1, buff_size flux_rsx_vf(j, k, r, i) = & flux_vf(i)%sf(dj*((m - 1) - 2*j) + j, k, r)* & - sign(1d0, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, wp)) end do end do end do @@ -1120,7 +1120,7 @@ contains do j = -1, buff_size flux_src_rsx_vf(j, k, r, advxb) = & flux_src_vf(advxb)%sf(dj*((m - 1) - 2*j) + j, k, r)* & - sign(1d0, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, wp)) end do end do end do @@ -1149,7 +1149,7 @@ contains do j = 0, buff_size q_prim_rsy_vf(j, k, r, momxb + 1) = & q_prim_vf(momxb + 1)%sf(k, dj*(n - 2*j) + j, r)* & - sign(1d0, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, wp)) end do end do end do @@ -1161,7 +1161,7 @@ contains do j = -1, buff_size flux_rsy_vf(j, k, r, i) = & flux_vf(i)%sf(k, dj*((n - 1) - 2*j) + j, r)* & - sign(1d0, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, wp)) end do end do end do @@ -1196,7 +1196,7 @@ contains do j = -1, buff_size flux_src_rsy_vf(j, k, r, advxb) = & flux_src_vf(advxb)%sf(k, dj*((n - 1) - 2*j) + j, r)* & - sign(1d0, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, wp)) end do end do end do @@ -1225,7 +1225,7 @@ contains do j = 0, buff_size q_prim_rsz_vf(j, k, r, momxe) = & q_prim_vf(momxe)%sf(r, k, dj*(p - 2*j) + j)* & - sign(1d0, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, wp)) end do end do end do @@ -1237,7 +1237,7 @@ contains do j = -1, buff_size flux_rsz_vf(j, k, r, i) = & flux_vf(i)%sf(r, k, dj*((p - 1) - 2*j) + j)* & - sign(1d0, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, wp)) end do end do end do @@ -1272,7 +1272,7 @@ contains do j = -1, buff_size flux_src_rsz_vf(j, k, r, advxb) = & flux_src_vf(advxb)%sf(r, k, dj*((p - 1) - 2*j) + j)* & - sign(1d0, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, wp)) end do end do end do @@ -1322,7 +1322,7 @@ contains do j = -1, buff_size flux_vf(i)%sf(dj*((m - 1) - 2*j) + j, k, r) = & flux_rsx_vf(j, k, r, i)* & - sign(1d0, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, wp)) end do end do end do @@ -1356,7 +1356,7 @@ contains do j = -1, buff_size flux_src_vf(advxb)%sf(dj*((m - 1) - 2*j) + j, k, r) = & flux_src_rsx_vf(j, k, r, advxb)* & - sign(1d0, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, wp)) end do end do end do @@ -1373,7 +1373,7 @@ contains do j = -1, buff_size flux_vf(i)%sf(k, dj*((n - 1) - 2*j) + j, r) = & flux_rsy_vf(j, k, r, i)* & - sign(1d0, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, wp)) end do end do end do @@ -1408,7 +1408,7 @@ contains do j = -1, buff_size flux_src_vf(advxb)%sf(k, dj*((n - 1) - 2*j) + j, r) = & flux_src_rsy_vf(j, k, r, advxb)* & - sign(1d0, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, wp)) end do end do end do @@ -1426,7 +1426,7 @@ contains do j = -1, buff_size flux_vf(i)%sf(r, k, dj*((p - 1) - 2*j) + j) = & flux_rsz_vf(j, k, r, i)* & - sign(1d0, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, wp)) end do end do end do @@ -1461,7 +1461,7 @@ contains do j = -1, buff_size flux_src_vf(advxb)%sf(r, k, dj*((p - 1) - 2*j) + j) = & flux_src_rsz_vf(j, k, r, advxb)* & - sign(1d0, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, wp)) end do end do end do diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index 0a65ecd4e8..115f477b7d 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -65,9 +65,9 @@ contains "For 3D simulation, p must be greater than or equal to (num_stcls_min*weno_order - 1), whose value is "//trim(numStr)) @:PROHIBIT(weno_order /= 1 .and. f_is_default(weno_eps), & "weno_order != 1, but weno_eps is not set. A typical value of weno_eps is 1e-6") - @:PROHIBIT(weno_eps <= 0d0, "weno_eps must be positive. A typical value of weno_eps is 1e-6") + @:PROHIBIT(weno_eps <= 0._wp, "weno_eps must be positive. A typical value of weno_eps is 1e-6") @:PROHIBIT(teno .and. f_is_default(teno_CT), "teno is used, but teno_CT is not set. A typical value of teno_CT is 1e-6") - @:PROHIBIT(teno .and. teno_CT <= 0d0, "teno_CT must be positive. A typical value of teno_CT is 1e-6") + @:PROHIBIT(teno .and. teno_CT <= 0._wp, "teno_CT must be positive. A typical value of teno_CT is 1e-6") @:PROHIBIT(count([mapped_weno, wenoz, teno]) >= 2, "Only one of mapped_weno, wenoz, or teno can be set to true") @:PROHIBIT(weno_order == 1 .and. mapped_weno) @:PROHIBIT(weno_order == 1 .and. wenoz) @@ -180,7 +180,7 @@ contains "acoustic("//trim(jStr)//")%dipole is not supported for support >= 5 (non-planar supports)") @:PROHIBIT(acoustic(j)%support < 5 .and. f_is_default(acoustic(j)%dir), & "acoustic("//trim(jStr)//")%dir must be specified for support < 5 (planer support)") - @:PROHIBIT(acoustic(j)%support == 1 .and. f_approx_equal(acoustic(j)%dir, 0d0), & + @:PROHIBIT(acoustic(j)%support == 1 .and. f_approx_equal(acoustic(j)%dir, 0._wp), & "acoustic("//trim(jStr)//")dir must be non-zero for support = 1") @:PROHIBIT(acoustic(j)%pulse == 2 .and. f_is_default(acoustic(j)%delay), & "acoustic("//trim(jStr)//")%delay must be specified for pulse = 2 (Gaussian)") @@ -189,20 +189,20 @@ contains @:PROHIBIT((acoustic(j)%support == 2 .or. acoustic(j)%support == 3) .and. f_is_default(acoustic(j)%length), & "acoustic("//trim(jStr)//")%length must be specified for support = 2 or 3") - @:PROHIBIT((acoustic(j)%support == 2 .or. acoustic(j)%support == 3) .and. acoustic(j)%length <= 0d0, & + @:PROHIBIT((acoustic(j)%support == 2 .or. acoustic(j)%support == 3) .and. acoustic(j)%length <= 0._wp, & "acoustic("//trim(jStr)//")%length must be positive for support = 2 or 3") @:PROHIBIT(acoustic(j)%support == 3 .and. f_is_default(acoustic(j)%height), & "acoustic("//trim(jStr)//")%height must be specified for support = 3") - @:PROHIBIT(acoustic(j)%support == 3 .and. acoustic(j)%height <= 0d0, & + @:PROHIBIT(acoustic(j)%support == 3 .and. acoustic(j)%height <= 0._wp, & "acoustic("//trim(jStr)//")%height must be positive for support = 3") @:PROHIBIT(acoustic(j)%support >= 5 .and. f_is_default(acoustic(j)%foc_length), & "acoustic("//trim(jStr)//")%foc_length must be specified for support >= 5 (non-planar supports)") - @:PROHIBIT(acoustic(j)%support >= 5 .and. acoustic(j)%foc_length <= 0d0, & + @:PROHIBIT(acoustic(j)%support >= 5 .and. acoustic(j)%foc_length <= 0._wp, & "acoustic("//trim(jStr)//")%foc_length must be positive for support >= 5 (non-planar supports)") @:PROHIBIT(acoustic(j)%support >= 5 .and. f_is_default(acoustic(j)%aperture), & "acoustic("//trim(jStr)//")%aperture must be specified for support >= 5 (non-planar supports)") - @:PROHIBIT(acoustic(j)%support >= 5 .and. acoustic(j)%aperture <= 0d0, & + @:PROHIBIT(acoustic(j)%support >= 5 .and. acoustic(j)%aperture <= 0._wp, & "acoustic("//trim(jStr)//")%aperture must be positive for support >= 5 (non-planar supports)") @:PROHIBIT(any(acoustic(j)%support == (/9, 10, 11/)) .and. acoustic(j)%num_elements == dflt_int, & @@ -215,11 +215,11 @@ contains "acoustic("//trim(jStr)//")%element_on must be less than or equal to num_elements for support = 9, 10, or 11 (transducer array)") @:PROHIBIT(any(acoustic(j)%support == (/9, 10/)) .and. f_is_default(acoustic(j)%element_spacing_angle), & "acoustic("//trim(jStr)//")%element_spacing_angle must be specified for support = 9 or 10 (2D transducer array)") - @:PROHIBIT(any(acoustic(j)%support == (/9, 10/)) .and. acoustic(j)%element_spacing_angle < 0d0, & + @:PROHIBIT(any(acoustic(j)%support == (/9, 10/)) .and. acoustic(j)%element_spacing_angle < 0._wp, & "acoustic("//trim(jStr)//")%element_spacing_angle must be non-negative for support = 9 or 10 (2D transducer array)") @:PROHIBIT(acoustic(j)%support == 11 .and. f_is_default(acoustic(j)%element_polygon_ratio), & "acoustic("//trim(jStr)//")%element_polygon_ratio must be specified for support = 11 (3D transducer array)") - @:PROHIBIT(acoustic(j)%support == 11 .and. acoustic(j)%element_polygon_ratio <= 0d0, & + @:PROHIBIT(acoustic(j)%support == 11 .and. acoustic(j)%element_polygon_ratio <= 0._wp, & "acoustic("//trim(jStr)//")%element_polygon_ratio must be positive for support = 11 (3D transducer array)") end do @@ -262,7 +262,7 @@ contains do i = 1, num_fluids do j = 1, 2 call s_int_to_str(j, jStr) - @:PROHIBIT((.not. f_is_default(fluid_pp(i)%Re(j))) .and. fluid_pp(i)%Re(j) <= 0d0, & + @:PROHIBIT((.not. f_is_default(fluid_pp(i)%Re(j))) .and. fluid_pp(i)%Re(j) <= 0._wp, & "fluid_pp("//trim(iStr)//")%"// "Re("//trim(jStr)//") must be positive.") @:PROHIBIT(model_eqns == 1 .and. (.not. f_is_default(fluid_pp(i)%Re(j))), & "model_eqns = 1 does not support fluid_pp("//trim(iStr)//")%"// "Re("//trim(jStr)//")") diff --git a/src/simulation/m_chemistry.fpp b/src/simulation/m_chemistry.fpp index 45982b1b29..1be11e2016 100644 --- a/src/simulation/m_chemistry.fpp +++ b/src/simulation/m_chemistry.fpp @@ -43,7 +43,7 @@ contains !$acc kernels do i = 1, num_dims - grads(i)%sf(:, :, :) = 0.0d0 + grads(i)%sf(:, :, :) = 0.0_wp end do !$acc end kernels @@ -105,8 +105,8 @@ contains real(wp) :: E real(wp) :: rho - real(kind(1.d0)), dimension(num_species) :: Ys - real(kind(1.d0)), dimension(num_species) :: omega + real(kind(1._wp)), dimension(num_species) :: Ys + real(kind(1._wp)), dimension(num_species) :: omega real(wp), dimension(num_species) :: enthalpies real(wp) :: cp_mix @@ -118,7 +118,7 @@ contains do z = 0, p ! Maybe use q_prim_vf instead? - rho = 0d0 + rho = 0._wp do eqn = chemxb, chemxe rho = rho + q_cons_qp(eqn)%sf(x, y, z) end do @@ -127,11 +127,11 @@ contains Ys(eqn - chemxb + 1) = q_cons_qp(eqn)%sf(x, y, z)/rho end do - dyn_pres = 0d0 + dyn_pres = 0._wp do i = momxb, momxe dyn_pres = dyn_pres + rho*q_cons_qp(i)%sf(x, y, z)* & - q_cons_qp(i)%sf(x, y, z)/2d0 + q_cons_qp(i)%sf(x, y, z)/2._wp end do call get_temperature(.true., q_cons_qp(E_idx)%sf(x, y, z) - dyn_pres, & @@ -176,7 +176,7 @@ contains do z = iz%beg, iz%end do eqn = chemxb, chemxe - q_cons_qp(eqn)%sf(x, y, z) = max(0d0, q_cons_qp(eqn)%sf(x, y, z)) + q_cons_qp(eqn)%sf(x, y, z) = max(0._wp, q_cons_qp(eqn)%sf(x, y, z)) end do end do diff --git a/src/simulation/m_compute_cbc.fpp b/src/simulation/m_compute_cbc.fpp index 738b02d075..e061e4e07f 100644 --- a/src/simulation/m_compute_cbc.fpp +++ b/src/simulation/m_compute_cbc.fpp @@ -46,7 +46,7 @@ contains L(1) = lambda(1)*(dpres_ds - rho*c*dvel_ds(dir_idx(1))) do i = 2, advxe - L(i) = 0d0 + L(i) = 0._wp end do L(advxe) = L(1) @@ -73,25 +73,25 @@ contains integer :: i !< Generic loop iterator - L(1) = (5d-1 - 5d-1*sign(1d0, lambda(1)))*lambda(1) & + L(1) = (5d-1 - 5d-1*sign(1._wp, lambda(1)))*lambda(1) & *(dpres_ds - rho*c*dvel_ds(dir_idx(1))) do i = 2, momxb - L(i) = (5d-1 - 5d-1*sign(1d0, lambda(2)))*lambda(2) & + L(i) = (5d-1 - 5d-1*sign(1._wp, lambda(2)))*lambda(2) & *(c*c*dalpha_rho_ds(i - 1) - mf(i - 1)*dpres_ds) end do do i = momxb + 1, momxe - L(i) = (5d-1 - 5d-1*sign(1d0, lambda(2)))*lambda(2) & + L(i) = (5d-1 - 5d-1*sign(1._wp, lambda(2)))*lambda(2) & *(dvel_ds(dir_idx(i - contxe))) end do do i = E_idx, advxe - 1 - L(i) = (5d-1 - 5d-1*sign(1d0, lambda(2)))*lambda(2) & + L(i) = (5d-1 - 5d-1*sign(1._wp, lambda(2)))*lambda(2) & *(dadv_ds(i - momxe)) end do - L(advxe) = (5d-1 - 5d-1*sign(1d0, lambda(3)))*lambda(3) & + L(advxe) = (5d-1 - 5d-1*sign(1._wp, lambda(3)))*lambda(3) & *(dpres_ds + rho*c*dvel_ds(dir_idx(1))) end subroutine s_compute_nonreflecting_subsonic_buffer_L @@ -118,7 +118,7 @@ contains L(1) = lambda(1)*(dpres_ds - rho*c*dvel_ds(dir_idx(1))) do i = 2, advxe - L(i) = 0d0 + L(i) = 0._wp end do end subroutine s_compute_nonreflecting_subsonic_inflow_L @@ -158,7 +158,7 @@ contains end do ! bubble index - L(advxe) = 0d0 + L(advxe) = 0._wp end subroutine s_compute_nonreflecting_subsonic_outflow_L @@ -199,7 +199,7 @@ contains L(i) = lambda(2)*(dadv_ds(i - momxe)) end do - L(advxe) = L(1) + 2d0*rho*c*lambda(2)*dvel_ds(dir_idx(1)) + L(advxe) = L(1) + 2._wp*rho*c*lambda(2)*dvel_ds(dir_idx(1)) end subroutine s_compute_force_free_subsonic_outflow_L @@ -262,7 +262,7 @@ contains integer :: i do i = 1, advxe - L(i) = 0d0 + L(i) = 0._wp end do end subroutine s_compute_supersonic_inflow_L diff --git a/src/simulation/m_compute_levelset.fpp b/src/simulation/m_compute_levelset.fpp index 49e0caf5e1..38208e3de0 100644 --- a/src/simulation/m_compute_levelset.fpp +++ b/src/simulation/m_compute_levelset.fpp @@ -90,7 +90,7 @@ contains x_centroid = patch_ib(ib_patch_id)%x_centroid y_centroid = patch_ib(ib_patch_id)%y_centroid - theta = pi*patch_ib(ib_patch_id)%theta/180d0 + theta = pi*patch_ib(ib_patch_id)%theta/180._wp do i = 0, m do j = 0, n @@ -175,7 +175,7 @@ contains y_centroid = patch_ib(ib_patch_id)%y_centroid z_centroid = patch_ib(ib_patch_id)%z_centroid lz = patch_ib(ib_patch_id)%length_z - theta = pi*patch_ib(ib_patch_id)%theta/180d0 + theta = pi*patch_ib(ib_patch_id)%theta/180._wp z_max = z_centroid + lz/2 z_min = z_centroid - lz/2 @@ -305,7 +305,7 @@ contains if (min_dist == abs(side_dists(1))) then levelset(i, j, 0, ib_patch_id) = side_dists(1) if (side_dists(1) == 0) then - levelset_norm(i, j, 0, ib_patch_id, 1) = 0d0 + levelset_norm(i, j, 0, ib_patch_id, 1) = 0._wp else levelset_norm(i, j, 0, ib_patch_id, 1) = side_dists(1)/ & abs(side_dists(1)) @@ -314,7 +314,7 @@ contains else if (min_dist == abs(side_dists(2))) then levelset(i, j, 0, ib_patch_id) = side_dists(2) if (side_dists(2) == 0) then - levelset_norm(i, j, 0, ib_patch_id, 1) = 0d0 + levelset_norm(i, j, 0, ib_patch_id, 1) = 0._wp else levelset_norm(i, j, 0, ib_patch_id, 1) = side_dists(2)/ & abs(side_dists(2)) @@ -322,7 +322,7 @@ contains else if (min_dist == abs(side_dists(3))) then if (side_dists(3) == 0) then - levelset_norm(i, j, 0, ib_patch_id, 1) = 0d0 + levelset_norm(i, j, 0, ib_patch_id, 1) = 0._wp else levelset_norm(i, j, 0, ib_patch_id, 1) = side_dists(3)/ & abs(side_dists(3)) @@ -330,7 +330,7 @@ contains else if (min_dist == abs(side_dists(4))) then if (side_dists(4) == 0) then - levelset_norm(i, j, 0, ib_patch_id, 1) = 0d0 + levelset_norm(i, j, 0, ib_patch_id, 1) = 0._wp else levelset_norm(i, j, 0, ib_patch_id, 1) = side_dists(4)/ & abs(side_dists(4)) @@ -404,17 +404,17 @@ contains length_y = patch_ib(ib_patch_id)%length_y length_z = patch_ib(ib_patch_id)%length_z - if (length_x /= 0d0) then + if (length_x /= 0._wp) then boundary%beg = x_centroid - 0.5*length_x boundary%end = x_centroid + 0.5*length_x dist_sides_vec = (/1, 0, 0/) dist_surface_vec = (/0, 1, 1/) - else if (length_y /= 0d0) then + else if (length_y /= 0._wp) then boundary%beg = y_centroid - 0.5*length_y boundary%end = y_centroid + 0.5*length_y dist_sides_vec = (/0, 1, 0/) dist_surface_vec = (/1, 0, 1/) - else if (length_z /= 0d0) then + else if (length_z /= 0._wp) then boundary%beg = z_centroid - 0.5*length_z boundary%end = z_centroid + 0.5*length_z dist_sides_vec = (/0, 0, 1/) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index d232367152..5bdd29cad2 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -343,19 +343,19 @@ contains if (icfl_max_glb /= icfl_max_glb) then call s_mpi_abort('ICFL is NaN. Exiting ...') - elseif (icfl_max_glb > 1d0) then + elseif (icfl_max_glb > 1._wp) then print *, 'icfl', icfl_max_glb call s_mpi_abort('ICFL is greater than 1.0. Exiting ...') end if do i = chemxb, chemxe - !@:ASSERT(all(q_prim_vf(i)%sf(:,:,:) >= -1d0), "bad conc") - !@:ASSERT(all(q_prim_vf(i)%sf(:,:,:) <= 2d0), "bad conc") + !@:ASSERT(all(q_prim_vf(i)%sf(:,:,:) >= -1._wp), "bad conc") + !@:ASSERT(all(q_prim_vf(i)%sf(:,:,:) <= 2._wp), "bad conc") end do if (vcfl_max_glb /= vcfl_max_glb) then call s_mpi_abort('VCFL is NaN. Exiting ...') - elseif (vcfl_max_glb > 1d0) then + elseif (vcfl_max_glb > 1._wp) then print *, 'vcfl', vcfl_max_glb call s_mpi_abort('VCFL is greater than 1.0. Exiting ...') end if @@ -491,7 +491,7 @@ contains end if gamma = fluid_pp(1)%gamma - lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 + lit_gamma = 1._wp/fluid_pp(1)%gamma + 1._wp pi_inf = fluid_pp(1)%pi_inf qv = fluid_pp(1)%qv @@ -514,9 +514,9 @@ contains do i = 1, sys_size !$acc update host(q_prim_vf(i)%sf(:,:,:)) end do - ! q_prim_vf(bubxb) stores the value of nb needed in riemann solvers, so replace with true primitive value (=1d0) + ! q_prim_vf(bubxb) stores the value of nb needed in riemann solvers, so replace with true primitive value (=1._wp) if (qbmm) then - q_prim_vf(bubxb)%sf = 1d0 + q_prim_vf(bubxb)%sf = 1._wp end if end if @@ -809,8 +809,8 @@ contains m_MOK = int(m_glb + 1, MPI_OFFSET_KIND) n_MOK = int(n_glb + 1, MPI_OFFSET_KIND) p_MOK = int(p_glb + 1, MPI_OFFSET_KIND) - WP_MOK = int(8d0, MPI_OFFSET_KIND) - MOK = int(1d0, MPI_OFFSET_KIND) + WP_MOK = int(8._wp, MPI_OFFSET_KIND) + MOK = int(1._wp, MPI_OFFSET_KIND) str_MOK = int(name_len, MPI_OFFSET_KIND) NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) @@ -866,8 +866,8 @@ contains m_MOK = int(m_glb + 1, MPI_OFFSET_KIND) n_MOK = int(n_glb + 1, MPI_OFFSET_KIND) p_MOK = int(p_glb + 1, MPI_OFFSET_KIND) - WP_MOK = int(8d0, MPI_OFFSET_KIND) - MOK = int(1d0, MPI_OFFSET_KIND) + WP_MOK = int(8._wp, MPI_OFFSET_KIND) + MOK = int(1._wp, MPI_OFFSET_KIND) str_MOK = int(name_len, MPI_OFFSET_KIND) NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) @@ -985,35 +985,35 @@ contains if (t_step_old /= dflt_int) then nondim_time = real(t_step + t_step_old, wp)*dt else - nondim_time = real(t_step, wp)*dt !*1.d-5/10.0761131451d0 + nondim_time = real(t_step, wp)*dt !*1.d-5/10.0761131451_wp end if end if do i = 1, num_probes ! Zeroing out flow variables for all processors - rho = 0d0 + rho = 0._wp do s = 1, num_dims - vel(s) = 0d0 + vel(s) = 0._wp end do - pres = 0d0 - gamma = 0d0 - pi_inf = 0d0 - qv = 0d0 - c = 0d0 - accel = 0d0 - nR = 0d0; R = 0d0 - nRdot = 0d0; Rdot = 0d0 - nbub = 0d0 - M00 = 0d0 - M10 = 0d0 - M01 = 0d0 - M20 = 0d0 - M11 = 0d0 - M02 = 0d0 - varR = 0d0; varV = 0d0 - alf = 0d0 + pres = 0._wp + gamma = 0._wp + pi_inf = 0._wp + qv = 0._wp + c = 0._wp + accel = 0._wp + nR = 0._wp; R = 0._wp + nRdot = 0._wp; Rdot = 0._wp + nbub = 0._wp + M00 = 0._wp + M10 = 0._wp + M01 = 0._wp + M20 = 0._wp + M11 = 0._wp + M02 = 0._wp + varR = 0._wp; varV = 0._wp + alf = 0._wp do s = 1, (num_dims*(num_dims + 1))/2 - tau_e(s) = 0d0 + tau_e(s) = 0._wp end do ! Find probe location in terms of indices on a @@ -1022,7 +1022,7 @@ contains if ((probe(i)%x >= x_cb(-1)) .and. (probe(i)%x <= x_cb(m))) then do s = -1, m distx(s) = x_cb(s) - probe(i)%x - if (distx(s) < 0d0) distx(s) = 1000d0 + if (distx(s) < 0._wp) distx(s) = 1000._wp end do j = minloc(distx, 1) if (j == 1) j = 2 ! Pick first point if probe is at edge @@ -1048,7 +1048,7 @@ contains vel(s) = q_cons_vf(cont_idx%end + s)%sf(j - 2, k, l)/rho end do - dyn_p = 0.5d0*rho*dot_product(vel, vel) + dyn_p = 0.5_wp*rho*dot_product(vel, vel) if (hypoelasticity) then call s_compute_pressure( & @@ -1065,7 +1065,7 @@ contains end if if (model_eqns == 4) then - lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 + lit_gamma = 1._wp/fluid_pp(1)%gamma + 1._wp else if (hypoelasticity) then tau_e(1) = q_cons_vf(stress_idx%end)%sf(j - 2, k, l)/rho end if @@ -1083,12 +1083,12 @@ contains if (adv_n) then nbub = q_cons_vf(n_idx)%sf(j - 2, k, l) else - nR3 = 0d0 + nR3 = 0._wp do s = 1, nb - nR3 = nR3 + weight(s)*(nR(s)**3d0) + nR3 = nR3 + weight(s)*(nR(s)**3._wp) end do - nbub = dsqrt((4.d0*pi/3.d0)*nR3/alf) + nbub = dsqrt((4._wp*pi/3._wp)*nR3/alf) end if #ifdef DEBUG print *, 'In probe, nbub: ', nbub @@ -1107,8 +1107,8 @@ contains M11 = M11/M00 M02 = M02/M00 - varR = M20 - M10**2d0 - varV = M02 - M01**2d0 + varR = M20 - M10**2._wp + varV = M02 - M01**2._wp end if R(:) = nR(:)/nbub Rdot(:) = nRdot(:)/nbub @@ -1119,7 +1119,7 @@ contains ! Compute mixture sound Speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & - ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) + ((gamma + 1._wp)*pres + pi_inf)/rho, alpha, 0._wp, c) accel = accel_mag(j - 2, k, l) end if @@ -1134,11 +1134,11 @@ contains if ((probe(i)%y >= y_cb(-1)) .and. (probe(i)%y <= y_cb(n))) then do s = -1, m distx(s) = x_cb(s) - probe(i)%x - if (distx(s) < 0d0) distx(s) = 1000d0 + if (distx(s) < 0._wp) distx(s) = 1000._wp end do do s = -1, n disty(s) = y_cb(s) - probe(i)%y - if (disty(s) < 0d0) disty(s) = 1000d0 + if (disty(s) < 0._wp) disty(s) = 1000._wp end do j = minloc(distx, 1) k = minloc(disty, 1) @@ -1154,7 +1154,7 @@ contains vel(s) = q_cons_vf(cont_idx%end + s)%sf(j - 2, k - 2, l)/rho end do - dyn_p = 0.5d0*rho*dot_product(vel, vel) + dyn_p = 0.5_wp*rho*dot_product(vel, vel) if (hypoelasticity) then call s_compute_pressure( & @@ -1173,7 +1173,7 @@ contains end if if (model_eqns == 4) then - lit_gamma = 1d0/fluid_pp(1)%gamma + 1d0 + lit_gamma = 1._wp/fluid_pp(1)%gamma + 1._wp else if (hypoelasticity) then do s = 1, 3 tau_e(s) = q_cons_vf(s)%sf(j - 2, k - 2, l)/rho @@ -1190,12 +1190,12 @@ contains if (adv_n) then nbub = q_cons_vf(n_idx)%sf(j - 2, k - 2, l) else - nR3 = 0d0 + nR3 = 0._wp do s = 1, nb - nR3 = nR3 + weight(s)*(nR(s)**3d0) + nR3 = nR3 + weight(s)*(nR(s)**3._wp) end do - nbub = dsqrt((4.d0*pi/3.d0)*nR3/alf) + nbub = dsqrt((4._wp*pi/3._wp)*nR3/alf) end if R(:) = nR(:)/nbub @@ -1204,7 +1204,7 @@ contains ! Compute mixture sound speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & - ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) + ((gamma + 1._wp)*pres + pi_inf)/rho, alpha, 0._wp, c) accel = accel_mag(j - 2, k - 2, l) end if @@ -1215,15 +1215,15 @@ contains if ((probe(i)%z >= z_cb(-1)) .and. (probe(i)%z <= z_cb(p))) then do s = -1, m distx(s) = x_cb(s) - probe(i)%x - if (distx(s) < 0d0) distx(s) = 1000d0 + if (distx(s) < 0._wp) distx(s) = 1000._wp end do do s = -1, n disty(s) = y_cb(s) - probe(i)%y - if (disty(s) < 0d0) disty(s) = 1000d0 + if (disty(s) < 0._wp) disty(s) = 1000._wp end do do s = -1, p distz(s) = z_cb(s) - probe(i)%z - if (distz(s) < 0d0) distz(s) = 1000d0 + if (distz(s) < 0._wp) distz(s) = 1000._wp end do j = minloc(distx, 1) k = minloc(disty, 1) @@ -1240,7 +1240,7 @@ contains vel(s) = q_cons_vf(cont_idx%end + s)%sf(j - 2, k - 2, l - 2)/rho end do - dyn_p = 0.5d0*rho*dot_product(vel, vel) + dyn_p = 0.5_wp*rho*dot_product(vel, vel) if (chemistry) then do d = 1, num_species @@ -1265,7 +1265,7 @@ contains ! Compute mixture sound speed call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, & - ((gamma + 1d0)*pres + pi_inf)/rho, alpha, 0d0, c) + ((gamma + 1._wp)*pres + pi_inf)/rho, alpha, 0._wp, c) accel = accel_mag(j - 2, k - 2, l - 2) end if @@ -1432,20 +1432,20 @@ contains if (integral_wrt .and. bubbles) then if (n == 0) then ! 1D simulation do i = 1, num_integrals - int_pres = 0d0 - max_pres = 0d0 + int_pres = 0._wp + max_pres = 0._wp k = 0; l = 0 npts = 0 do j = 1, m - pres = 0d0 + pres = 0._wp do s = 1, num_dims - vel(s) = 0d0 + vel(s) = 0._wp end do - rho = 0d0 - pres = 0d0 - gamma = 0d0 - pi_inf = 0d0 - qv = 0d0 + rho = 0._wp + pres = 0._wp + gamma = 0._wp + pi_inf = 0._wp + qv = 0._wp if ((integral(i)%xmin <= x_cb(j)) .and. (integral(i)%xmax >= x_cb(j))) then npts = npts + 1 @@ -1457,14 +1457,14 @@ contains pres = ( & (q_cons_vf(E_idx)%sf(j, k, l) - & - 0.5d0*(q_cons_vf(mom_idx%beg)%sf(j, k, l)**2.d0)/rho)/ & - (1.d0 - q_cons_vf(alf_idx)%sf(j, k, l)) - & + 0.5_wp*(q_cons_vf(mom_idx%beg)%sf(j, k, l)**2._wp)/rho)/ & + (1._wp - q_cons_vf(alf_idx)%sf(j, k, l)) - & pi_inf - qv & )/gamma - int_pres = int_pres + (pres - 1.d0)**2.d0 + int_pres = int_pres + (pres - 1._wp)**2._wp end if end do - int_pres = dsqrt(int_pres/(1.d0*npts)) + int_pres = dsqrt(int_pres/(1._wp*npts)) if (num_procs > 1) then tmp = int_pres @@ -1487,8 +1487,8 @@ contains thickness = integral(1)%xmin do i = 1, num_integrals - int_pres = 0d0 - max_pres = 0d0 + int_pres = 0._wp + max_pres = 0._wp l = 0 npts = 0 do j = 1, m @@ -1496,28 +1496,28 @@ contains trigger = .false. if (i == 1) then !inner portion - if (dsqrt(x_cb(j)**2.d0 + y_cb(k)**2.d0) < (rad - 0.5d0*thickness)) & + if (dsqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) < (rad - 0.5_wp*thickness)) & trigger = .true. elseif (i == 2) then !net region - if (dsqrt(x_cb(j)**2.d0 + y_cb(k)**2.d0) > (rad - 0.5d0*thickness) .and. & - dsqrt(x_cb(j)**2.d0 + y_cb(k)**2.d0) < (rad + 0.5d0*thickness)) & + if (dsqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad - 0.5_wp*thickness) .and. & + dsqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) < (rad + 0.5_wp*thickness)) & trigger = .true. elseif (i == 3) then !everything else - if (dsqrt(x_cb(j)**2.d0 + y_cb(k)**2.d0) > (rad + 0.5d0*thickness)) & + if (dsqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad + 0.5_wp*thickness)) & trigger = .true. end if - pres = 0d0 + pres = 0._wp do s = 1, num_dims - vel(s) = 0d0 + vel(s) = 0._wp end do - rho = 0d0 - pres = 0d0 - gamma = 0d0 - pi_inf = 0d0 - qv = 0d0 + rho = 0._wp + pres = 0._wp + gamma = 0._wp + pi_inf = 0._wp + qv = 0._wp if (trigger) then npts = npts + 1 @@ -1529,21 +1529,21 @@ contains pres = ( & (q_cons_vf(E_idx)%sf(j, k, l) - & - 0.5d0*(q_cons_vf(mom_idx%beg)%sf(j, k, l)**2.d0)/rho)/ & - (1.d0 - q_cons_vf(alf_idx)%sf(j, k, l)) - & + 0.5_wp*(q_cons_vf(mom_idx%beg)%sf(j, k, l)**2._wp)/rho)/ & + (1._wp - q_cons_vf(alf_idx)%sf(j, k, l)) - & pi_inf - qv & )/gamma - int_pres = int_pres + abs(pres - 1.d0) - max_pres = max(max_pres, abs(pres - 1.d0)) + int_pres = int_pres + abs(pres - 1._wp) + max_pres = max(max_pres, abs(pres - 1._wp)) end if end do end do if (npts > 0) then - int_pres = int_pres/(1.d0*npts) + int_pres = int_pres/(1._wp*npts) else - int_pres = 0.d0 + int_pres = 0._wp end if if (num_procs > 1) then @@ -1615,13 +1615,13 @@ contains ! Allocating/initializing ICFL, VCFL, CCFL and Rc stability criteria @:ALLOCATE_GLOBAL(icfl_sf(0:m, 0:n, 0:p)) - icfl_max = 0d0 + icfl_max = 0._wp if (any(Re_size > 0)) then @:ALLOCATE_GLOBAL(vcfl_sf(0:m, 0:n, 0:p)) @:ALLOCATE_GLOBAL(Rc_sf (0:m, 0:n, 0:p)) - vcfl_max = 0d0 + vcfl_max = 0._wp Rc_min = 1d3 end if diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index 6159a51d2e..6e45fe59f0 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -148,12 +148,12 @@ subroutine s_compute_derived_variables(t_step) do j = 0, n do i = 0, m if (p > 0) then - accel_mag(i, j, k) = sqrt(x_accel(i, j, k)**2d0 + & - y_accel(i, j, k)**2d0 + & - z_accel(i, j, k)**2d0) + accel_mag(i, j, k) = sqrt(x_accel(i, j, k)**2._wp + & + y_accel(i, j, k)**2._wp + & + z_accel(i, j, k)**2._wp) elseif (n > 0) then - accel_mag(i, j, k) = sqrt(x_accel(i, j, k)**2d0 + & - y_accel(i, j, k)**2d0) + accel_mag(i, j, k) = sqrt(x_accel(i, j, k)**2._wp + & + y_accel(i, j, k)**2._wp) else accel_mag(i, j, k) = x_accel(i, j, k) end if @@ -198,10 +198,10 @@ subroutine s_derive_acceleration_component(i, q_prim_vf0, q_prim_vf1, & do k = 0, n do j = 0, m - q_sf(j, k, l) = (11d0*q_prim_vf0(mom_idx%beg)%sf(j, k, l) & - - 18d0*q_prim_vf1(mom_idx%beg)%sf(j, k, l) & - + 9d0*q_prim_vf2(mom_idx%beg)%sf(j, k, l) & - - 2d0*q_prim_vf3(mom_idx%beg)%sf(j, k, l))/(6d0*dt) + q_sf(j, k, l) = (11._wp*q_prim_vf0(mom_idx%beg)%sf(j, k, l) & + - 18._wp*q_prim_vf1(mom_idx%beg)%sf(j, k, l) & + + 9._wp*q_prim_vf2(mom_idx%beg)%sf(j, k, l) & + - 2._wp*q_prim_vf3(mom_idx%beg)%sf(j, k, l))/(6._wp*dt) do r = -fd_number, fd_number if (n == 0) then ! 1D simulation @@ -244,10 +244,10 @@ subroutine s_derive_acceleration_component(i, q_prim_vf0, q_prim_vf1, & do k = 0, n do j = 0, m - q_sf(j, k, l) = (11d0*q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l) & - - 18d0*q_prim_vf1(mom_idx%beg + 1)%sf(j, k, l) & - + 9d0*q_prim_vf2(mom_idx%beg + 1)%sf(j, k, l) & - - 2d0*q_prim_vf3(mom_idx%beg + 1)%sf(j, k, l))/(6d0*dt) + q_sf(j, k, l) = (11._wp*q_prim_vf0(mom_idx%beg + 1)%sf(j, k, l) & + - 18._wp*q_prim_vf1(mom_idx%beg + 1)%sf(j, k, l) & + + 9._wp*q_prim_vf2(mom_idx%beg + 1)%sf(j, k, l) & + - 2._wp*q_prim_vf3(mom_idx%beg + 1)%sf(j, k, l))/(6._wp*dt) do r = -fd_number, fd_number if (p == 0) then ! 2D simulation @@ -265,7 +265,7 @@ subroutine s_derive_acceleration_component(i, q_prim_vf0, q_prim_vf1, & q_prim_vf0(mom_idx%beg + 1)%sf(j, r + k, l) & + q_prim_vf0(mom_idx%end)%sf(j, k, l)*fd_coeff_z(r, l)* & q_prim_vf0(mom_idx%beg + 1)%sf(j, k, r + l)/y_cc(k) & - - (q_prim_vf0(mom_idx%end)%sf(j, k, l)**2d0)/y_cc(k) + - (q_prim_vf0(mom_idx%end)%sf(j, k, l)**2._wp)/y_cc(k) else q_sf(j, k, l) = q_sf(j, k, l) & + q_prim_vf0(mom_idx%beg)%sf(j, k, l)*fd_coeff_x(r, j)* & @@ -286,10 +286,10 @@ subroutine s_derive_acceleration_component(i, q_prim_vf0, q_prim_vf1, & do l = 0, p do k = 0, n do j = 0, m - q_sf(j, k, l) = (11d0*q_prim_vf0(mom_idx%end)%sf(j, k, l) & - - 18d0*q_prim_vf1(mom_idx%end)%sf(j, k, l) & - + 9d0*q_prim_vf2(mom_idx%end)%sf(j, k, l) & - - 2d0*q_prim_vf3(mom_idx%end)%sf(j, k, l))/(6d0*dt) + q_sf(j, k, l) = (11._wp*q_prim_vf0(mom_idx%end)%sf(j, k, l) & + - 18._wp*q_prim_vf1(mom_idx%end)%sf(j, k, l) & + + 9._wp*q_prim_vf2(mom_idx%end)%sf(j, k, l) & + - 2._wp*q_prim_vf3(mom_idx%end)%sf(j, k, l))/(6._wp*dt) do r = -fd_number, fd_number if (grid_geometry == 3) then diff --git a/src/simulation/m_fftw.fpp b/src/simulation/m_fftw.fpp index c5013a7e98..0a2bc86c50 100644 --- a/src/simulation/m_fftw.fpp +++ b/src/simulation/m_fftw.fpp @@ -153,7 +153,7 @@ contains do k = 1, sys_size do j = 0, m do l = 1, cmplx_size - data_fltr_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) = (0d0, 0d0) + data_fltr_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) = (0._wp, 0._wp) end do end do end do @@ -217,7 +217,7 @@ contains do k = 1, sys_size do j = 0, m do l = 1, cmplx_size - data_fltr_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) = (0d0, 0d0) + data_fltr_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) = (0._wp, 0._wp) end do end do end do @@ -240,7 +240,7 @@ contains #endif !$acc end host_data - Nfq = min(floor(2d0*real(i, wp)*pi), cmplx_size) + Nfq = min(floor(2._wp*real(i, wp)*pi), cmplx_size) !$acc update device(Nfq) !$acc parallel loop collapse(3) gang vector default(present) @@ -277,7 +277,7 @@ contains Nfq = 3 do j = 0, m do k = 1, sys_size - data_fltr_cmplx(:) = (0d0, 0d0) + data_fltr_cmplx(:) = (0._wp, 0._wp) data_real(1:p + 1) = q_cons_vf(k)%sf(j, 0, 0:p) call fftw_execute_dft_r2c(fwd_plan, data_real, data_cmplx) data_fltr_cmplx(1:Nfq) = data_cmplx(1:Nfq) @@ -289,10 +289,10 @@ contains ! Apply Fourier filter to additional rings do i = 1, fourier_rings - Nfq = min(floor(2d0*real(i, wp)*pi), cmplx_size) + Nfq = min(floor(2._wp*real(i, wp)*pi), cmplx_size) do j = 0, m do k = 1, sys_size - data_fltr_cmplx(:) = (0d0, 0d0) + data_fltr_cmplx(:) = (0._wp, 0._wp) data_real(1:p + 1) = q_cons_vf(k)%sf(j, i, 0:p) call fftw_execute_dft_r2c(fwd_plan, data_real, data_cmplx) data_fltr_cmplx(1:Nfq) = data_cmplx(1:Nfq) diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 41a1ed06dc..56fb8a52e9 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -563,8 +563,8 @@ contains #:for DIM in ['x', 'y', 'z'] #:for DIR in [1, 2, 3] - bc_${DIM}$%vb${DIR}$ = 0d0 - bc_${DIM}$%ve${DIR}$ = 0d0 + bc_${DIM}$%vb${DIR}$ = 0._wp + bc_${DIM}$%ve${DIR}$ = 0._wp #:endfor #:endfor @@ -576,9 +576,9 @@ contains do i = 1, num_fluids_max fluid_pp(i)%gamma = dflt_real fluid_pp(i)%pi_inf = dflt_real - fluid_pp(i)%cv = 0d0 - fluid_pp(i)%qv = 0d0 - fluid_pp(i)%qvp = 0d0 + fluid_pp(i)%cv = 0._wp + fluid_pp(i)%qv = 0._wp + fluid_pp(i)%qvp = 0._wp fluid_pp(i)%Re(:) = dflt_real fluid_pp(i)%mul0 = dflt_real fluid_pp(i)%ss = dflt_real @@ -587,7 +587,7 @@ contains fluid_pp(i)%M_v = dflt_real fluid_pp(i)%mu_v = dflt_real fluid_pp(i)%k_v = dflt_real - fluid_pp(i)%G = 0d0 + fluid_pp(i)%G = 0._wp end do ! Tait EOS @@ -617,7 +617,7 @@ contains adv_n = .false. adap_dt = .false. - pi_fac = 1d0 + pi_fac = 1._wp ! User inputs for qbmm for simulation code qbmm = .false. @@ -792,9 +792,9 @@ contains @:ALLOCATE(bub_idx%ps(nb), bub_idx%ms(nb)) if (num_fluids == 1) then - gam = 1.d0/fluid_pp(num_fluids + 1)%gamma + 1.d0 + gam = 1._wp/fluid_pp(num_fluids + 1)%gamma + 1._wp else - gam = 1.d0/fluid_pp(num_fluids)%gamma + 1.d0 + gam = 1._wp/fluid_pp(num_fluids)%gamma + 1._wp end if if (qbmm) then @@ -826,11 +826,11 @@ contains end if if (nb == 1) then - weight(:) = 1d0 - R0(:) = 1d0 - V0(:) = 1d0 + weight(:) = 1._wp + R0(:) = 1._wp + V0(:) = 1._wp else if (nb > 1) then - V0(:) = 1d0 + V0(:) = 1._wp !R0 and weight initialized in s_simpson else stop 'Invalid value of nb' @@ -839,8 +839,8 @@ contains !Initialize pref,rhoref for polytropic qbmm (done in s_initialize_nonpoly for non-polytropic) if (.not. qbmm) then if (polytropic) then - rhoref = 1.d0 - pref = 1.d0 + rhoref = 1._wp + pref = 1._wp end if end if @@ -853,9 +853,9 @@ contains if ((f_is_default(Web))) then pb0 = pref pb0 = pb0/pref - pref = 1d0 + pref = 1._wp end if - rhoref = 1d0 + rhoref = 1._wp end if end if end if @@ -929,18 +929,18 @@ contains end if end do if (nb == 1) then - weight(:) = 1d0 - R0(:) = 1d0 - V0(:) = 0d0 + weight(:) = 1._wp + R0(:) = 1._wp + V0(:) = 0._wp else if (nb > 1) then - V0(:) = 1d0 + V0(:) = 1._wp else stop 'Invalid value of nb' end if if (polytropic) then - rhoref = 1.d0 - pref = 1.d0 + rhoref = 1._wp + pref = 1._wp end if end if end if @@ -1003,7 +1003,7 @@ contains ! using the arithmetic mean of left and right, WENO-reconstructed, ! cell-boundary values or otherwise, the unaltered left and right, ! WENO-reconstructed, cell-boundary values - wa_flg = 0d0; if (weno_avg) wa_flg = 1d0 + wa_flg = 0._wp; if (weno_avg) wa_flg = 1._wp !$acc update device(wa_flg) ! Resort to default WENO-JS if no other WENO scheme is selected diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index 96548b6934..4b18d26664 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -99,10 +99,10 @@ contains do k = 0, m du_dx(k, l, q) = & (q_prim_vf(momxb)%sf(k - 2, l, q) & - - 8d0*q_prim_vf(momxb)%sf(k - 1, l, q) & - + 8d0*q_prim_vf(momxb)%sf(k + 1, l, q) & + - 8._wp*q_prim_vf(momxb)%sf(k - 1, l, q) & + + 8._wp*q_prim_vf(momxb)%sf(k + 1, l, q) & - q_prim_vf(momxb)%sf(k + 2, l, q)) & - /(12d0*dx(k)) + /(12._wp*dx(k)) end do end do end do @@ -114,22 +114,22 @@ contains do k = 0, m du_dy(k, l, q) = & (q_prim_vf(momxb)%sf(k, l - 2, q) & - - 8d0*q_prim_vf(momxb)%sf(k, l - 1, q) & - + 8d0*q_prim_vf(momxb)%sf(k, l + 1, q) & + - 8._wp*q_prim_vf(momxb)%sf(k, l - 1, q) & + + 8._wp*q_prim_vf(momxb)%sf(k, l + 1, q) & - q_prim_vf(momxb)%sf(k, l + 2, q)) & - /(12d0*dy(l)) + /(12._wp*dy(l)) dv_dx(k, l, q) = & (q_prim_vf(momxb + 1)%sf(k - 2, l, q) & - - 8d0*q_prim_vf(momxb + 1)%sf(k - 1, l, q) & - + 8d0*q_prim_vf(momxb + 1)%sf(k + 1, l, q) & + - 8._wp*q_prim_vf(momxb + 1)%sf(k - 1, l, q) & + + 8._wp*q_prim_vf(momxb + 1)%sf(k + 1, l, q) & - q_prim_vf(momxb + 1)%sf(k + 2, l, q)) & - /(12d0*dx(k)) + /(12._wp*dx(k)) dv_dy(k, l, q) = & (q_prim_vf(momxb + 1)%sf(k, l - 2, q) & - - 8d0*q_prim_vf(momxb + 1)%sf(k, l - 1, q) & - + 8d0*q_prim_vf(momxb + 1)%sf(k, l + 1, q) & + - 8._wp*q_prim_vf(momxb + 1)%sf(k, l - 1, q) & + + 8._wp*q_prim_vf(momxb + 1)%sf(k, l + 1, q) & - q_prim_vf(momxb + 1)%sf(k, l + 2, q)) & - /(12d0*dy(l)) + /(12._wp*dy(l)) end do end do end do @@ -142,34 +142,34 @@ contains do k = 0, m du_dz(k, l, q) = & (q_prim_vf(momxb)%sf(k, l, q - 2) & - - 8d0*q_prim_vf(momxb)%sf(k, l, q - 1) & - + 8d0*q_prim_vf(momxb)%sf(k, l, q + 1) & + - 8._wp*q_prim_vf(momxb)%sf(k, l, q - 1) & + + 8._wp*q_prim_vf(momxb)%sf(k, l, q + 1) & - q_prim_vf(momxb)%sf(k, l, q + 2)) & - /(12d0*dz(q)) + /(12._wp*dz(q)) dv_dz(k, l, q) = & (q_prim_vf(momxb + 1)%sf(k, l, q - 2) & - - 8d0*q_prim_vf(momxb + 1)%sf(k, l, q - 1) & - + 8d0*q_prim_vf(momxb + 1)%sf(k, l, q + 1) & + - 8._wp*q_prim_vf(momxb + 1)%sf(k, l, q - 1) & + + 8._wp*q_prim_vf(momxb + 1)%sf(k, l, q + 1) & - q_prim_vf(momxb + 1)%sf(k, l, q + 2)) & - /(12d0*dz(q)) + /(12._wp*dz(q)) dw_dx(k, l, q) = & (q_prim_vf(momxe)%sf(k - 2, l, q) & - - 8d0*q_prim_vf(momxe)%sf(k - 1, l, q) & - + 8d0*q_prim_vf(momxe)%sf(k + 1, l, q) & + - 8._wp*q_prim_vf(momxe)%sf(k - 1, l, q) & + + 8._wp*q_prim_vf(momxe)%sf(k + 1, l, q) & - q_prim_vf(momxe)%sf(k + 2, l, q)) & - /(12d0*dx(k)) + /(12._wp*dx(k)) dw_dy(k, l, q) = & (q_prim_vf(momxe)%sf(k, l - 2, q) & - - 8d0*q_prim_vf(momxe)%sf(k, l - 1, q) & - + 8d0*q_prim_vf(momxe)%sf(k, l + 1, q) & + - 8._wp*q_prim_vf(momxe)%sf(k, l - 1, q) & + + 8._wp*q_prim_vf(momxe)%sf(k, l + 1, q) & - q_prim_vf(momxe)%sf(k, l + 2, q)) & - /(12d0*dy(l)) + /(12._wp*dy(l)) dw_dz(k, l, q) = & (q_prim_vf(momxe)%sf(k, l, q - 2) & - - 8d0*q_prim_vf(momxe)%sf(k, l, q - 1) & - + 8d0*q_prim_vf(momxe)%sf(k, l, q + 1) & + - 8._wp*q_prim_vf(momxe)%sf(k, l, q - 1) & + + 8._wp*q_prim_vf(momxe)%sf(k, l, q + 1) & - q_prim_vf(momxe)%sf(k, l, q + 2)) & - /(12d0*dz(q)) + /(12._wp*dz(q)) end do end do end do @@ -180,7 +180,7 @@ contains do q = 0, p do l = 0, n do k = 0, m - rho_K = 0d0; G_K = 0d0 + rho_K = 0._wp; G_K = 0._wp do i = 1, num_fluids rho_K = rho_K + q_prim_vf(i)%sf(k, l, q) !alpha_rho_K(1) G_K = G_K + q_prim_vf(advxb - 1 + i)%sf(k, l, q)*Gs(i) !alpha_K(1) * Gs(1) @@ -203,7 +203,7 @@ contains do k = 0, m rhs_vf(strxb)%sf(k, l, q) = & rhs_vf(strxb)%sf(k, l, q) + rho_K_field(k, l, q)* & - ((4d0*G_K_field(k, l, q)/3d0) + & + ((4._wp*G_K_field(k, l, q)/3._wp) + & q_prim_vf(strxb)%sf(k, l, q))* & du_dx(k, l, q) end do @@ -219,7 +219,7 @@ contains (q_prim_vf(strxb + 1)%sf(k, l, q)*du_dy(k, l, q) + & q_prim_vf(strxb + 1)%sf(k, l, q)*du_dy(k, l, q) - & q_prim_vf(strxb)%sf(k, l, q)*dv_dy(k, l, q) - & - 2d0*G_K_field(k, l, q)*(1d0/3d0)*dv_dy(k, l, q)) + 2._wp*G_K_field(k, l, q)*(1._wp/3._wp)*dv_dy(k, l, q)) rhs_vf(strxb + 1)%sf(k, l, q) = rhs_vf(strxb + 1)%sf(k, l, q) + rho_K_field(k, l, q)* & (q_prim_vf(strxb + 1)%sf(k, l, q)*du_dx(k, l, q) + & @@ -228,7 +228,7 @@ contains q_prim_vf(strxb + 2)%sf(k, l, q)*du_dy(k, l, q) + & q_prim_vf(strxb + 1)%sf(k, l, q)*dv_dy(k, l, q) - & q_prim_vf(strxb + 1)%sf(k, l, q)*dv_dy(k, l, q) + & - 2d0*G_K_field(k, l, q)*(1d0/2d0)*(du_dy(k, l, q) + & + 2._wp*G_K_field(k, l, q)*(1._wp/2._wp)*(du_dy(k, l, q) + & dv_dx(k, l, q))) rhs_vf(strxb + 2)%sf(k, l, q) = rhs_vf(strxb + 2)%sf(k, l, q) + rho_K_field(k, l, q)* & @@ -238,7 +238,7 @@ contains q_prim_vf(strxb + 2)%sf(k, l, q)*dv_dy(k, l, q) + & q_prim_vf(strxb + 2)%sf(k, l, q)*dv_dy(k, l, q) - & q_prim_vf(strxb + 2)%sf(k, l, q)*dv_dy(k, l, q) + & - 2d0*G_K_field(k, l, q)*(dv_dy(k, l, q) - (1d0/3d0)* & + 2._wp*G_K_field(k, l, q)*(dv_dy(k, l, q) - (1._wp/3._wp)* & (du_dx(k, l, q) + & dv_dy(k, l, q)))) end do @@ -254,7 +254,7 @@ contains (q_prim_vf(strxb + 3)%sf(k, l, q)*du_dz(k, l, q) + & q_prim_vf(strxb + 3)%sf(k, l, q)*du_dz(k, l, q) - & q_prim_vf(strxb)%sf(k, l, q)*dw_dz(k, l, q) - & - 2d0*G_K_field(k, l, q)*(1d0/3d0)*dw_dz(k, l, q)) + 2._wp*G_K_field(k, l, q)*(1._wp/3._wp)*dw_dz(k, l, q)) rhs_vf(strxb + 1)%sf(k, l, q) = rhs_vf(strxb + 1)%sf(k, l, q) + rho_K_field(k, l, q)* & (q_prim_vf(strxb + 4)%sf(k, l, q)*du_dz(k, l, q) + & @@ -265,7 +265,7 @@ contains (q_prim_vf(strxb + 4)%sf(k, l, q)*dv_dz(k, l, q) + & q_prim_vf(strxb + 4)%sf(k, l, q)*dv_dz(k, l, q) - & q_prim_vf(strxb + 2)%sf(k, l, q)*dw_dz(k, l, q) - & - 2d0*G_K_field(k, l, q)*(1d0/3d0)*dw_dz(k, l, q)) + 2._wp*G_K_field(k, l, q)*(1._wp/3._wp)*dw_dz(k, l, q)) rhs_vf(strxb + 3)%sf(k, l, q) = rhs_vf(strxb + 3)%sf(k, l, q) + rho_K_field(k, l, q)* & (q_prim_vf(strxb + 3)%sf(k, l, q)*du_dx(k, l, q) + & @@ -277,7 +277,7 @@ contains q_prim_vf(strxb + 5)%sf(k, l, q)*du_dz(k, l, q) + & q_prim_vf(strxb + 3)%sf(k, l, q)*dw_dz(k, l, q) - & q_prim_vf(strxb + 3)%sf(k, l, q)*dw_dz(k, l, q) + & - 2d0*G_K_field(k, l, q)*(1d0/2d0)*(du_dz(k, l, q) + & + 2._wp*G_K_field(k, l, q)*(1._wp/2._wp)*(du_dz(k, l, q) + & dw_dx(k, l, q))) rhs_vf(strxb + 4)%sf(k, l, q) = rhs_vf(strxb + 4)%sf(k, l, q) + rho_K_field(k, l, q)* & @@ -290,7 +290,7 @@ contains q_prim_vf(strxb + 5)%sf(k, l, q)*dv_dz(k, l, q) + & q_prim_vf(strxb + 4)%sf(k, l, q)*dw_dz(k, l, q) - & q_prim_vf(strxb + 4)%sf(k, l, q)*dw_dz(k, l, q) + & - 2d0*G_K_field(k, l, q)*(1d0/2d0)*(dv_dz(k, l, q) + & + 2._wp*G_K_field(k, l, q)*(1._wp/2._wp)*(dv_dz(k, l, q) + & dw_dy(k, l, q))) rhs_vf(strxe)%sf(k, l, q) = rhs_vf(strxe)%sf(k, l, q) + rho_K_field(k, l, q)* & @@ -303,7 +303,7 @@ contains q_prim_vf(strxe)%sf(k, l, q)*dw_dz(k, l, q) + & q_prim_vf(strxe)%sf(k, l, q)*dw_dz(k, l, q) - & q_prim_vf(strxe)%sf(k, l, q)*dw_dz(k, l, q) + & - 2d0*G_K_field(k, l, q)*(dw_dz(k, l, q) - (1d0/3d0)* & + 2._wp*G_K_field(k, l, q)*(dw_dz(k, l, q) - (1._wp/3._wp)* & (du_dx(k, l, q) + & dv_dy(k, l, q) + & dw_dz(k, l, q)))) diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 2e1985c501..1e688088e0 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -176,7 +176,7 @@ contains if (p > 0) then physical_loc = [x_cc(j), y_cc(k), z_cc(l)] else - physical_loc = [x_cc(j), y_cc(k), 0d0] + physical_loc = [x_cc(j), y_cc(k), 0._wp] end if !Interpolate primitive variables at image point associated w/ GP @@ -197,7 +197,7 @@ contains alpha_rho_IP, alpha_IP, pres_IP, vel_IP) end if - dyn_pres = 0d0 + dyn_pres = 0._wp ! Set q_prim_vf params at GP so that mixture vars calculated properly !$acc loop seq @@ -228,7 +228,7 @@ contains vel_norm_IP = sum(vel_IP*norm)*norm vel_g = vel_IP - vel_norm_IP else - vel_g = 0d0 + vel_g = 0._wp end if ! Set momentum @@ -236,7 +236,7 @@ contains do q = momxb, momxe q_cons_vf(q)%sf(j, k, l) = rho*vel_g(q - momxb + 1) dyn_pres = dyn_pres + q_cons_vf(q)%sf(j, k, l)* & - vel_g(q - momxb + 1)/2d0 + vel_g(q - momxb + 1)/2._wp end do ! Set continuity and adv vars @@ -301,7 +301,7 @@ contains !$acc parallel loop gang vector private(physical_loc, dyn_pres, alpha_rho_IP, alpha_IP, vel_g, rho, gamma, pi_inf, Re_K, innerp, j, k, l, q) do i = 1, num_inner_gps - vel_g = 0d0 + vel_g = 0._wp innerp = inner_points(i) j = innerp%loc(1) k = innerp%loc(2) @@ -312,7 +312,7 @@ contains if (p > 0) then physical_loc = [x_cc(j), y_cc(k), z_cc(l)] else - physical_loc = [x_cc(j), y_cc(k), 0d0] + physical_loc = [x_cc(j), y_cc(k), 0._wp] end if !$acc loop seq @@ -324,13 +324,13 @@ contains call s_convert_species_to_mixture_variables_acc(rho, gamma, pi_inf, qv_K, alpha_IP, & alpha_rho_IP, Re_K, j, k, l) - dyn_pres = 0d0 + dyn_pres = 0._wp !$acc loop seq do q = momxb, momxe q_cons_vf(q)%sf(j, k, l) = rho*vel_g(q - momxb + 1) dyn_pres = dyn_pres + q_cons_vf(q)%sf(j, k, l)* & - vel_g(q - momxb + 1)/2d0 + vel_g(q - momxb + 1)/2._wp end do end do @@ -367,7 +367,7 @@ contains if (p > 0) then physical_loc = [x_cc(i), y_cc(j), z_cc(k)] else - physical_loc = [x_cc(i), y_cc(j), 0d0] + physical_loc = [x_cc(i), y_cc(j), 0._wp] end if ! Calculate and store the precise location of the image point @@ -663,8 +663,8 @@ contains i1 = gp%ip_grid(1); i2 = i1 + 1 j1 = gp%ip_grid(2); j2 = j1 + 1 - dist = 0d0 - buf = 1d0 + dist = 0._wp + buf = 1._wp dist(1, 1, 1) = sqrt( & (x_cc(i1) - gp%ip_loc(1))**2 + & (y_cc(j1) - gp%ip_loc(2))**2) @@ -678,26 +678,26 @@ contains (x_cc(i2) - gp%ip_loc(1))**2 + & (y_cc(j2) - gp%ip_loc(2))**2) - interp_coeffs = 0d0 + interp_coeffs = 0._wp if (dist(1, 1, 1) <= 1d-16) then - interp_coeffs(1, 1, 1) = 1d0 + interp_coeffs(1, 1, 1) = 1._wp else if (dist(2, 1, 1) <= 1d-16) then - interp_coeffs(2, 1, 1) = 1d0 + interp_coeffs(2, 1, 1) = 1._wp else if (dist(1, 2, 1) <= 1d-16) then - interp_coeffs(1, 2, 1) = 1d0 + interp_coeffs(1, 2, 1) = 1._wp else if (dist(2, 2, 1) <= 1d-16) then - interp_coeffs(2, 2, 1) = 1d0 + interp_coeffs(2, 2, 1) = 1._wp else - eta(:, :, 1) = 1d0/dist(:, :, 1)**2 - alpha = 1d0 + eta(:, :, 1) = 1._wp/dist(:, :, 1)**2 + alpha = 1._wp patch_id = gp%ib_patch_id - if (ib_markers%sf(i1, j1, 0) /= 0) alpha(1, 1, 1) = 0d0 - if (ib_markers%sf(i2, j1, 0) /= 0) alpha(2, 1, 1) = 0d0 - if (ib_markers%sf(i1, j2, 0) /= 0) alpha(1, 2, 1) = 0d0 - if (ib_markers%sf(i2, j2, 0) /= 0) alpha(2, 2, 1) = 0d0 + if (ib_markers%sf(i1, j1, 0) /= 0) alpha(1, 1, 1) = 0._wp + if (ib_markers%sf(i2, j1, 0) /= 0) alpha(2, 1, 1) = 0._wp + if (ib_markers%sf(i1, j2, 0) /= 0) alpha(1, 2, 1) = 0._wp + if (ib_markers%sf(i2, j2, 0) /= 0) alpha(2, 2, 1) = 0._wp buf = sum(alpha(:, :, 1)*eta(:, :, 1)) - if (buf > 0d0) then + if (buf > 0._wp) then interp_coeffs(:, :, 1) = alpha(:, :, 1)*eta(:, :, 1)/buf else buf = sum(eta(:, :, 1)) @@ -749,37 +749,37 @@ contains (x_cc(i2) - gp%ip_loc(1))**2 + & (y_cc(j2) - gp%ip_loc(2))**2 + & (z_cc(k2) - gp%ip_loc(3))**2) - interp_coeffs = 0d0 - buf = 1d0 + interp_coeffs = 0._wp + buf = 1._wp if (dist(1, 1, 1) <= 1d-16) then - interp_coeffs(1, 1, 1) = 1d0 + interp_coeffs(1, 1, 1) = 1._wp else if (dist(2, 1, 1) <= 1d-16) then - interp_coeffs(2, 1, 1) = 1d0 + interp_coeffs(2, 1, 1) = 1._wp else if (dist(1, 2, 1) <= 1d-16) then - interp_coeffs(1, 2, 1) = 1d0 + interp_coeffs(1, 2, 1) = 1._wp else if (dist(2, 2, 1) <= 1d-16) then - interp_coeffs(2, 2, 1) = 1d0 + interp_coeffs(2, 2, 1) = 1._wp else if (dist(1, 1, 2) <= 1d-16) then - interp_coeffs(1, 1, 2) = 1d0 + interp_coeffs(1, 1, 2) = 1._wp else if (dist(2, 1, 2) <= 1d-16) then - interp_coeffs(2, 1, 2) = 1d0 + interp_coeffs(2, 1, 2) = 1._wp else if (dist(1, 2, 2) <= 1d-16) then - interp_coeffs(1, 2, 2) = 1d0 + interp_coeffs(1, 2, 2) = 1._wp else if (dist(2, 2, 2) <= 1d-16) then - interp_coeffs(2, 2, 2) = 1d0 + interp_coeffs(2, 2, 2) = 1._wp else - eta = 1d0/dist**2 - alpha = 1d0 - if (ib_markers%sf(i1, j1, k1) /= 0) alpha(1, 1, 1) = 0d0 - if (ib_markers%sf(i2, j1, k1) /= 0) alpha(2, 1, 1) = 0d0 - if (ib_markers%sf(i1, j2, k1) /= 0) alpha(1, 2, 1) = 0d0 - if (ib_markers%sf(i2, j2, k1) /= 0) alpha(2, 2, 1) = 0d0 - if (ib_markers%sf(i1, j1, k2) /= 0) alpha(1, 1, 2) = 0d0 - if (ib_markers%sf(i2, j1, k2) /= 0) alpha(2, 1, 2) = 0d0 - if (ib_markers%sf(i1, j2, k2) /= 0) alpha(1, 2, 2) = 0d0 - if (ib_markers%sf(i2, j2, k2) /= 0) alpha(2, 2, 2) = 0d0 + eta = 1._wp/dist**2 + alpha = 1._wp + if (ib_markers%sf(i1, j1, k1) /= 0) alpha(1, 1, 1) = 0._wp + if (ib_markers%sf(i2, j1, k1) /= 0) alpha(2, 1, 1) = 0._wp + if (ib_markers%sf(i1, j2, k1) /= 0) alpha(1, 2, 1) = 0._wp + if (ib_markers%sf(i2, j2, k1) /= 0) alpha(2, 2, 1) = 0._wp + if (ib_markers%sf(i1, j1, k2) /= 0) alpha(1, 1, 2) = 0._wp + if (ib_markers%sf(i2, j1, k2) /= 0) alpha(2, 1, 2) = 0._wp + if (ib_markers%sf(i1, j2, k2) /= 0) alpha(1, 2, 2) = 0._wp + if (ib_markers%sf(i2, j2, k2) /= 0) alpha(2, 2, 2) = 0._wp buf = sum(alpha*eta) - if (buf > 0d0) then + if (buf > 0._wp) then interp_coeffs = alpha*eta/buf else buf = sum(eta) @@ -818,25 +818,25 @@ contains k2 = 0 end if - alpha_rho_IP = 0d0 - alpha_IP = 0d0 - pres_IP = 0d0 - vel_IP = 0d0 + alpha_rho_IP = 0._wp + alpha_IP = 0._wp + pres_IP = 0._wp + vel_IP = 0._wp if (bubbles) then - r_IP = 0d0 - v_IP = 0d0 + r_IP = 0._wp + v_IP = 0._wp if (.not. polytropic) then - mv_IP = 0d0 - pb_IP = 0d0 + mv_IP = 0._wp + pb_IP = 0._wp end if end if if (qbmm) then - nmom_IP = 0d0 + nmom_IP = 0._wp if (.not. polytropic) then - presb_IP = 0d0 - massv_IP = 0d0 + presb_IP = 0._wp + massv_IP = 0._wp end if end if diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index 256903c9d4..bbea5bb7b2 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -334,7 +334,7 @@ contains tmp_num_procs_x = num_procs_x tmp_num_procs_y = num_procs_y tmp_num_procs_z = num_procs_z - fct_min = 10d0*abs((m + 1)/tmp_num_procs_x & + fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - (n + 1)/tmp_num_procs_y) ! Searching for optimal computational domain distribution @@ -378,9 +378,9 @@ contains tmp_num_procs_x = num_procs_x tmp_num_procs_y = num_procs_y tmp_num_procs_z = num_procs_z - fct_min = 10d0*abs((m + 1)/tmp_num_procs_x & + fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - (n + 1)/tmp_num_procs_y) & - + 10d0*abs((n + 1)/tmp_num_procs_y & + + 10._wp*abs((n + 1)/tmp_num_procs_y & - (p + 1)/tmp_num_procs_z) ! Optimization of the initial processor topology @@ -501,7 +501,7 @@ contains ! Benchmarking the quality of this initial guess tmp_num_procs_x = num_procs_x tmp_num_procs_y = num_procs_y - fct_min = 10d0*abs((m + 1)/tmp_num_procs_x & + fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - (n + 1)/tmp_num_procs_y) ! Optimization of the initial processor topology diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp index 4bc8beb30f..bfbc590dd9 100644 --- a/src/simulation/m_qbmm.fpp +++ b/src/simulation/m_qbmm.fpp @@ -77,7 +77,7 @@ contains #:endif @:ALLOCATE_GLOBAL(momrhs(3, 0:2, 0:2, nterms, nb)) - momrhs = 0d0 + momrhs = 0._wp ! Assigns the required RHS moments for moment transport equations ! The rhs%(:,3) is only to be used for R0 quadrature, not for computing X/Y indices @@ -87,169 +87,169 @@ contains do i1 = 0, 2; do i2 = 0, 2 if ((i1 + i2) <= 2) then if (bubble_model == 3) then - momrhs(1, i1, i2, 1, q) = -1.d0 + i1 - momrhs(2, i1, i2, 1, q) = -1.d0 + i2 - momrhs(3, i1, i2, 1, q) = 0d0 + momrhs(1, i1, i2, 1, q) = -1._wp + i1 + momrhs(2, i1, i2, 1, q) = -1._wp + i2 + momrhs(3, i1, i2, 1, q) = 0._wp - momrhs(1, i1, i2, 2, q) = -1.d0 + i1 - momrhs(2, i1, i2, 2, q) = 1.d0 + i2 - momrhs(3, i1, i2, 2, q) = 0d0 + momrhs(1, i1, i2, 2, q) = -1._wp + i1 + momrhs(2, i1, i2, 2, q) = 1._wp + i2 + momrhs(3, i1, i2, 2, q) = 0._wp - momrhs(1, i1, i2, 3, q) = -1.d0 + i1 - momrhs(2, i1, i2, 3, q) = -1.d0 + i2 - momrhs(3, i1, i2, 3, q) = 0d0 + momrhs(1, i1, i2, 3, q) = -1._wp + i1 + momrhs(2, i1, i2, 3, q) = -1._wp + i2 + momrhs(3, i1, i2, 3, q) = 0._wp - momrhs(1, i1, i2, 4, q) = -1.d0 + i1 - momrhs(2, i1, i2, 4, q) = 1.d0 + i2 - momrhs(3, i1, i2, 4, q) = 0d0 + momrhs(1, i1, i2, 4, q) = -1._wp + i1 + momrhs(2, i1, i2, 4, q) = 1._wp + i2 + momrhs(3, i1, i2, 4, q) = 0._wp if (.not. f_is_default(Re_inv)) then ! add viscosity - momrhs(1, i1, i2, 5, q) = -2.d0 + i1 + momrhs(1, i1, i2, 5, q) = -2._wp + i1 momrhs(2, i1, i2, 5, q) = i2 - momrhs(3, i1, i2, 5, q) = 0d0 + momrhs(3, i1, i2, 5, q) = 0._wp end if if (.not. f_is_default(Web)) then ! add surface tension - momrhs(1, i1, i2, 6, q) = -2.d0 + i1 - momrhs(2, i1, i2, 6, q) = -1.d0 + i2 - momrhs(3, i1, i2, 6, q) = 0d0 + momrhs(1, i1, i2, 6, q) = -2._wp + i1 + momrhs(2, i1, i2, 6, q) = -1._wp + i2 + momrhs(3, i1, i2, 6, q) = 0._wp end if - momrhs(1, i1, i2, 7, q) = -1.d0 + i1 - momrhs(2, i1, i2, 7, q) = -1.d0 + i2 - momrhs(3, i1, i2, 7, q) = 0d0 + momrhs(1, i1, i2, 7, q) = -1._wp + i1 + momrhs(2, i1, i2, 7, q) = -1._wp + i2 + momrhs(3, i1, i2, 7, q) = 0._wp else if (bubble_model == 2) then ! KM with approximation of 1/(1-V/C) = 1+V/C - momrhs(1, i1, i2, 1, q) = -1d0 + i1 - momrhs(2, i1, i2, 1, q) = 1d0 + i2 - momrhs(3, i1, i2, 1, q) = 0d0 + momrhs(1, i1, i2, 1, q) = -1._wp + i1 + momrhs(2, i1, i2, 1, q) = 1._wp + i2 + momrhs(3, i1, i2, 1, q) = 0._wp - momrhs(1, i1, i2, 2, q) = -1d0 + i1 - momrhs(2, i1, i2, 2, q) = 2d0 + i2 - momrhs(3, i1, i2, 2, q) = 0d0 + momrhs(1, i1, i2, 2, q) = -1._wp + i1 + momrhs(2, i1, i2, 2, q) = 2._wp + i2 + momrhs(3, i1, i2, 2, q) = 0._wp - momrhs(1, i1, i2, 3, q) = -1d0 + i1 - momrhs(2, i1, i2, 3, q) = 3d0 + i2 - momrhs(3, i1, i2, 3, q) = 0d0 + momrhs(1, i1, i2, 3, q) = -1._wp + i1 + momrhs(2, i1, i2, 3, q) = 3._wp + i2 + momrhs(3, i1, i2, 3, q) = 0._wp - momrhs(1, i1, i2, 4, q) = -1d0 + i1 - momrhs(2, i1, i2, 4, q) = -1d0 + i2 - momrhs(3, i1, i2, 4, q) = 0d0 + momrhs(1, i1, i2, 4, q) = -1._wp + i1 + momrhs(2, i1, i2, 4, q) = -1._wp + i2 + momrhs(3, i1, i2, 4, q) = 0._wp - momrhs(1, i1, i2, 5, q) = -1d0 + i1 + momrhs(1, i1, i2, 5, q) = -1._wp + i1 momrhs(2, i1, i2, 5, q) = i2 - momrhs(3, i1, i2, 5, q) = 0d0 + momrhs(3, i1, i2, 5, q) = 0._wp - momrhs(1, i1, i2, 6, q) = -1d0 + i1 - momrhs(2, i1, i2, 6, q) = 1d0 + i2 - momrhs(3, i1, i2, 6, q) = 0d0 + momrhs(1, i1, i2, 6, q) = -1._wp + i1 + momrhs(2, i1, i2, 6, q) = 1._wp + i2 + momrhs(3, i1, i2, 6, q) = 0._wp - momrhs(1, i1, i2, 7, q) = -1d0 + i1 - momrhs(2, i1, i2, 7, q) = -1d0 + i2 - momrhs(3, i1, i2, 7, q) = 0d0 + momrhs(1, i1, i2, 7, q) = -1._wp + i1 + momrhs(2, i1, i2, 7, q) = -1._wp + i2 + momrhs(3, i1, i2, 7, q) = 0._wp - momrhs(1, i1, i2, 8, q) = -1d0 + i1 + momrhs(1, i1, i2, 8, q) = -1._wp + i1 momrhs(2, i1, i2, 8, q) = i2 - momrhs(3, i1, i2, 8, q) = 0d0 + momrhs(3, i1, i2, 8, q) = 0._wp - momrhs(1, i1, i2, 9, q) = -1d0 + i1 - momrhs(2, i1, i2, 9, q) = 1d0 + i2 - momrhs(3, i1, i2, 9, q) = 0d0 + momrhs(1, i1, i2, 9, q) = -1._wp + i1 + momrhs(2, i1, i2, 9, q) = 1._wp + i2 + momrhs(3, i1, i2, 9, q) = 0._wp - momrhs(1, i1, i2, 10, q) = -1d0 + i1 + momrhs(1, i1, i2, 10, q) = -1._wp + i1 momrhs(2, i1, i2, 10, q) = i2 - momrhs(3, i1, i2, 10, q) = 0d0 + momrhs(3, i1, i2, 10, q) = 0._wp - momrhs(1, i1, i2, 11, q) = -1d0 + i1 - momrhs(2, i1, i2, 11, q) = 1d0 + i2 - momrhs(3, i1, i2, 11, q) = 0d0 + momrhs(1, i1, i2, 11, q) = -1._wp + i1 + momrhs(2, i1, i2, 11, q) = 1._wp + i2 + momrhs(3, i1, i2, 11, q) = 0._wp - momrhs(1, i1, i2, 12, q) = -1d0 + i1 - momrhs(2, i1, i2, 12, q) = 1d0 + i2 - momrhs(3, i1, i2, 12, q) = 0d0 + momrhs(1, i1, i2, 12, q) = -1._wp + i1 + momrhs(2, i1, i2, 12, q) = 1._wp + i2 + momrhs(3, i1, i2, 12, q) = 0._wp - momrhs(1, i1, i2, 13, q) = -1d0 + i1 - momrhs(2, i1, i2, 13, q) = -1d0 + i2 - momrhs(3, i1, i2, 13, q) = 0d0 + momrhs(1, i1, i2, 13, q) = -1._wp + i1 + momrhs(2, i1, i2, 13, q) = -1._wp + i2 + momrhs(3, i1, i2, 13, q) = 0._wp - momrhs(1, i1, i2, 14, q) = -1d0 + i1 + momrhs(1, i1, i2, 14, q) = -1._wp + i1 momrhs(2, i1, i2, 14, q) = i2 - momrhs(3, i1, i2, 14, q) = 0d0 + momrhs(3, i1, i2, 14, q) = 0._wp - momrhs(1, i1, i2, 15, q) = -1d0 + i1 - momrhs(2, i1, i2, 15, q) = 1d0 + i2 - momrhs(3, i1, i2, 15, q) = 0d0 + momrhs(1, i1, i2, 15, q) = -1._wp + i1 + momrhs(2, i1, i2, 15, q) = 1._wp + i2 + momrhs(3, i1, i2, 15, q) = 0._wp - momrhs(1, i1, i2, 16, q) = -2d0 + i1 + momrhs(1, i1, i2, 16, q) = -2._wp + i1 momrhs(2, i1, i2, 16, q) = i2 - momrhs(3, i1, i2, 16, q) = 0d0 + momrhs(3, i1, i2, 16, q) = 0._wp - momrhs(1, i1, i2, 17, q) = -2d0 + i1 - momrhs(2, i1, i2, 17, q) = -1d0 + i2 - momrhs(3, i1, i2, 17, q) = 0d0 + momrhs(1, i1, i2, 17, q) = -2._wp + i1 + momrhs(2, i1, i2, 17, q) = -1._wp + i2 + momrhs(3, i1, i2, 17, q) = 0._wp - momrhs(1, i1, i2, 18, q) = -2d0 + i1 - momrhs(2, i1, i2, 18, q) = 1d0 + i2 - momrhs(3, i1, i2, 18, q) = 0d0 + momrhs(1, i1, i2, 18, q) = -2._wp + i1 + momrhs(2, i1, i2, 18, q) = 1._wp + i2 + momrhs(3, i1, i2, 18, q) = 0._wp - momrhs(1, i1, i2, 19, q) = -2d0 + i1 - momrhs(2, i1, i2, 19, q) = 2d0 + i2 - momrhs(3, i1, i2, 19, q) = 0d0 + momrhs(1, i1, i2, 19, q) = -2._wp + i1 + momrhs(2, i1, i2, 19, q) = 2._wp + i2 + momrhs(3, i1, i2, 19, q) = 0._wp - momrhs(1, i1, i2, 20, q) = -2d0 + i1 - momrhs(2, i1, i2, 20, q) = -1d0 + i2 - momrhs(3, i1, i2, 20, q) = 0d0 + momrhs(1, i1, i2, 20, q) = -2._wp + i1 + momrhs(2, i1, i2, 20, q) = -1._wp + i2 + momrhs(3, i1, i2, 20, q) = 0._wp - momrhs(1, i1, i2, 21, q) = -2d0 + i1 + momrhs(1, i1, i2, 21, q) = -2._wp + i1 momrhs(2, i1, i2, 21, q) = i2 - momrhs(3, i1, i2, 21, q) = 0d0 + momrhs(3, i1, i2, 21, q) = 0._wp - momrhs(1, i1, i2, 22, q) = -2d0 + i1 - momrhs(2, i1, i2, 22, q) = -1d0 + i2 - momrhs(3, i1, i2, 22, q) = 0d0 + momrhs(1, i1, i2, 22, q) = -2._wp + i1 + momrhs(2, i1, i2, 22, q) = -1._wp + i2 + momrhs(3, i1, i2, 22, q) = 0._wp - momrhs(1, i1, i2, 23, q) = -2d0 + i1 + momrhs(1, i1, i2, 23, q) = -2._wp + i1 momrhs(2, i1, i2, 23, q) = i2 - momrhs(3, i1, i2, 23, q) = 0d0 + momrhs(3, i1, i2, 23, q) = 0._wp - momrhs(1, i1, i2, 24, q) = -3d0 + i1 + momrhs(1, i1, i2, 24, q) = -3._wp + i1 momrhs(2, i1, i2, 24, q) = i2 - momrhs(3, i1, i2, 24, q) = 0d0 + momrhs(3, i1, i2, 24, q) = 0._wp - momrhs(1, i1, i2, 25, q) = -3d0 + i1 - momrhs(2, i1, i2, 25, q) = -1d0 + i2 - momrhs(3, i1, i2, 25, q) = 0d0 + momrhs(1, i1, i2, 25, q) = -3._wp + i1 + momrhs(2, i1, i2, 25, q) = -1._wp + i2 + momrhs(3, i1, i2, 25, q) = 0._wp - momrhs(1, i1, i2, 26, q) = -2d0 + i1 + momrhs(1, i1, i2, 26, q) = -2._wp + i1 momrhs(2, i1, i2, 26, q) = i2 - momrhs(3, i1, i2, 26, q) = 0d0 + momrhs(3, i1, i2, 26, q) = 0._wp - momrhs(1, i1, i2, 27, q) = -1d0 + i1 - momrhs(2, i1, i2, 27, q) = -1d0 + i2 - momrhs(3, i1, i2, 27, q) = 0d0 + momrhs(1, i1, i2, 27, q) = -1._wp + i1 + momrhs(2, i1, i2, 27, q) = -1._wp + i2 + momrhs(3, i1, i2, 27, q) = 0._wp - momrhs(1, i1, i2, 28, q) = -1d0 + i1 + momrhs(1, i1, i2, 28, q) = -1._wp + i1 momrhs(2, i1, i2, 28, q) = i2 - momrhs(3, i1, i2, 28, q) = 0d0 + momrhs(3, i1, i2, 28, q) = 0._wp - momrhs(1, i1, i2, 29, q) = -2d0 + i1 + momrhs(1, i1, i2, 29, q) = -2._wp + i1 momrhs(2, i1, i2, 29, q) = i2 - momrhs(3, i1, i2, 29, q) = 0d0 + momrhs(3, i1, i2, 29, q) = 0._wp - momrhs(1, i1, i2, 30, q) = -1d0 + i1 - momrhs(2, i1, i2, 30, q) = -1d0 + i2 - momrhs(3, i1, i2, 30, q) = 0d0 + momrhs(1, i1, i2, 30, q) = -1._wp + i1 + momrhs(2, i1, i2, 30, q) = -1._wp + i2 + momrhs(3, i1, i2, 30, q) = 0._wp - momrhs(1, i1, i2, 31, q) = -1d0 + i1 + momrhs(1, i1, i2, 31, q) = -1._wp + i1 momrhs(2, i1, i2, 31, q) = i2 - momrhs(3, i1, i2, 31, q) = 0d0 + momrhs(3, i1, i2, 31, q) = 0._wp - momrhs(1, i1, i2, 32, q) = -2d0 + i1 + momrhs(1, i1, i2, 32, q) = -2._wp + i1 momrhs(2, i1, i2, 32, q) = i2 - momrhs(3, i1, i2, 32, q) = 0d0 + momrhs(3, i1, i2, 32, q) = 0._wp end if end if end do; end do @@ -260,145 +260,145 @@ contains do i1 = 0, 2; do i2 = 0, 2 if ((i1 + i2) <= 2) then if (bubble_model == 3) then - momrhs(1, i1, i2, 1, q) = -1.d0 + i1 - momrhs(2, i1, i2, 1, q) = -1.d0 + i2 - momrhs(3, i1, i2, 1, q) = 0d0 + momrhs(1, i1, i2, 1, q) = -1._wp + i1 + momrhs(2, i1, i2, 1, q) = -1._wp + i2 + momrhs(3, i1, i2, 1, q) = 0._wp - momrhs(1, i1, i2, 2, q) = -1.d0 + i1 - momrhs(2, i1, i2, 2, q) = 1.d0 + i2 - momrhs(3, i1, i2, 2, q) = 0d0 + momrhs(1, i1, i2, 2, q) = -1._wp + i1 + momrhs(2, i1, i2, 2, q) = 1._wp + i2 + momrhs(3, i1, i2, 2, q) = 0._wp - momrhs(1, i1, i2, 3, q) = -1.d0 + i1 - 3.d0*gam - momrhs(2, i1, i2, 3, q) = -1.d0 + i2 - momrhs(3, i1, i2, 3, q) = 3.d0*gam + momrhs(1, i1, i2, 3, q) = -1._wp + i1 - 3._wp*gam + momrhs(2, i1, i2, 3, q) = -1._wp + i2 + momrhs(3, i1, i2, 3, q) = 3._wp*gam - momrhs(1, i1, i2, 4, q) = -1.d0 + i1 - momrhs(2, i1, i2, 4, q) = 1.d0 + i2 - momrhs(3, i1, i2, 4, q) = 0d0 + momrhs(1, i1, i2, 4, q) = -1._wp + i1 + momrhs(2, i1, i2, 4, q) = 1._wp + i2 + momrhs(3, i1, i2, 4, q) = 0._wp if (.not. f_is_default(Re_inv)) then ! add viscosity - momrhs(1, i1, i2, 5, q) = -2.d0 + i1 + momrhs(1, i1, i2, 5, q) = -2._wp + i1 momrhs(2, i1, i2, 5, q) = i2 - momrhs(3, i1, i2, 5, q) = 0d0 + momrhs(3, i1, i2, 5, q) = 0._wp end if if (.not. f_is_default(Web)) then ! add surface tension - momrhs(1, i1, i2, 6, q) = -2.d0 + i1 - momrhs(2, i1, i2, 6, q) = -1.d0 + i2 - momrhs(3, i1, i2, 6, q) = 0d0 + momrhs(1, i1, i2, 6, q) = -2._wp + i1 + momrhs(2, i1, i2, 6, q) = -1._wp + i2 + momrhs(3, i1, i2, 6, q) = 0._wp end if - momrhs(1, i1, i2, 7, q) = -1.d0 + i1 - momrhs(2, i1, i2, 7, q) = -1.d0 + i2 - momrhs(3, i1, i2, 7, q) = 0d0 + momrhs(1, i1, i2, 7, q) = -1._wp + i1 + momrhs(2, i1, i2, 7, q) = -1._wp + i2 + momrhs(3, i1, i2, 7, q) = 0._wp else if (bubble_model == 2) then ! KM with approximation of 1/(1-V/C) = 1+V/C - momrhs(1, i1, i2, 1, q) = -1d0 + i1 - momrhs(2, i1, i2, 1, q) = 1d0 + i2 - momrhs(3, i1, i2, 1, q) = 0d0 + momrhs(1, i1, i2, 1, q) = -1._wp + i1 + momrhs(2, i1, i2, 1, q) = 1._wp + i2 + momrhs(3, i1, i2, 1, q) = 0._wp - momrhs(1, i1, i2, 2, q) = -1d0 + i1 - momrhs(2, i1, i2, 2, q) = 2d0 + i2 - momrhs(3, i1, i2, 2, q) = 0d0 + momrhs(1, i1, i2, 2, q) = -1._wp + i1 + momrhs(2, i1, i2, 2, q) = 2._wp + i2 + momrhs(3, i1, i2, 2, q) = 0._wp - momrhs(1, i1, i2, 3, q) = -1d0 + i1 - momrhs(2, i1, i2, 3, q) = 3d0 + i2 - momrhs(3, i1, i2, 3, q) = 0d0 + momrhs(1, i1, i2, 3, q) = -1._wp + i1 + momrhs(2, i1, i2, 3, q) = 3._wp + i2 + momrhs(3, i1, i2, 3, q) = 0._wp - momrhs(1, i1, i2, 4, q) = -1d0 + i1 - momrhs(2, i1, i2, 4, q) = -1d0 + i2 - momrhs(3, i1, i2, 4, q) = 0d0 + momrhs(1, i1, i2, 4, q) = -1._wp + i1 + momrhs(2, i1, i2, 4, q) = -1._wp + i2 + momrhs(3, i1, i2, 4, q) = 0._wp - momrhs(1, i1, i2, 5, q) = -1d0 + i1 + momrhs(1, i1, i2, 5, q) = -1._wp + i1 momrhs(2, i1, i2, 5, q) = i2 - momrhs(3, i1, i2, 5, q) = 0d0 + momrhs(3, i1, i2, 5, q) = 0._wp - momrhs(1, i1, i2, 6, q) = -1d0 + i1 - momrhs(2, i1, i2, 6, q) = 1d0 + i2 - momrhs(3, i1, i2, 6, q) = 0d0 + momrhs(1, i1, i2, 6, q) = -1._wp + i1 + momrhs(2, i1, i2, 6, q) = 1._wp + i2 + momrhs(3, i1, i2, 6, q) = 0._wp - momrhs(1, i1, i2, 7, q) = -1d0 + i1 - 3d0*gam - momrhs(2, i1, i2, 7, q) = -1d0 + i2 - momrhs(3, i1, i2, 7, q) = 3d0*gam + momrhs(1, i1, i2, 7, q) = -1._wp + i1 - 3._wp*gam + momrhs(2, i1, i2, 7, q) = -1._wp + i2 + momrhs(3, i1, i2, 7, q) = 3._wp*gam - momrhs(1, i1, i2, 8, q) = -1d0 + i1 - 3d0*gam + momrhs(1, i1, i2, 8, q) = -1._wp + i1 - 3._wp*gam momrhs(2, i1, i2, 8, q) = i2 - momrhs(3, i1, i2, 8, q) = 3d0*gam + momrhs(3, i1, i2, 8, q) = 3._wp*gam - momrhs(1, i1, i2, 9, q) = -1d0 + i1 - 3d0*gam - momrhs(2, i1, i2, 9, q) = 1d0 + i2 - momrhs(3, i1, i2, 9, q) = 3d0*gam + momrhs(1, i1, i2, 9, q) = -1._wp + i1 - 3._wp*gam + momrhs(2, i1, i2, 9, q) = 1._wp + i2 + momrhs(3, i1, i2, 9, q) = 3._wp*gam - momrhs(1, i1, i2, 10, q) = -1d0 + i1 - 3d0*gam + momrhs(1, i1, i2, 10, q) = -1._wp + i1 - 3._wp*gam momrhs(2, i1, i2, 10, q) = i2 - momrhs(3, i1, i2, 10, q) = 3d0*gam + momrhs(3, i1, i2, 10, q) = 3._wp*gam - momrhs(1, i1, i2, 11, q) = -1d0 + i1 - 3d0*gam - momrhs(2, i1, i2, 11, q) = 1d0 + i2 - momrhs(3, i1, i2, 11, q) = 3d0*gam + momrhs(1, i1, i2, 11, q) = -1._wp + i1 - 3._wp*gam + momrhs(2, i1, i2, 11, q) = 1._wp + i2 + momrhs(3, i1, i2, 11, q) = 3._wp*gam - momrhs(1, i1, i2, 12, q) = -1d0 + i1 - momrhs(2, i1, i2, 12, q) = 1d0 + i2 - momrhs(3, i1, i2, 12, q) = 0d0 + momrhs(1, i1, i2, 12, q) = -1._wp + i1 + momrhs(2, i1, i2, 12, q) = 1._wp + i2 + momrhs(3, i1, i2, 12, q) = 0._wp - momrhs(1, i1, i2, 13, q) = -1d0 + i1 - momrhs(2, i1, i2, 13, q) = -1d0 + i2 - momrhs(3, i1, i2, 13, q) = 0d0 + momrhs(1, i1, i2, 13, q) = -1._wp + i1 + momrhs(2, i1, i2, 13, q) = -1._wp + i2 + momrhs(3, i1, i2, 13, q) = 0._wp - momrhs(1, i1, i2, 14, q) = -1d0 + i1 + momrhs(1, i1, i2, 14, q) = -1._wp + i1 momrhs(2, i1, i2, 14, q) = i2 - momrhs(3, i1, i2, 14, q) = 0d0 + momrhs(3, i1, i2, 14, q) = 0._wp - momrhs(1, i1, i2, 15, q) = -1d0 + i1 - momrhs(2, i1, i2, 15, q) = 1d0 + i2 - momrhs(3, i1, i2, 15, q) = 0d0 + momrhs(1, i1, i2, 15, q) = -1._wp + i1 + momrhs(2, i1, i2, 15, q) = 1._wp + i2 + momrhs(3, i1, i2, 15, q) = 0._wp - momrhs(1, i1, i2, 16, q) = -2d0 + i1 + momrhs(1, i1, i2, 16, q) = -2._wp + i1 momrhs(2, i1, i2, 16, q) = i2 - momrhs(3, i1, i2, 16, q) = 0d0 + momrhs(3, i1, i2, 16, q) = 0._wp - momrhs(1, i1, i2, 17, q) = -2d0 + i1 - momrhs(2, i1, i2, 17, q) = -1d0 + i2 - momrhs(3, i1, i2, 17, q) = 0d0 + momrhs(1, i1, i2, 17, q) = -2._wp + i1 + momrhs(2, i1, i2, 17, q) = -1._wp + i2 + momrhs(3, i1, i2, 17, q) = 0._wp - momrhs(1, i1, i2, 18, q) = -2d0 + i1 - momrhs(2, i1, i2, 18, q) = 1d0 + i2 - momrhs(3, i1, i2, 18, q) = 0d0 + momrhs(1, i1, i2, 18, q) = -2._wp + i1 + momrhs(2, i1, i2, 18, q) = 1._wp + i2 + momrhs(3, i1, i2, 18, q) = 0._wp - momrhs(1, i1, i2, 19, q) = -2d0 + i1 - momrhs(2, i1, i2, 19, q) = 2d0 + i2 - momrhs(3, i1, i2, 19, q) = 0d0 + momrhs(1, i1, i2, 19, q) = -2._wp + i1 + momrhs(2, i1, i2, 19, q) = 2._wp + i2 + momrhs(3, i1, i2, 19, q) = 0._wp - momrhs(1, i1, i2, 20, q) = -2d0 + i1 - momrhs(2, i1, i2, 20, q) = -1d0 + i2 - momrhs(3, i1, i2, 20, q) = 0d0 + momrhs(1, i1, i2, 20, q) = -2._wp + i1 + momrhs(2, i1, i2, 20, q) = -1._wp + i2 + momrhs(3, i1, i2, 20, q) = 0._wp - momrhs(1, i1, i2, 21, q) = -2d0 + i1 + momrhs(1, i1, i2, 21, q) = -2._wp + i1 momrhs(2, i1, i2, 21, q) = i2 - momrhs(3, i1, i2, 21, q) = 0d0 + momrhs(3, i1, i2, 21, q) = 0._wp - momrhs(1, i1, i2, 22, q) = -2d0 + i1 - 3d0*gam - momrhs(2, i1, i2, 22, q) = -1d0 + i2 - momrhs(3, i1, i2, 22, q) = 3d0*gam + momrhs(1, i1, i2, 22, q) = -2._wp + i1 - 3._wp*gam + momrhs(2, i1, i2, 22, q) = -1._wp + i2 + momrhs(3, i1, i2, 22, q) = 3._wp*gam - momrhs(1, i1, i2, 23, q) = -2d0 + i1 - 3d0*gam + momrhs(1, i1, i2, 23, q) = -2._wp + i1 - 3._wp*gam momrhs(2, i1, i2, 23, q) = i2 - momrhs(3, i1, i2, 23, q) = 3d0*gam + momrhs(3, i1, i2, 23, q) = 3._wp*gam - momrhs(1, i1, i2, 24, q) = -3d0 + i1 + momrhs(1, i1, i2, 24, q) = -3._wp + i1 momrhs(2, i1, i2, 24, q) = i2 - momrhs(3, i1, i2, 24, q) = 0d0 + momrhs(3, i1, i2, 24, q) = 0._wp - momrhs(1, i1, i2, 25, q) = -3d0 + i1 - momrhs(2, i1, i2, 25, q) = -1d0 + i2 - momrhs(3, i1, i2, 25, q) = 0d0 + momrhs(1, i1, i2, 25, q) = -3._wp + i1 + momrhs(2, i1, i2, 25, q) = -1._wp + i2 + momrhs(3, i1, i2, 25, q) = 0._wp - momrhs(1, i1, i2, 26, q) = -2d0 + i1 - 3d0*gam + momrhs(1, i1, i2, 26, q) = -2._wp + i1 - 3._wp*gam momrhs(2, i1, i2, 26, q) = i2 - momrhs(3, i1, i2, 26, q) = 3d0*gam + momrhs(3, i1, i2, 26, q) = 3._wp*gam end if end if @@ -455,8 +455,8 @@ contains R = q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l) R2 = q_prim_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l) - if (R2 - R**2d0 > 0d0) then - var = R2 - R**2d0 + if (R2 - R**2._wp > 0._wp) then + var = R2 - R**2._wp else var = verysmall end if @@ -471,20 +471,20 @@ contains nR_dot = flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j - 1, k, l) - flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l) nR2_dot = flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j - 1, k, l) - flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dx(j)*AX*nb_q**2)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dx(j)*AX*nb_q**2)* & (nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i)) if (q <= 2) then - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2d0)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2._wp)* & (nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2d0)* & - (-2d0*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2._wp)* & + (-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) else - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2d0)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2._wp)* & (nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2d0)* & - (-2d0*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2._wp)* & + (-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) end if end do @@ -539,8 +539,8 @@ contains R = q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l) R2 = q_prim_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l) - if (R2 - R**2d0 > 0d0) then - var = R2 - R**2d0 + if (R2 - R**2._wp > 0._wp) then + var = R2 - R**2._wp else var = verysmall end if @@ -555,20 +555,20 @@ contains nR_dot = flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k - 1, l) - flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l) nR2_dot = flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k - 1, l) - flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dy(k)*AX*nb_q**2)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dy(k)*AX*nb_q**2)* & (nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i)) if (q <= 2) then - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2d0)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2._wp)* & (nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2d0)* & - (-2d0*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2._wp)* & + (-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) else - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2d0)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2._wp)* & (nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2d0)* & - (-2d0*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2._wp)* & + (-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) end if end do @@ -596,8 +596,8 @@ contains R = q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l) R2 = q_prim_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l) - if (R2 - R**2d0 > 0d0) then - var = R2 - R**2d0 + if (R2 - R**2._wp > 0._wp) then + var = R2 - R**2._wp else var = verysmall end if @@ -612,20 +612,20 @@ contains nR_dot = q_prim_vf(contxe + idir)%sf(j, k, l)*(flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)) nR2_dot = q_prim_vf(contxe + idir)%sf(j, k, l)*(flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*y_cc(k)*AX*nb_q**2)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2)* & (nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i)) if (q <= 2) then - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2d0)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2._wp)* & (nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2d0)* & - (-2d0*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2._wp)* & + (-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) else - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2d0)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2._wp)* & (nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2d0)* & - (-2d0*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2._wp)* & + (-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) end if end do end do @@ -647,8 +647,8 @@ contains R = q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l) R2 = q_prim_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l) - if (R2 - R**2d0 > 0d0) then - var = R2 - R**2d0 + if (R2 - R**2._wp > 0._wp) then + var = R2 - R**2._wp else var = verysmall end if @@ -663,20 +663,20 @@ contains nR_dot = flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l) nR2_dot = flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*AX*nb_q**2)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*AX*nb_q**2)* & (nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i)) if (q <= 2) then - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2d0)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2._wp)* & (nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2d0)* & - (-2d0*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2._wp)* & + (-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) else - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2d0)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2._wp)* & (nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2d0)* & - (-2d0*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2._wp)* & + (-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) end if end do @@ -699,65 +699,65 @@ contains #else !$acc routine seq #endif - real(kind(0.d0)), intent(in) :: pres, rho, c - real(kind(0.d0)), dimension(nterms, 0:2, 0:2), intent(out) :: coeffs + real(wp), intent(in) :: pres, rho, c + real(wp), dimension(nterms, 0:2, 0:2), intent(out) :: coeffs integer :: i1, i2, q - coeffs = 0d0 + coeffs = 0._wp do i2 = 0, 2; do i1 = 0, 2 if ((i1 + i2) <= 2) then if (bubble_model == 3) then ! RPE - coeffs(1, i1, i2) = -1d0*i2*pres/rho - coeffs(2, i1, i2) = -3d0*i2/2d0 + coeffs(1, i1, i2) = -1._wp*i2*pres/rho + coeffs(2, i1, i2) = -3._wp*i2/2._wp coeffs(3, i1, i2) = i2/rho coeffs(4, i1, i2) = i1 - if (.not. f_is_default(Re_inv)) coeffs(5, i1, i2) = -4d0*i2*Re_inv/rho - if (.not. f_is_default(Web)) coeffs(6, i1, i2) = -2d0*i2/Web/rho - coeffs(7, i1, i2) = 0d0 + if (.not. f_is_default(Re_inv)) coeffs(5, i1, i2) = -4._wp*i2*Re_inv/rho + if (.not. f_is_default(Web)) coeffs(6, i1, i2) = -2._wp*i2/Web/rho + coeffs(7, i1, i2) = 0._wp else if (bubble_model == 2) then ! KM with approximation of 1/(1-V/C) = 1+V/C - coeffs(1, i1, i2) = -3d0*i2/2d0 + coeffs(1, i1, i2) = -3._wp*i2/2._wp coeffs(2, i1, i2) = -i2/c - coeffs(3, i1, i2) = i2/(2d0*c*c) + coeffs(3, i1, i2) = i2/(2._wp*c*c) coeffs(4, i1, i2) = -i2*pres/rho - coeffs(5, i1, i2) = -2d0*i2*pres/(c*rho) + coeffs(5, i1, i2) = -2._wp*i2*pres/(c*rho) coeffs(6, i1, i2) = -i2*pres/(c*c*rho) coeffs(7, i1, i2) = i2/rho - coeffs(8, i1, i2) = 2d0*i2/(c*rho) + coeffs(8, i1, i2) = 2._wp*i2/(c*rho) coeffs(9, i1, i2) = i2/(c*c*rho) - coeffs(10, i1, i2) = -3d0*i2*gam/(c*rho) - coeffs(11, i1, i2) = -3d0*i2*gam/(c*c*rho) + coeffs(10, i1, i2) = -3._wp*i2*gam/(c*rho) + coeffs(11, i1, i2) = -3._wp*i2*gam/(c*c*rho) coeffs(12, i1, i2) = i1 - coeffs(13, i1, i2) = 0d0 - coeffs(14, i1, i2) = 0d0 - coeffs(15, i1, i2) = 0d0 - if (.not. f_is_default(Re_inv)) coeffs(16, i1, i2) = -i2*4d0*Re_inv/rho - if (.not. f_is_default(Web)) coeffs(17, i1, i2) = -i2*2d0/Web/rho + coeffs(13, i1, i2) = 0._wp + coeffs(14, i1, i2) = 0._wp + coeffs(15, i1, i2) = 0._wp + if (.not. f_is_default(Re_inv)) coeffs(16, i1, i2) = -i2*4._wp*Re_inv/rho + if (.not. f_is_default(Web)) coeffs(17, i1, i2) = -i2*2._wp/Web/rho if (.not. f_is_default(Re_inv)) then - coeffs(18, i1, i2) = i2*6d0*Re_inv/(rho*c) - coeffs(19, i1, i2) = -i2*2d0*Re_inv/(rho*c*c) - coeffs(20, i1, i2) = i2*4d0*pres*Re_inv/(rho*rho*c) - coeffs(21, i1, i2) = i2*4d0*pres*Re_inv/(rho*rho*c*c) - coeffs(22, i1, i2) = -i2*4d0/(rho*rho*c) - coeffs(23, i1, i2) = -i2*4d0/(rho*rho*c*c) - coeffs(24, i1, i2) = i2*16d0*Re_inv*Re_inv/(rho*rho*c) + coeffs(18, i1, i2) = i2*6._wp*Re_inv/(rho*c) + coeffs(19, i1, i2) = -i2*2._wp*Re_inv/(rho*c*c) + coeffs(20, i1, i2) = i2*4._wp*pres*Re_inv/(rho*rho*c) + coeffs(21, i1, i2) = i2*4._wp*pres*Re_inv/(rho*rho*c*c) + coeffs(22, i1, i2) = -i2*4._wp/(rho*rho*c) + coeffs(23, i1, i2) = -i2*4._wp/(rho*rho*c*c) + coeffs(24, i1, i2) = i2*16._wp*Re_inv*Re_inv/(rho*rho*c) if (.not. f_is_default(Web)) then - coeffs(25, i1, i2) = i2*8d0*Re_inv/Web/(rho*rho*c) + coeffs(25, i1, i2) = i2*8._wp*Re_inv/Web/(rho*rho*c) end if - coeffs(26, i1, i2) = -12d0*i2*gam*Re_inv/(rho*rho*c*c) + coeffs(26, i1, i2) = -12._wp*i2*gam*Re_inv/(rho*rho*c*c) end if - coeffs(27, i1, i2) = 3d0*i2*gam*R_v*Tw/(c*rho) - coeffs(28, i1, i2) = 3d0*i2*gam*R_v*Tw/(c*c*rho) + coeffs(27, i1, i2) = 3._wp*i2*gam*R_v*Tw/(c*rho) + coeffs(28, i1, i2) = 3._wp*i2*gam*R_v*Tw/(c*c*rho) if (.not. f_is_default(Re_inv)) then - coeffs(29, i1, i2) = 12d0*i2*gam*R_v*Tw*Re_inv/(rho*rho*c*c) + coeffs(29, i1, i2) = 12._wp*i2*gam*R_v*Tw*Re_inv/(rho*rho*c*c) end if - coeffs(30, i1, i2) = 3d0*i2*gam/(c*rho) - coeffs(31, i1, i2) = 3d0*i2*gam/(c*c*rho) + coeffs(30, i1, i2) = 3._wp*i2*gam/(c*rho) + coeffs(31, i1, i2) = 3._wp*i2*gam/(c*c*rho) if (.not. f_is_default(Re_inv)) then - coeffs(32, i1, i2) = 12d0*i2*gam*Re_inv/(rho*rho*c*c) + coeffs(32, i1, i2) = 12._wp*i2*gam*Re_inv/(rho*rho*c*c) end if end if end if @@ -773,55 +773,55 @@ contains !$acc routine seq #endif - real(kind(0.d0)), intent(inout) :: pres, rho, c - real(kind(0.d0)), dimension(nterms, 0:2, 0:2), intent(out) :: coeffs + real(wp), intent(inout) :: pres, rho, c + real(wp), dimension(nterms, 0:2, 0:2), intent(out) :: coeffs integer :: i1, i2, q - coeffs = 0d0 + coeffs = 0._wp do i2 = 0, 2; do i1 = 0, 2 if ((i1 + i2) <= 2) then if (bubble_model == 3) then ! RPE - coeffs(1, i1, i2) = -1d0*i2*pres/rho - coeffs(2, i1, i2) = -3d0*i2/2d0 + coeffs(1, i1, i2) = -1._wp*i2*pres/rho + coeffs(2, i1, i2) = -3._wp*i2/2._wp coeffs(3, i1, i2) = i2/rho coeffs(4, i1, i2) = i1 - if (.not. f_is_default(Re_inv)) coeffs(5, i1, i2) = -4d0*i2*Re_inv/rho - if (.not. f_is_default(Web)) coeffs(6, i1, i2) = -2d0*i2/Web/rho + if (.not. f_is_default(Re_inv)) coeffs(5, i1, i2) = -4._wp*i2*Re_inv/rho + if (.not. f_is_default(Web)) coeffs(6, i1, i2) = -2._wp*i2/Web/rho coeffs(7, i1, i2) = i2*pv/rho else if (bubble_model == 2) then ! KM with approximation of 1/(1-V/C) = 1+V/C - coeffs(1, i1, i2) = -3d0*i2/2d0 + coeffs(1, i1, i2) = -3._wp*i2/2._wp coeffs(2, i1, i2) = -i2/c - coeffs(3, i1, i2) = i2/(2d0*c*c) + coeffs(3, i1, i2) = i2/(2._wp*c*c) coeffs(4, i1, i2) = -i2*pres/rho - coeffs(5, i1, i2) = -2d0*i2*pres/(c*rho) + coeffs(5, i1, i2) = -2._wp*i2*pres/(c*rho) coeffs(6, i1, i2) = -i2*pres/(c*c*rho) coeffs(7, i1, i2) = i2/rho - coeffs(8, i1, i2) = 2d0*i2/(c*rho) + coeffs(8, i1, i2) = 2._wp*i2/(c*rho) coeffs(9, i1, i2) = i2/(c*c*rho) - coeffs(10, i1, i2) = -3d0*i2*gam/(c*rho) - coeffs(11, i1, i2) = -3d0*i2*gam/(c*c*rho) + coeffs(10, i1, i2) = -3._wp*i2*gam/(c*rho) + coeffs(11, i1, i2) = -3._wp*i2*gam/(c*c*rho) coeffs(12, i1, i2) = i1 coeffs(13, i1, i2) = i2*(pv)/rho - coeffs(14, i1, i2) = 2d0*i2*(pv)/(c*rho) + coeffs(14, i1, i2) = 2._wp*i2*(pv)/(c*rho) coeffs(15, i1, i2) = i2*(pv)/(c*c*rho) - if (.not. f_is_default(Re_inv)) coeffs(16, i1, i2) = -i2*4d0*Re_inv/rho - if (.not. f_is_default(Web)) coeffs(17, i1, i2) = -i2*2d0/Web/rho + if (.not. f_is_default(Re_inv)) coeffs(16, i1, i2) = -i2*4._wp*Re_inv/rho + if (.not. f_is_default(Web)) coeffs(17, i1, i2) = -i2*2._wp/Web/rho if (.not. f_is_default(Re_inv)) then - coeffs(18, i1, i2) = i2*6d0*Re_inv/(rho*c) - coeffs(19, i1, i2) = -i2*2d0*Re_inv/(rho*c*c) - coeffs(20, i1, i2) = i2*4d0*pres*Re_inv/(rho*rho*c) - coeffs(21, i1, i2) = i2*4d0*pres*Re_inv/(rho*rho*c*c) - coeffs(22, i1, i2) = -i2*4d0/(rho*rho*c) - coeffs(23, i1, i2) = -i2*4d0/(rho*rho*c*c) - coeffs(24, i1, i2) = i2*16d0*Re_inv*Re_inv/(rho*rho*c) + coeffs(18, i1, i2) = i2*6._wp*Re_inv/(rho*c) + coeffs(19, i1, i2) = -i2*2._wp*Re_inv/(rho*c*c) + coeffs(20, i1, i2) = i2*4._wp*pres*Re_inv/(rho*rho*c) + coeffs(21, i1, i2) = i2*4._wp*pres*Re_inv/(rho*rho*c*c) + coeffs(22, i1, i2) = -i2*4._wp/(rho*rho*c) + coeffs(23, i1, i2) = -i2*4._wp/(rho*rho*c*c) + coeffs(24, i1, i2) = i2*16._wp*Re_inv*Re_inv/(rho*rho*c) if (.not. f_is_default(Web)) then - coeffs(25, i1, i2) = i2*8d0*Re_inv/Web/(rho*rho*c) + coeffs(25, i1, i2) = i2*8._wp*Re_inv/Web/(rho*rho*c) end if - coeffs(26, i1, i2) = -12d0*i2*gam*Re_inv/(rho*rho*c*c) + coeffs(26, i1, i2) = -12._wp*i2*gam*Re_inv/(rho*rho*c*c) end if end if end if @@ -864,11 +864,11 @@ contains rho = q_prim_vf(contxb)%sf(id1, id2, id3) if (bubble_model == 2) then n_tait = gammas(1) - n_tait = 1.d0/n_tait + 1.d0 !make this the usual little 'gamma' + n_tait = 1._wp/n_tait + 1._wp !make this the usual little 'gamma' B_tait = pi_infs(1)*(n_tait - 1)/n_tait - c = n_tait*(pres + B_tait)*(1d0 - alf)/(rho) + c = n_tait*(pres + B_tait)*(1._wp - alf)/(rho) - if (c > 0.d0) then + if (c > 0._wp) then c = DSQRT(c) else c = sgm_eps @@ -882,7 +882,7 @@ contains end if ! SHB: Manually adjusted pressure here for no-coupling case - ! pres = 1d0/0.3d0 + ! pres = 1._wp/0.3_wp if (alf > small_alf) then nbub = q_cons_vf(bubxb)%sf(id1, id2, id3) @@ -895,7 +895,7 @@ contains moms(r) = q_prim_vf(bubmoms(q, r))%sf(id1, id2, id3) end do - moms(1) = 1d0 + moms(1) = 1._wp call s_chyqmom(moms, wght(:, q), abscX(:, q), abscY(:, q)) @@ -909,13 +909,13 @@ contains !Account for bubble pressure, mass transfer rate and heat transfer rate in wght_pb, wght_mv and wght_ht using Preston model !$acc loop seq do j = 1, nnode - chi_vw = 1.d0/(1.d0 + R_v/R_n*(pb(id1, id2, id3, j, q)/pv - 1.d0)) + chi_vw = 1._wp/(1._wp + R_v/R_n*(pb(id1, id2, id3, j, q)/pv - 1._wp)) x_vw = M_n*chi_vw/(M_v + (M_n - M_v)*chi_vw) - k_mw = x_vw*k_v(q)/(x_vw + (1.d0 - x_vw)*phi_vn) & - + (1.d0 - x_vw)*k_n(q)/(x_vw*phi_nv + 1.d0 - x_vw) + k_mw = x_vw*k_v(q)/(x_vw + (1._wp - x_vw)*phi_vn) & + + (1._wp - x_vw)*k_n(q)/(x_vw*phi_nv + 1._wp - x_vw) rho_mw = pv/(chi_vw*R_v*Tw) rhs_mv(id1, id2, id3, j, q) = -Re_trans_c(q)*((mv(id1, id2, id3, j, q)/(mv(id1, id2, id3, j, q) + mass_n0(q))) - chi_vw) - rhs_mv(id1, id2, id3, j, q) = rho_mw*rhs_mv(id1, id2, id3, j, q)/Pe_c/(1.d0 - chi_vw)/abscX(j, q) + rhs_mv(id1, id2, id3, j, q) = rho_mw*rhs_mv(id1, id2, id3, j, q)/Pe_c/(1._wp - chi_vw)/abscX(j, q) T_bar = Tw*(pb(id1, id2, id3, j, q)/pb0(q))*(abscX(j, q)/R0(q))**3 & *(mass_n0(q) + mass_v0(q))/(mass_n0(q) + mv(id1, id2, id3, j, q)) @@ -935,7 +935,7 @@ contains !$acc loop seq do i1 = 0, 2 if ((i1 + i2) <= 2) then - momsum = 0d0 + momsum = 0._wp !$acc loop seq do j = 1, nterms ! Account for term with pb in Rayleigh Plesset equation @@ -975,48 +975,48 @@ contains do j = 1, nnode ! Compute Rdot (drdt) at quadrature node in the ODE for pb (note this is not the same as bubble variable Rdot) drdt = msum(2) - if (moms(4) - moms(2)**2d0 > 0d0) then + if (moms(4) - moms(2)**2._wp > 0._wp) then if (j == 1 .or. j == 2) then - drdt2 = -1d0/(2d0*dsqrt(moms(4) - moms(2)**2d0)) + drdt2 = -1._wp/(2._wp*dsqrt(moms(4) - moms(2)**2._wp)) else - drdt2 = 1d0/(2d0*dsqrt(moms(4) - moms(2)**2d0)) + drdt2 = 1._wp/(2._wp*dsqrt(moms(4) - moms(2)**2._wp)) end if else ! Edge case where variance < 0 if (j == 1 .or. j == 2) then - drdt2 = -1d0/(2d0*dsqrt(verysmall)) + drdt2 = -1._wp/(2._wp*dsqrt(verysmall)) else - drdt2 = 1d0/(2d0*dsqrt(verysmall)) + drdt2 = 1._wp/(2._wp*dsqrt(verysmall)) end if end if - drdt2 = drdt2*(msum(3) - 2d0*moms(2)*msum(2)) + drdt2 = drdt2*(msum(3) - 2._wp*moms(2)*msum(2)) drdt = drdt + drdt2 - rhs_pb(id1, id2, id3, j, q) = (-3d0*gam*drdt/abscX(j, q))*(pb(id1, id2, id3, j, q)) - rhs_pb(id1, id2, id3, j, q) = rhs_pb(id1, id2, id3, j, q) + (3d0*gam/abscX(j, q))*rhs_mv(id1, id2, id3, j, q)*R_v*Tw - rhs_pb(id1, id2, id3, j, q) = rhs_pb(id1, id2, id3, j, q) + (3d0*gam/abscX(j, q))*ht(j, q) - rhs_mv(id1, id2, id3, j, q) = rhs_mv(id1, id2, id3, j, q)*(4d0*pi*abscX(j, q)**2d0) + rhs_pb(id1, id2, id3, j, q) = (-3._wp*gam*drdt/abscX(j, q))*(pb(id1, id2, id3, j, q)) + rhs_pb(id1, id2, id3, j, q) = rhs_pb(id1, id2, id3, j, q) + (3._wp*gam/abscX(j, q))*rhs_mv(id1, id2, id3, j, q)*R_v*Tw + rhs_pb(id1, id2, id3, j, q) = rhs_pb(id1, id2, id3, j, q) + (3._wp*gam/abscX(j, q))*ht(j, q) + rhs_mv(id1, id2, id3, j, q) = rhs_mv(id1, id2, id3, j, q)*(4._wp*pi*abscX(j, q)**2._wp) end do end if end do ! Compute special high-order moments - momsp(1)%sf(id1, id2, id3) = f_quad(abscX, abscY, wght, 3d0, 0d0, 0d0) - momsp(2)%sf(id1, id2, id3) = 4.d0*pi*nbub*f_quad(abscX, abscY, wght, 2d0, 1d0, 0d0) - momsp(3)%sf(id1, id2, id3) = f_quad(abscX, abscY, wght, 3d0, 2d0, 0d0) - if (abs(gam - 1.d0) <= 1.d-4) then + momsp(1)%sf(id1, id2, id3) = f_quad(abscX, abscY, wght, 3._wp, 0._wp, 0._wp) + momsp(2)%sf(id1, id2, id3) = 4._wp*pi*nbub*f_quad(abscX, abscY, wght, 2._wp, 1._wp, 0._wp) + momsp(3)%sf(id1, id2, id3) = f_quad(abscX, abscY, wght, 3._wp, 2._wp, 0._wp) + if (abs(gam - 1._wp) <= 1.d-4) then ! Gam \approx 1, don't risk imaginary quadrature - momsp(4)%sf(id1, id2, id3) = 1.d0 + momsp(4)%sf(id1, id2, id3) = 1._wp else !Special moment with bubble pressure pb if (polytropic) then - momsp(4)%sf(id1, id2, id3) = f_quad(abscX, abscY, wght_pb, 3d0*(1d0 - gam), 0d0, 3d0*gam) + pv*f_quad(abscX, abscY, wght, 3d0, 0d0, 0d0) & - - 4d0*Re_inv*f_quad(abscX, abscY, wght, 2d0, 1d0, 0d0) - (2d0/Web)*f_quad(abscX, abscY, wght, 2d0, 0d0, 0d0) + momsp(4)%sf(id1, id2, id3) = f_quad(abscX, abscY, wght_pb, 3._wp*(1._wp - gam), 0._wp, 3._wp*gam) + pv*f_quad(abscX, abscY, wght, 3._wp, 0._wp, 0._wp) & + - 4._wp*Re_inv*f_quad(abscX, abscY, wght, 2._wp, 1._wp, 0._wp) - (2._wp/Web)*f_quad(abscX, abscY, wght, 2._wp, 0._wp, 0._wp) else - momsp(4)%sf(id1, id2, id3) = f_quad(abscX, abscY, wght_pb, 3d0, 0d0, 0d0) & - - 4d0*Re_inv*f_quad(abscX, abscY, wght, 2d0, 1d0, 0d0) - (2d0/Web)*f_quad(abscX, abscY, wght, 2d0, 0d0, 0d0) + momsp(4)%sf(id1, id2, id3) = f_quad(abscX, abscY, wght_pb, 3._wp, 0._wp, 0._wp) & + - 4._wp*Re_inv*f_quad(abscX, abscY, wght, 2._wp, 1._wp, 0._wp) - (2._wp/Web)*f_quad(abscX, abscY, wght, 2._wp, 0._wp, 0._wp) end if end if @@ -1027,15 +1027,15 @@ contains do i1 = 0, 2 !$acc loop seq do i2 = 0, 2 - moms3d(i1, i2, q)%sf(id1, id2, id3) = 0d0 + moms3d(i1, i2, q)%sf(id1, id2, id3) = 0._wp end do end do end do - momsp(1)%sf(id1, id2, id3) = 0d0 - momsp(2)%sf(id1, id2, id3) = 0d0 - momsp(3)%sf(id1, id2, id3) = 0d0 - momsp(4)%sf(id1, id2, id3) = 0d0 + momsp(1)%sf(id1, id2, id3) = 0._wp + momsp(2)%sf(id1, id2, id3) = 0._wp + momsp(3)%sf(id1, id2, id3) = 0._wp + momsp(4)%sf(id1, id2, id3) = 0._wp end if @@ -1073,18 +1073,18 @@ contains d11 = moms(1, 1)/moms(0, 0) d02 = moms(0, 2)/moms(0, 0) - c20 = d20 - bu**2d0; + c20 = d20 - bu**2._wp; c11 = d11 - bu*bv; - c02 = d02 - bv**2d0; - M1 = (/1d0, 0d0, c20/) + c02 = d02 - bv**2._wp; + M1 = (/1._wp, 0._wp, c20/) call s_hyqmom(myrho, up, M1) Vf = c11*up/c20 - mu2avg = c02 - sum(myrho(:)*(Vf(:)**2d0)) + mu2avg = c02 - sum(myrho(:)*(Vf(:)**2._wp)) - mu2avg = maxval((/mu2avg, 0d0/)) + mu2avg = maxval((/mu2avg, 0._wp/)) mu2 = mu2avg - M3 = (/1d0, 0d0, mu2/) + M3 = (/1._wp, 0._wp, mu2/) call s_hyqmom(myrho3, up3, M3) vp21 = up3(1) @@ -1125,9 +1125,9 @@ contains bu = fmom(2)/fmom(1) d2 = fmom(3)/fmom(1) - c2 = d2 - bu**2d0 - frho(1) = fmom(1)/2d0; - frho(2) = fmom(1)/2d0; + c2 = d2 - bu**2._wp + frho(1) = fmom(1)/2._wp; + frho(2) = fmom(1)/2._wp; c2 = maxval((/c2, verysmall/)) fup(1) = bu - DSQRT(c2) fup(2) = bu + DSQRT(c2) @@ -1136,13 +1136,13 @@ contains function f_quad(abscX, abscY, wght_in, q, r, s) !$acc routine seq - real(kind(0.d0)), dimension(nnode, nb), intent(in) :: abscX, abscY, wght_in - real(kind(0.d0)), intent(in) :: q, r, s + real(wp), dimension(nnode, nb), intent(in) :: abscX, abscY, wght_in + real(wp), intent(in) :: q, r, s - real(kind(0.d0)) :: f_quad_RV, f_quad + real(wp) :: f_quad_RV, f_quad integer :: i - f_quad = 0d0 + f_quad = 0._wp do i = 1, nb f_quad_RV = sum(wght_in(:, i)*(abscX(:, i)**q)*(abscY(:, i)**r)) f_quad = f_quad + weight(i)*(R0(i)**s)*f_quad_RV @@ -1152,10 +1152,10 @@ contains function f_quad2D(abscX, abscY, wght_in, pow) !$acc routine seq - real(kind(0.d0)), dimension(nnode), intent(in) :: abscX, abscY, wght_in - real(kind(0.d0)), dimension(3), intent(in) :: pow + real(wp), dimension(nnode), intent(in) :: abscX, abscY, wght_in + real(wp), dimension(3), intent(in) :: pow - real(kind(0.d0)) :: f_quad2D + real(wp) :: f_quad2D f_quad2D = sum(wght_in(:)*(abscX(:)**pow(1))*(abscY(:)**pow(2))) end function f_quad2D diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index e56bef26fb..2218b98fdd 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -651,8 +651,8 @@ contains @:ALLOCATE_GLOBAL(gamma_min(1:num_fluids), pres_inf(1:num_fluids)) do i = 1, num_fluids - gamma_min(i) = 1d0/fluid_pp(i)%gamma + 1d0 - pres_inf(i) = fluid_pp(i)%pi_inf/(1d0 + fluid_pp(i)%gamma) + gamma_min(i) = 1._wp/fluid_pp(i)%gamma + 1._wp + pres_inf(i) = fluid_pp(i)%pi_inf/(1._wp + fluid_pp(i)%gamma) end do !$acc update device(gamma_min, pres_inf) @@ -696,7 +696,7 @@ contains do l = startz, p - startz do k = starty, n - starty do j = startx, m - startx - flux_gsrc_n(id)%vf(i)%sf(j, k, l) = 0d0 + flux_gsrc_n(id)%vf(i)%sf(j, k, l) = 0._wp end do end do end do @@ -771,7 +771,7 @@ contains if (chemistry) then !$acc parallel loop default(present) do i = chemxb, chemxe - rhs_vf(i)%sf(:, :, :) = 0d0 + rhs_vf(i)%sf(:, :, :) = 0._wp end do end if @@ -784,14 +784,14 @@ contains do l = iz%beg, iz%end do k = iy%beg, iy%end do j = ix%beg, ix%end - alf_sum%sf(j, k, l) = 0d0 + alf_sum%sf(j, k, l) = 0._wp !$acc loop seq do i = advxb, advxe - 1 alf_sum%sf(j, k, l) = alf_sum%sf(j, k, l) + q_cons_qp%vf(i)%sf(j, k, l) end do !$acc loop seq do i = advxb, advxe - 1 - q_cons_qp%vf(i)%sf(j, k, l) = q_cons_qp%vf(i)%sf(j, k, l)*(1.d0 - q_cons_qp%vf(alf_idx)%sf(j, k, l)) & + q_cons_qp%vf(i)%sf(j, k, l) = q_cons_qp%vf(i)%sf(j, k, l)*(1._wp - q_cons_qp%vf(alf_idx)%sf(j, k, l)) & /alf_sum%sf(j, k, l) end do end do @@ -964,7 +964,7 @@ contains ! RHS additions for viscosity call nvtxStartRange("RHS_add_phys") - if (any(Re_size > 0d0) .or. (.not. f_is_default(sigma))) then + if (any(Re_size > 0._wp) .or. (.not. f_is_default(sigma))) then call s_compute_additional_physics_rhs(id, & q_prim_qp%vf, & rhs_vf, & @@ -1026,7 +1026,7 @@ contains do j = 0, m if (ib_markers%sf(j, k, l) /= 0) then do i = 1, sys_size - rhs_vf(i)%sf(j, k, l) = 0d0 + rhs_vf(i)%sf(j, k, l) = 0._wp end do end if end do @@ -1085,7 +1085,7 @@ contains if (t_step >= 4) then time_avg = (abs(t_finish - t_start) + (t_step - 4)*time_avg)/(t_step - 3) else - time_avg = 0d0 + time_avg = 0._wp end if ! ================================================================== @@ -1107,9 +1107,9 @@ contains do l = 0, p do k = 0, n do j = 0, m - blkmod1(j, k, l) = ((gammas(1) + 1d0)*q_prim_vf%vf(E_idx)%sf(j, k, l) + & + blkmod1(j, k, l) = ((gammas(1) + 1._wp)*q_prim_vf%vf(E_idx)%sf(j, k, l) + & pi_infs(1))/gammas(1) - blkmod2(j, k, l) = ((gammas(2) + 1d0)*q_prim_vf%vf(E_idx)%sf(j, k, l) + & + blkmod2(j, k, l) = ((gammas(2) + 1._wp)*q_prim_vf%vf(E_idx)%sf(j, k, l) + & pi_infs(2))/gammas(2) alpha1(j, k, l) = q_cons_vf%vf(advxb)%sf(j, k, l) @@ -1143,7 +1143,7 @@ contains do q = 0, p do l = 0, n do k = 0, m - rhs_vf(j)%sf(k, l, q) = 1d0/dx(k)* & + rhs_vf(j)%sf(k, l, q) = 1._wp/dx(k)* & (flux_n(1)%vf(j)%sf(k - 1, l, q) & - flux_n(1)%vf(j)%sf(k, l, q)) end do @@ -1158,7 +1158,7 @@ contains do j = 0, m do i = 1, num_fluids rhs_vf(i + intxb - 1)%sf(j, k, l) = & - rhs_vf(i + intxb - 1)%sf(j, k, l) - 1d0/dx(j)* & + rhs_vf(i + intxb - 1)%sf(j, k, l) - 1._wp/dx(j)* & q_cons_vf%vf(i + advxb - 1)%sf(j, k, l)* & q_prim_vf%vf(E_idx)%sf(j, k, l)* & (flux_src_n(1)%vf(advxb)%sf(j, k, l) - & @@ -1176,7 +1176,7 @@ contains do l = 0, n do k = 0, m rhs_vf(j)%sf(k, l, q) = & - rhs_vf(j)%sf(k, l, q) + 1d0/dx(k)* & + rhs_vf(j)%sf(k, l, q) + 1._wp/dx(k)* & q_prim_vf%vf(contxe + idir)%sf(k, l, q)* & (flux_src_n(1)%vf(j)%sf(k - 1, l, q) & - flux_src_n(1)%vf(j)%sf(k, l, q)) @@ -1193,7 +1193,7 @@ contains do l = 0, n do k = 0, m rhs_vf(j)%sf(k, l, q) = & - rhs_vf(j)%sf(k, l, q) + 1d0/dx(k)* & + rhs_vf(j)%sf(k, l, q) + 1._wp/dx(k)* & (q_cons_vf%vf(j)%sf(k, l, q) - Kterm(k, l, q))* & (flux_src_n(1)%vf(j)%sf(k, l, q) & - flux_src_n(1)%vf(j)%sf(k - 1, l, q)) @@ -1206,7 +1206,7 @@ contains do l = 0, n do k = 0, m rhs_vf(j)%sf(k, l, q) = & - rhs_vf(j)%sf(k, l, q) + 1d0/dx(k)* & + rhs_vf(j)%sf(k, l, q) + 1._wp/dx(k)* & (q_cons_vf%vf(j)%sf(k, l, q) + Kterm(k, l, q))* & (flux_src_n(1)%vf(j)%sf(k, l, q) & - flux_src_n(1)%vf(j)%sf(k - 1, l, q)) @@ -1222,7 +1222,7 @@ contains do l = 0, n do k = 0, m rhs_vf(j)%sf(k, l, q) = & - rhs_vf(j)%sf(k, l, q) + 1d0/dx(k)* & + rhs_vf(j)%sf(k, l, q) + 1._wp/dx(k)* & q_cons_vf%vf(j)%sf(k, l, q)* & (flux_src_n(1)%vf(j)%sf(k, l, q) & - flux_src_n(1)%vf(j)%sf(k - 1, l, q)) @@ -1253,7 +1253,7 @@ contains do k = 0, n do q = 0, m rhs_vf(j)%sf(q, k, l) = & - rhs_vf(j)%sf(q, k, l) + 1d0/dy(k)* & + rhs_vf(j)%sf(q, k, l) + 1._wp/dy(k)* & (flux_n(2)%vf(j)%sf(q, k - 1, l) & - flux_n(2)%vf(j)%sf(q, k, l)) end do @@ -1268,7 +1268,7 @@ contains do j = 0, m do i = 1, num_fluids rhs_vf(i + intxb - 1)%sf(j, k, l) = & - rhs_vf(i + intxb - 1)%sf(j, k, l) - 1d0/dy(k)* & + rhs_vf(i + intxb - 1)%sf(j, k, l) - 1._wp/dy(k)* & q_cons_vf%vf(i + advxb - 1)%sf(j, k, l)* & q_prim_vf%vf(E_idx)%sf(j, k, l)* & (flux_src_n(2)%vf(advxb)%sf(j, k, l) - & @@ -1320,7 +1320,7 @@ contains do k = 0, n do q = 0, m rhs_vf(j)%sf(q, k, l) = & - rhs_vf(j)%sf(q, k, l) + 1d0/dy(k)* & + rhs_vf(j)%sf(q, k, l) + 1._wp/dy(k)* & q_prim_vf%vf(contxe + idir)%sf(q, k, l)* & (flux_src_n(2)%vf(j)%sf(q, k - 1, l) & - flux_src_n(2)%vf(j)%sf(q, k, l)) @@ -1338,7 +1338,7 @@ contains do k = 0, n do q = 0, m rhs_vf(j)%sf(q, k, l) = & - rhs_vf(j)%sf(q, k, l) + 1d0/dy(k)* & + rhs_vf(j)%sf(q, k, l) + 1._wp/dy(k)* & (q_cons_vf%vf(j)%sf(q, k, l) - Kterm(q, k, l))* & (flux_src_n(2)%vf(j)%sf(q, k, l) & - flux_src_n(2)%vf(j)%sf(q, k - 1, l)) @@ -1352,7 +1352,7 @@ contains do q = 0, m rhs_vf(j)%sf(q, k, l) = & rhs_vf(j)%sf(q, k, l) - & - (Kterm(q, k, l)/2d0/y_cc(k))* & + (Kterm(q, k, l)/2._wp/y_cc(k))* & (flux_src_n(2)%vf(j)%sf(q, k, l) & + flux_src_n(2)%vf(j)%sf(q, k - 1, l)) end do @@ -1365,7 +1365,7 @@ contains do k = 0, n do q = 0, m rhs_vf(j)%sf(q, k, l) = & - rhs_vf(j)%sf(q, k, l) + 1d0/dy(k)* & + rhs_vf(j)%sf(q, k, l) + 1._wp/dy(k)* & (q_cons_vf%vf(j)%sf(q, k, l) + Kterm(q, k, l))* & (flux_src_n(2)%vf(j)%sf(q, k, l) & - flux_src_n(2)%vf(j)%sf(q, k - 1, l)) @@ -1379,7 +1379,7 @@ contains do q = 0, m rhs_vf(j)%sf(q, k, l) = & rhs_vf(j)%sf(q, k, l) + & - (Kterm(q, k, l)/2d0/y_cc(k))* & + (Kterm(q, k, l)/2._wp/y_cc(k))* & (flux_src_n(2)%vf(j)%sf(q, k, l) & + flux_src_n(2)%vf(j)%sf(q, k - 1, l)) end do @@ -1395,7 +1395,7 @@ contains do k = 0, n do q = 0, m rhs_vf(j)%sf(q, k, l) = & - rhs_vf(j)%sf(q, k, l) + 1d0/dy(k)* & + rhs_vf(j)%sf(q, k, l) + 1._wp/dy(k)* & q_cons_vf%vf(j)%sf(q, k, l)* & (flux_src_n(2)%vf(j)%sf(q, k, l) & - flux_src_n(2)%vf(j)%sf(q, k - 1, l)) @@ -1428,7 +1428,7 @@ contains do q = 0, n do l = 0, m rhs_vf(j)%sf(l, q, k) = & - rhs_vf(j)%sf(l, q, k) + 1d0/dz(k)/y_cc(q)* & + rhs_vf(j)%sf(l, q, k) + 1._wp/dz(k)/y_cc(q)* & q_prim_vf%vf(contxe + idir)%sf(l, q, k)* & (flux_n(3)%vf(j)%sf(l, q, k - 1) & - flux_n(3)%vf(j)%sf(l, q, k)) @@ -1458,7 +1458,7 @@ contains do q = 0, n do l = 0, m rhs_vf(j)%sf(l, q, k) = & - rhs_vf(j)%sf(l, q, k) + 1d0/dz(k)* & + rhs_vf(j)%sf(l, q, k) + 1._wp/dz(k)* & (flux_n(3)%vf(j)%sf(l, q, k - 1) & - flux_n(3)%vf(j)%sf(l, q, k)) end do @@ -1474,7 +1474,7 @@ contains do j = 0, m do i = 1, num_fluids rhs_vf(i + intxb - 1)%sf(j, k, l) = & - rhs_vf(i + intxb - 1)%sf(j, k, l) - 1d0/dz(l)* & + rhs_vf(i + intxb - 1)%sf(j, k, l) - 1._wp/dz(l)* & q_cons_vf%vf(i + advxb - 1)%sf(j, k, l)* & q_prim_vf%vf(E_idx)%sf(j, k, l)* & (flux_src_n(3)%vf(advxb)%sf(j, k, l) - & @@ -1493,7 +1493,7 @@ contains do k = 0, n do q = 0, m rhs_vf(j)%sf(q, k, l) = & - rhs_vf(j)%sf(q, k, l) + 1d0/dy(k)* & + rhs_vf(j)%sf(q, k, l) + 1._wp/dy(k)* & q_prim_vf%vf(contxe + idir)%sf(q, k, l)* & (flux_src_n(2)%vf(j)%sf(q, k - 1, l) & - flux_src_n(2)%vf(j)%sf(q, k, l)) @@ -1511,7 +1511,7 @@ contains do k = 0, n do q = 0, m rhs_vf(j)%sf(q, k, l) = & - rhs_vf(j)%sf(q, k, l) + 1d0/dy(k)* & + rhs_vf(j)%sf(q, k, l) + 1._wp/dy(k)* & (q_cons_vf%vf(j)%sf(q, k, l) - Kterm(q, k, l))* & (flux_src_n(2)%vf(j)%sf(q, k, l) & - flux_src_n(2)%vf(j)%sf(q, k - 1, l)) @@ -1525,7 +1525,7 @@ contains do q = 0, m rhs_vf(j)%sf(q, k, l) = & rhs_vf(j)%sf(q, k, l) - & - (Kterm(q, k, l)/2d0/y_cc(k))* & + (Kterm(q, k, l)/2._wp/y_cc(k))* & (flux_src_n(2)%vf(j)%sf(q, k, l) & + flux_src_n(2)%vf(j)%sf(q, k - 1, l)) end do @@ -1538,7 +1538,7 @@ contains do k = 0, n do q = 0, m rhs_vf(j)%sf(q, k, l) = & - rhs_vf(j)%sf(q, k, l) + 1d0/dy(k)* & + rhs_vf(j)%sf(q, k, l) + 1._wp/dy(k)* & (q_cons_vf%vf(j)%sf(q, k, l) + Kterm(q, k, l))* & (flux_src_n(2)%vf(j)%sf(q, k, l) & - flux_src_n(2)%vf(j)%sf(q, k - 1, l)) @@ -1552,7 +1552,7 @@ contains do q = 0, m rhs_vf(j)%sf(q, k, l) = & rhs_vf(j)%sf(q, k, l) + & - (Kterm(q, k, l)/2d0/y_cc(k))* & + (Kterm(q, k, l)/2._wp/y_cc(k))* & (flux_src_n(2)%vf(j)%sf(q, k, l) & + flux_src_n(2)%vf(j)%sf(q, k - 1, l)) end do @@ -1568,7 +1568,7 @@ contains do k = 0, n do q = 0, m rhs_vf(j)%sf(q, k, l) = & - rhs_vf(j)%sf(q, k, l) + 1d0/dy(k)* & + rhs_vf(j)%sf(q, k, l) + 1._wp/dy(k)* & q_cons_vf%vf(j)%sf(q, k, l)* & (flux_src_n(2)%vf(j)%sf(q, k, l) & - flux_src_n(2)%vf(j)%sf(q, k - 1, l)) @@ -1586,7 +1586,7 @@ contains do q = 0, n do l = 0, m rhs_vf(j)%sf(l, q, k) = & - rhs_vf(j)%sf(l, q, k) + 1d0/dz(k)* & + rhs_vf(j)%sf(l, q, k) + 1._wp/dz(k)* & q_prim_vf%vf(contxe + idir)%sf(l, q, k)* & (flux_src_n(3)%vf(j)%sf(l, q, k - 1) & - flux_src_n(3)%vf(j)%sf(l, q, k)) @@ -1603,7 +1603,7 @@ contains do q = 0, n do l = 0, m rhs_vf(j)%sf(l, q, k) = & - rhs_vf(j)%sf(l, q, k) + 1d0/dz(k)* & + rhs_vf(j)%sf(l, q, k) + 1._wp/dz(k)* & (q_cons_vf%vf(j)%sf(l, q, k) - Kterm(l, q, k))* & (flux_src_n(3)%vf(j)%sf(l, q, k) & - flux_src_n(3)%vf(j)%sf(l, q, k - 1)) @@ -1616,7 +1616,7 @@ contains do q = 0, n do l = 0, m rhs_vf(j)%sf(l, q, k) = & - rhs_vf(j)%sf(l, q, k) + 1d0/dz(k)* & + rhs_vf(j)%sf(l, q, k) + 1._wp/dz(k)* & (q_cons_vf%vf(j)%sf(l, q, k) + Kterm(l, q, k))* & (flux_src_n(3)%vf(j)%sf(l, q, k) & - flux_src_n(3)%vf(j)%sf(l, q, k - 1)) @@ -1632,7 +1632,7 @@ contains do q = 0, n do l = 0, m rhs_vf(j)%sf(l, q, k) = & - rhs_vf(j)%sf(l, q, k) + 1d0/dz(k)* & + rhs_vf(j)%sf(l, q, k) + 1._wp/dz(k)* & q_cons_vf%vf(j)%sf(l, q, k)* & (flux_src_n(3)%vf(j)%sf(l, q, k) & - flux_src_n(3)%vf(j)%sf(l, q, k - 1)) @@ -1667,7 +1667,7 @@ contains do k = 0, n do j = 0, m rhs_vf(c_idx)%sf(j, k, l) = & - rhs_vf(c_idx)%sf(j, k, l) + 1d0/dx(j)* & + rhs_vf(c_idx)%sf(j, k, l) + 1._wp/dx(j)* & q_prim_vf(c_idx)%sf(j, k, l)* & (flux_src_n(advxb)%sf(j, k, l) - & flux_src_n(advxb)%sf(j - 1, k, l)) @@ -1683,7 +1683,7 @@ contains !$acc loop seq do i = momxb, E_idx rhs_vf(i)%sf(j, k, l) = & - rhs_vf(i)%sf(j, k, l) + 1d0/dx(j)* & + rhs_vf(i)%sf(j, k, l) + 1._wp/dx(j)* & (flux_src_n(i)%sf(j - 1, k, l) & - flux_src_n(i)%sf(j, k, l)) end do @@ -1699,7 +1699,7 @@ contains do k = 0, n do j = 0, m rhs_vf(c_idx)%sf(j, k, l) = & - rhs_vf(c_idx)%sf(j, k, l) + 1d0/dy(k)* & + rhs_vf(c_idx)%sf(j, k, l) + 1._wp/dy(k)* & q_prim_vf(c_idx)%sf(j, k, l)* & (flux_src_n(advxb)%sf(j, k, l) - & flux_src_n(advxb)%sf(j, k - 1, l)) @@ -1732,7 +1732,7 @@ contains !$acc loop seq do i = momxb, E_idx rhs_vf(i)%sf(j, 0, l) = & - rhs_vf(i)%sf(j, 0, l) + 1d0/(y_cc(1) - y_cc(-1))* & + rhs_vf(i)%sf(j, 0, l) + 1._wp/(y_cc(1) - y_cc(-1))* & (tau_Re_vf(i)%sf(j, -1, l) & - tau_Re_vf(i)%sf(j, 1, l)) end do @@ -1748,7 +1748,7 @@ contains !$acc loop seq do i = momxb, E_idx rhs_vf(i)%sf(j, k, l) = & - rhs_vf(i)%sf(j, k, l) + 1d0/dy(k)* & + rhs_vf(i)%sf(j, k, l) + 1._wp/dy(k)* & (flux_src_n(i)%sf(j, k - 1, l) & - flux_src_n(i)%sf(j, k, l)) end do @@ -1764,7 +1764,7 @@ contains !$acc loop seq do i = momxb, E_idx rhs_vf(i)%sf(j, k, l) = & - rhs_vf(i)%sf(j, k, l) + 1d0/dy(k)* & + rhs_vf(i)%sf(j, k, l) + 1._wp/dy(k)* & (flux_src_n(i)%sf(j, k - 1, l) & - flux_src_n(i)%sf(j, k, l)) end do @@ -1800,7 +1800,7 @@ contains !$acc loop seq do i = momxb, E_idx rhs_vf(i)%sf(j, 0, l) = & - rhs_vf(i)%sf(j, 0, l) - 1d0/y_cc(0)* & + rhs_vf(i)%sf(j, 0, l) - 1._wp/y_cc(0)* & tau_Re_vf(i)%sf(j, 0, l) end do end do @@ -1834,7 +1834,7 @@ contains do k = 0, n do j = 0, m rhs_vf(c_idx)%sf(j, k, l) = & - rhs_vf(c_idx)%sf(j, k, l) + 1d0/dz(l)* & + rhs_vf(c_idx)%sf(j, k, l) + 1._wp/dz(l)* & q_prim_vf(c_idx)%sf(j, k, l)* & (flux_src_n(advxb)%sf(j, k, l) - & flux_src_n(advxb)%sf(j, k, l - 1)) @@ -1850,7 +1850,7 @@ contains !$acc loop seq do i = momxb, E_idx rhs_vf(i)%sf(j, k, l) = & - rhs_vf(i)%sf(j, k, l) + 1d0/dz(l)* & + rhs_vf(i)%sf(j, k, l) + 1._wp/dz(l)* & (flux_src_n(i)%sf(j, k, l - 1) & - flux_src_n(i)%sf(j, k, l)) end do @@ -1921,19 +1921,19 @@ contains ! Numerical correction of the volume fractions if (mpp_lim) then - sum_alpha = 0d0 + sum_alpha = 0._wp !$acc loop seq do i = 1, num_fluids - if ((q_cons_vf(i + contxb - 1)%sf(j, k, l) < 0d0) .or. & - (q_cons_vf(i + advxb - 1)%sf(j, k, l) < 0d0)) then - q_cons_vf(i + contxb - 1)%sf(j, k, l) = 0d0 - q_cons_vf(i + advxb - 1)%sf(j, k, l) = 0d0 - q_cons_vf(i + intxb - 1)%sf(j, k, l) = 0d0 + if ((q_cons_vf(i + contxb - 1)%sf(j, k, l) < 0._wp) .or. & + (q_cons_vf(i + advxb - 1)%sf(j, k, l) < 0._wp)) then + q_cons_vf(i + contxb - 1)%sf(j, k, l) = 0._wp + q_cons_vf(i + advxb - 1)%sf(j, k, l) = 0._wp + q_cons_vf(i + intxb - 1)%sf(j, k, l) = 0._wp end if - if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > 1d0) & - q_cons_vf(i + advxb - 1)%sf(j, k, l) = 1d0 + if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > 1._wp) & + q_cons_vf(i + advxb - 1)%sf(j, k, l) = 1._wp sum_alpha = sum_alpha + q_cons_vf(i + advxb - 1)%sf(j, k, l) end do @@ -1950,12 +1950,12 @@ contains !$acc loop seq do i = 1, num_fluids - if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > (1d0 - sgm_eps)) relax = 0 + if (q_cons_vf(i + advxb - 1)%sf(j, k, l) > (1._wp - sgm_eps)) relax = 0 end do if (relax == 1) then ! Initial state - pres_relax = 0d0 + pres_relax = 0._wp !$acc loop seq do i = 1, num_fluids @@ -1965,10 +1965,10 @@ contains q_cons_vf(i + advxb - 1)%sf(j, k, l) & - pi_infs(i))/gammas(i) - if (pres_K_init(i) <= -(1d0 - 1d-8)*pres_inf(i) + 1d-8) & - pres_K_init(i) = -(1d0 - 1d-8)*pres_inf(i) + 1d-8 + if (pres_K_init(i) <= -(1._wp - 1d-8)*pres_inf(i) + 1d-8) & + pres_K_init(i) = -(1._wp - 1d-8)*pres_inf(i) + 1d-8 else - pres_K_init(i) = 0d0 + pres_K_init(i) = 0._wp end if pres_relax = pres_relax + q_cons_vf(i + advxb - 1)%sf(j, k, l)*pres_K_init(i) end do @@ -1979,7 +1979,7 @@ contains !$acc loop seq do i = 1, num_fluids - rho_K_s(i) = 0d0 + rho_K_s(i) = 0._wp end do !$acc loop seq @@ -1990,13 +1990,13 @@ contains ! Physical pressure do i = 1, num_fluids - if (pres_relax <= -(1d0 - 1d-8)*pres_inf(i) + 1d-8) & - pres_relax = -(1d0 - 1d-8)*pres_inf(i) + 1d0 + if (pres_relax <= -(1._wp - 1d-8)*pres_inf(i) + 1d-8) & + pres_relax = -(1._wp - 1d-8)*pres_inf(i) + 1._wp end do ! Newton-Raphson method - f_pres = -1d0 - df_pres = 0d0 + f_pres = -1._wp + df_pres = 0._wp !$acc loop seq do i = 1, num_fluids @@ -2004,7 +2004,7 @@ contains rho_K_s(i) = q_cons_vf(i + contxb - 1)%sf(j, k, l)/ & max(q_cons_vf(i + advxb - 1)%sf(j, k, l), sgm_eps) & *((pres_relax + pres_inf(i))/(pres_K_init(i) + & - pres_inf(i)))**(1d0/gamma_min(i)) + pres_inf(i)))**(1._wp/gamma_min(i)) f_pres = f_pres + q_cons_vf(i + contxb - 1)%sf(j, k, l) & /rho_K_s(i) @@ -2043,9 +2043,9 @@ contains end do if (bubbles) then - rho = 0d0 - gamma = 0d0 - pi_inf = 0d0 + rho = 0._wp + gamma = 0._wp + pi_inf = 0._wp if (mpp_lim .and. (model_eqns == 2) .and. (num_fluids > 2)) then !$acc loop seq @@ -2067,17 +2067,17 @@ contains pi_inf = pi_infs(1) end if else - rho = 0d0 - gamma = 0d0 - pi_inf = 0d0 + rho = 0._wp + gamma = 0._wp + pi_inf = 0._wp - sum_alpha = 0d0 + sum_alpha = 0._wp if (mpp_lim) then !$acc loop seq do i = 1, num_fluids - alpha_rho(i) = max(0d0, alpha_rho(i)) - alpha(i) = min(max(0d0, alpha(i)), 1d0) + alpha_rho(i) = max(0._wp, alpha_rho(i)) + alpha(i) = min(max(0._wp, alpha(i)), 1._wp) sum_alpha = sum_alpha + alpha(i) end do @@ -2097,20 +2097,20 @@ contains do i = 1, 2 Re(i) = dflt_real - if (Re_size(i) > 0) Re(i) = 0d0 + if (Re_size(i) > 0) Re(i) = 0._wp !$acc loop seq do q = 1, Re_size(i) Re(i) = alpha(Re_idx(i, q))/Res(i, q) & + Re(i) end do - Re(i) = 1d0/max(Re(i), sgm_eps) + Re(i) = 1._wp/max(Re(i), sgm_eps) end do end if end if - dyn_pres = 0d0 + dyn_pres = 0._wp !$acc loop seq do i = momxb, momxe diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index bab2a74155..769100a3c0 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -373,12 +373,12 @@ contains vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, contxe + i) end do - vel_L_rms = 0d0; vel_R_rms = 0d0 + vel_L_rms = 0._wp; vel_R_rms = 0._wp !$acc loop seq do i = 1, num_dims - vel_L_rms = vel_L_rms + vel_L(i)**2d0 - vel_R_rms = vel_R_rms + vel_R(i)**2d0 + vel_L_rms = vel_L_rms + vel_L(i)**2._wp + vel_R_rms = vel_R_rms + vel_R(i)**2._wp end do !$acc loop seq @@ -390,24 +390,24 @@ contains pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx) pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx) - rho_L = 0d0 - gamma_L = 0d0 - pi_inf_L = 0d0 - qv_L = 0d0 + rho_L = 0._wp + gamma_L = 0._wp + pi_inf_L = 0._wp + qv_L = 0._wp - rho_R = 0d0 - gamma_R = 0d0 - pi_inf_R = 0d0 - qv_R = 0d0 + rho_R = 0._wp + gamma_R = 0._wp + pi_inf_R = 0._wp + qv_R = 0._wp - alpha_L_sum = 0d0 - alpha_R_sum = 0d0 + alpha_L_sum = 0._wp + alpha_R_sum = 0._wp if (mpp_lim) then !$acc loop seq do i = 1, num_fluids - alpha_rho_L(i) = max(0d0, alpha_rho_L(i)) - alpha_L(i) = min(max(0d0, alpha_L(i)), 1d0) + alpha_rho_L(i) = max(0._wp, alpha_rho_L(i)) + alpha_L(i) = min(max(0._wp, alpha_L(i)), 1._wp) alpha_L_sum = alpha_L_sum + alpha_L(i) end do @@ -415,8 +415,8 @@ contains !$acc loop seq do i = 1, num_fluids - alpha_rho_R(i) = max(0d0, alpha_rho_R(i)) - alpha_R(i) = min(max(0d0, alpha_R(i)), 1d0) + alpha_rho_R(i) = max(0._wp, alpha_rho_R(i)) + alpha_R(i) = min(max(0._wp, alpha_R(i)), 1._wp) alpha_R_sum = alpha_R_sum + alpha_R(i) end do @@ -441,7 +441,7 @@ contains do i = 1, 2 Re_L(i) = dflt_real - if (Re_size(i) > 0) Re_L(i) = 0d0 + if (Re_size(i) > 0) Re_L(i) = 0._wp !$acc loop seq do q = 1, Re_size(i) @@ -449,7 +449,7 @@ contains + Re_L(i) end do - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) + Re_L(i) = 1._wp/max(Re_L(i), sgm_eps) end do @@ -457,7 +457,7 @@ contains do i = 1, 2 Re_R(i) = dflt_real - if (Re_size(i) > 0) Re_R(i) = 0d0 + if (Re_size(i) > 0) Re_R(i) = 0._wp !$acc loop seq do q = 1, Re_size(i) @@ -465,7 +465,7 @@ contains + Re_R(i) end do - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) + Re_R(i) = 1._wp/max(Re_R(i), sgm_eps) end do end if @@ -482,8 +482,8 @@ contains tau_e_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, strxb - 1 + i) end do - G_L = 0d0 - G_R = 0d0 + G_L = 0._wp + G_R = 0._wp !$acc loop seq do i = 1, num_fluids @@ -495,12 +495,12 @@ contains ! Elastic contribution to energy if G large enough !TODO take out if statement if stable without if ((G_L > 1000) .and. (G_R > 1000)) then - E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) - E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) + E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4._wp*G_L) + E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4._wp*G_R) ! Additional terms in 2D and 3D if ((i == 2) .or. (i == 4) .or. (i == 5)) then - E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4d0*G_L) - E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4d0*G_R) + E_L = E_L + (tau_e_L(i)*tau_e_L(i))/(4._wp*G_L) + E_R = E_R + (tau_e_R(i)*tau_e_R(i))/(4._wp*G_R) end if end if end do @@ -523,23 +523,23 @@ contains if (any(Re_size > 0)) then !$acc loop seq do i = 1, 2 - Re_avg_rs${XYZ}$_vf(j, k, l, i) = 2d0/(1d0/Re_L(i) + 1d0/Re_R(i)) + Re_avg_rs${XYZ}$_vf(j, k, l, i) = 2._wp/(1._wp/Re_L(i) + 1._wp/Re_R(i)) end do end if if (wave_speeds == 1) then if (hypoelasticity) then s_L = min(vel_L(dir_idx(1)) - sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + & + (((4._wp*G_L)/3._wp) + & tau_e_L(dir_idx_tau(1)))/rho_L) & , vel_R(dir_idx(1)) - sqrt(c_R*c_R + & - (((4d0*G_R)/3d0) + & + (((4._wp*G_R)/3._wp) + & tau_e_R(dir_idx_tau(1)))/rho_R)) s_R = max(vel_R(dir_idx(1)) + sqrt(c_R*c_R + & - (((4d0*G_R)/3d0) + & + (((4._wp*G_R)/3._wp) + & tau_e_R(dir_idx_tau(1)))/rho_R) & , vel_L(dir_idx(1)) + sqrt(c_L*c_L + & - (((4d0*G_L)/3d0) + & + (((4._wp*G_L)/3._wp) + & tau_e_L(dir_idx_tau(1)))/rho_L)) else s_L = min(vel_L(dir_idx(1)) - c_L, vel_R(dir_idx(1)) - c_R) @@ -559,12 +559,12 @@ contains pres_SR = pres_SL - Ms_L = max(1d0, sqrt(1d0 + ((5d-1 + gamma_L)/(1d0 + gamma_L))* & - (pres_SL/pres_L - 1d0)*pres_L/ & - ((pres_L + pi_inf_L/(1d0 + gamma_L))))) - Ms_R = max(1d0, sqrt(1d0 + ((5d-1 + gamma_R)/(1d0 + gamma_R))* & - (pres_SR/pres_R - 1d0)*pres_R/ & - ((pres_R + pi_inf_R/(1d0 + gamma_R))))) + Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* & + (pres_SL/pres_L - 1._wp)*pres_L/ & + ((pres_L + pi_inf_L/(1._wp + gamma_L))))) + Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* & + (pres_SR/pres_R - 1._wp)*pres_R/ & + ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R @@ -574,7 +574,7 @@ contains (rho_avg*c_avg)) end if - s_M = min(0d0, s_L); s_P = max(0d0, s_R) + s_M = min(0._wp, s_L); s_P = max(0._wp, s_R) xi_M = (5d-1 + sign(5d-1, s_L)) & + (5d-1 - sign(5d-1, s_L)) & @@ -733,7 +733,7 @@ contains if (bubbles) then ! From HLLC: Kills mass transport @ bubble gas density if (num_fluids > 1) then - flux_rs${XYZ}$_vf(j, k, l, contxe) = 0d0 + flux_rs${XYZ}$_vf(j, k, l, contxe) = 0._wp end if end if @@ -747,7 +747,7 @@ contains - s_P*Y_L*rho_L*vel_L(dir_idx(norm_dir)) & + s_M*s_P*(Y_L*rho_L - Y_R*rho_R)) & /(s_M - s_P) - flux_src_rs${XYZ}$_vf(j, k, l, i) = 0d0 + flux_src_rs${XYZ}$_vf(j, k, l, i) = 0._wp end do end if end do @@ -936,37 +936,37 @@ contains do k = is2%beg, is2%end do j = is1%beg, is1%end - vel_L_rms = 0d0; vel_R_rms = 0d0 + vel_L_rms = 0._wp; vel_R_rms = 0._wp !$acc loop seq do i = 1, num_dims vel_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, contxe + i) vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, contxe + i) - vel_L_rms = vel_L_rms + vel_L(i)**2d0 - vel_R_rms = vel_R_rms + vel_R(i)**2d0 + vel_L_rms = vel_L_rms + vel_L(i)**2._wp + vel_R_rms = vel_R_rms + vel_R(i)**2._wp end do pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx) pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx) - rho_L = 0d0 - gamma_L = 0d0 - pi_inf_L = 0d0 - qv_L = 0d0 + rho_L = 0._wp + gamma_L = 0._wp + pi_inf_L = 0._wp + qv_L = 0._wp - rho_R = 0d0 - gamma_R = 0d0 - pi_inf_R = 0d0 - qv_R = 0d0 + rho_R = 0._wp + gamma_R = 0._wp + pi_inf_R = 0._wp + qv_R = 0._wp - alpha_L_sum = 0d0 - alpha_R_sum = 0d0 + alpha_L_sum = 0._wp + alpha_R_sum = 0._wp if (mpp_lim) then !$acc loop seq do i = 1, num_fluids - qL_prim_rs${XYZ}$_vf(j, k, l, i) = max(0d0, qL_prim_rs${XYZ}$_vf(j, k, l, i)) - qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) = min(max(0d0, qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i)), 1d0) + qL_prim_rs${XYZ}$_vf(j, k, l, i) = max(0._wp, qL_prim_rs${XYZ}$_vf(j, k, l, i)) + qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) = min(max(0._wp, qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i)), 1._wp) alpha_L_sum = alpha_L_sum + qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) end do @@ -977,8 +977,8 @@ contains !$acc loop seq do i = 1, num_fluids - qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) = max(0d0, qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)) - qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) = min(max(0d0, qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i)), 1d0) + qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) = max(0._wp, qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)) + qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) = min(max(0._wp, qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i)), 1._wp) alpha_R_sum = alpha_R_sum + qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) end do @@ -1009,7 +1009,7 @@ contains do i = 1, 2 Re_L(i) = dflt_real - if (Re_size(i) > 0) Re_L(i) = 0d0 + if (Re_size(i) > 0) Re_L(i) = 0._wp !$acc loop seq do q = 1, Re_size(i) @@ -1017,7 +1017,7 @@ contains + Re_L(i) end do - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) + Re_L(i) = 1._wp/max(Re_L(i), sgm_eps) end do @@ -1025,7 +1025,7 @@ contains do i = 1, 2 Re_R(i) = dflt_real - if (Re_size(i) > 0) Re_R(i) = 0d0 + if (Re_size(i) > 0) Re_R(i) = 0._wp !$acc loop seq do q = 1, Re_size(i) @@ -1033,7 +1033,7 @@ contains + Re_R(i) end do - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) + Re_R(i) = 1._wp/max(Re_R(i), sgm_eps) end do end if @@ -1061,7 +1061,7 @@ contains if (any(Re_size > 0)) then !$acc loop seq do i = 1, 2 - Re_avg_rs${XYZ}$_vf(j, k, l, i) = 2d0/(1d0/Re_L(i) + 1d0/Re_R(i)) + Re_avg_rs${XYZ}$_vf(j, k, l, i) = 2._wp/(1._wp/Re_L(i) + 1._wp/Re_R(i)) end do end if @@ -1082,12 +1082,12 @@ contains pres_SR = pres_SL - Ms_L = max(1d0, sqrt(1d0 + ((5d-1 + gamma_L)/(1d0 + gamma_L))* & - (pres_SL/pres_L - 1d0)*pres_L/ & - ((pres_L + pi_inf_L/(1d0 + gamma_L))))) - Ms_R = max(1d0, sqrt(1d0 + ((5d-1 + gamma_R)/(1d0 + gamma_R))* & - (pres_SR/pres_R - 1d0)*pres_R/ & - ((pres_R + pi_inf_R/(1d0 + gamma_R))))) + Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* & + (pres_SL/pres_L - 1._wp)*pres_L/ & + ((pres_L + pi_inf_L/(1._wp + gamma_L))))) + Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* & + (pres_SR/pres_R - 1._wp)*pres_R/ & + ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R @@ -1097,7 +1097,7 @@ contains (rho_avg*c_avg)) end if - if (s_L >= 0d0) then + if (s_L >= 0._wp) then p_Star = pres_L ! Only useful to recalculate the radial momentum geometric source flux !$acc loop seq do i = 1, num_fluids @@ -1130,7 +1130,7 @@ contains end if ! Compute right solution state - else if (s_R <= 0d0) then + else if (s_R <= 0._wp) then p_Star = pres_R ! Only useful to recalculate the radial momentum geometric source flux !$acc loop seq @@ -1164,7 +1164,7 @@ contains end if ! Compute left star solution state - else if (s_S >= 0d0) then + else if (s_S >= 0._wp) then xi_L = (s_L - vel_L(dir_idx(1)))/(s_L - s_S) rho_Star = rho_L*xi_L E_Star = xi_L*(E_L + (s_S - vel_L(dir_idx(1)))* & @@ -1172,8 +1172,8 @@ contains p_Star = rho_L*(s_L - vel_L(dir_idx(1)))*(s_S - vel_L(dir_idx(1))) + pres_L !$acc loop seq do i = 1, num_fluids - p_K_Star = (pres_L + pi_infs(i)/(1d0 + gammas(i)))* & - xi_L**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) + p_K_Star = (pres_L + pi_infs(i)/(1._wp + gammas(i)))* & + xi_L**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & qL_prim_rs${XYZ}$_vf(j, k, l, i + advxb - 1)*s_S @@ -1191,7 +1191,7 @@ contains do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = & rho_Star*s_S*(s_S*dir_flg(dir_idx(i)) + vel_L(dir_idx(i))* & - (1d0 - dir_flg(dir_idx(i)))) + dir_flg(dir_idx(i))*p_Star + (1._wp - dir_flg(dir_idx(i)))) + dir_flg(dir_idx(i))*p_Star vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_L(dir_idx(i)) + & dir_flg(dir_idx(i))*(s_S*xi_L - vel_L(dir_idx(i))) @@ -1216,8 +1216,8 @@ contains p_Star = rho_R*(s_R - vel_R(dir_idx(1)))*(s_S - vel_R(dir_idx(1))) + pres_R !$acc loop seq do i = 1, num_fluids - p_K_Star = (pres_R + pi_infs(i)/(1d0 + gammas(i)))* & - xi_R**(1d0/gammas(i) + 1d0) - pi_infs(i)/(1d0 + gammas(i)) + p_K_Star = (pres_R + pi_infs(i)/(1._wp + gammas(i)))* & + xi_R**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) flux_rs${XYZ}$_vf(j, k, l, i + advxb - 1) = & qR_prim_rs${XYZ}$_vf(j + 1, k, l, i + advxb - 1)*s_S @@ -1234,7 +1234,7 @@ contains !$acc loop seq do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, momxb - 1 + dir_idx(i)) = rho_Star*s_S* & - (s_S*dir_flg(dir_idx(i)) + vel_R(dir_idx(i))*(1d0 - dir_flg(dir_idx(i)))) + & + (s_S*dir_flg(dir_idx(i)) + vel_R(dir_idx(i))*(1._wp - dir_flg(dir_idx(i)))) + & dir_flg(dir_idx(i))*p_Star vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = vel_R(dir_idx(i)) + & @@ -1270,7 +1270,7 @@ contains ! Geometrical source of the void fraction(s) is zero !$acc loop seq do i = advxb, advxe - flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 + flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0._wp end do end if @@ -1296,11 +1296,11 @@ contains vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, contxe + i) end do - vel_L_rms = 0d0; vel_R_rms = 0d0 + vel_L_rms = 0._wp; vel_R_rms = 0._wp !$acc loop seq do i = 1, num_dims - vel_L_rms = vel_L_rms + vel_L(i)**2d0 - vel_R_rms = vel_R_rms + vel_R(i)**2d0 + vel_L_rms = vel_L_rms + vel_L(i)**2._wp + vel_R_rms = vel_R_rms + vel_R(i)**2._wp end do !$acc loop seq @@ -1312,10 +1312,10 @@ contains pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx) pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx) - rho_L = 0d0 - gamma_L = 0d0 - pi_inf_L = 0d0 - qv_L = 0d0 + rho_L = 0._wp + gamma_L = 0._wp + pi_inf_L = 0._wp + qv_L = 0._wp !$acc loop seq do i = 1, num_fluids rho_L = rho_L + alpha_rho_L(i) @@ -1324,10 +1324,10 @@ contains qv_L = qv_L + alpha_rho_L(i)*qvs(i) end do - rho_R = 0d0 - gamma_R = 0d0 - pi_inf_R = 0d0 - qv_R = 0d0 + rho_R = 0._wp + gamma_R = 0._wp + pi_inf_R = 0._wp + qv_R = 0._wp !$acc loop seq do i = 1, num_fluids rho_R = rho_R + alpha_rho_R(i) @@ -1374,12 +1374,12 @@ contains pres_SR = pres_SL - Ms_L = max(1d0, sqrt(1d0 + ((5d-1 + gamma_L)/(1d0 + gamma_L))* & - (pres_SL/pres_L - 1d0)*pres_L/ & - ((pres_L + pi_inf_L/(1d0 + gamma_L))))) - Ms_R = max(1d0, sqrt(1d0 + ((5d-1 + gamma_R)/(1d0 + gamma_R))* & - (pres_SR/pres_R - 1d0)*pres_R/ & - ((pres_R + pi_inf_R/(1d0 + gamma_R))))) + Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* & + (pres_SL/pres_L - 1._wp)*pres_L/ & + ((pres_L + pi_inf_L/(1._wp + gamma_L))))) + Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* & + (pres_SR/pres_R - 1._wp)*pres_R/ & + ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R @@ -1391,7 +1391,7 @@ contains ! follows Einfeldt et al. ! s_M/P = min/max(0.,s_L/R) - s_M = min(0d0, s_L); s_P = max(0d0, s_R) + s_M = min(0._wp, s_L); s_P = max(0._wp, s_R) ! goes with q_star_L/R = xi_L/R * (variable) ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) ) @@ -1407,9 +1407,9 @@ contains do i = 1, contxe flux_rs${XYZ}$_vf(j, k, l, i) = & xi_M*alpha_rho_L(i) & - *(vel_L(dir_idx(1)) + s_M*(xi_L - 1d0)) & + *(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & + xi_P*alpha_rho_R(i) & - *(vel_R(dir_idx(1)) + s_P*(xi_R - 1d0)) + *(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) end do ! Momentum flux. @@ -1420,13 +1420,13 @@ contains xi_M*(rho_L*(vel_L(dir_idx(1))* & vel_L(dir_idx(i)) + & s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & - (1d0 - dir_flg(dir_idx(i)))* & + (1._wp - dir_flg(dir_idx(i)))* & vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + & dir_flg(dir_idx(i))*pres_L) & + xi_P*(rho_R*(vel_R(dir_idx(1))* & vel_R(dir_idx(i)) + & s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & - (1d0 - dir_flg(dir_idx(i)))* & + (1._wp - dir_flg(dir_idx(i)))* & vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + & dir_flg(dir_idx(i))*pres_R) end do @@ -1437,28 +1437,28 @@ contains do i = 1, num_dims flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) = & flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(i)) + & - xi_M*(dir_flg(dir_idx(i))*(-1d0*ptilde_L)) & - + xi_P*(dir_flg(dir_idx(i))*(-1d0*ptilde_R)) + xi_M*(dir_flg(dir_idx(i))*(-1._wp*ptilde_L)) & + + xi_P*(dir_flg(dir_idx(i))*(-1._wp*ptilde_R)) end do end if - flux_rs${XYZ}$_vf(j, k, l, E_idx) = 0.d0 + flux_rs${XYZ}$_vf(j, k, l, E_idx) = 0._wp !$acc loop seq do i = alf_idx, alf_idx !only advect the void fraction flux_rs${XYZ}$_vf(j, k, l, i) = & xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & - *(vel_L(dir_idx(1)) + s_M*(xi_L - 1d0)) & + *(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & - *(vel_R(dir_idx(1)) + s_P*(xi_R - 1d0)) + *(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) end do ! Source for volume fraction advection equation !$acc loop seq do i = 1, num_dims - vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = 0d0 - !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0d0 + vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = 0._wp + !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp end do flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) @@ -1469,9 +1469,9 @@ contains do i = bubxb, bubxe flux_rs${XYZ}$_vf(j, k, l, i) = & xi_M*nbub_L*qL_prim_rs${XYZ}$_vf(j, k, l, i) & - *(vel_L(dir_idx(1)) + s_M*(xi_L - 1d0)) & + *(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & + xi_P*nbub_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & - *(vel_R(dir_idx(1)) + s_P*(xi_R - 1d0)) + *(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) end do end if @@ -1489,17 +1489,17 @@ contains xi_M*(rho_L*(vel_L(dir_idx(1))* & vel_L(dir_idx(1)) + & s_M*(xi_L*(dir_flg(dir_idx(1))*s_S + & - (1d0 - dir_flg(dir_idx(1)))* & + (1._wp - dir_flg(dir_idx(1)))* & vel_L(dir_idx(1))) - vel_L(dir_idx(1))))) & + xi_P*(rho_R*(vel_R(dir_idx(1))* & vel_R(dir_idx(1)) + & s_P*(xi_R*(dir_flg(dir_idx(1))*s_S + & - (1d0 - dir_flg(dir_idx(1)))* & + (1._wp - dir_flg(dir_idx(1)))* & vel_R(dir_idx(1))) - vel_R(dir_idx(1))))) ! Geometrical source of the void fraction(s) is zero !$acc loop seq do i = advxb, advxe - flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 + flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0._wp end do end if #:endif @@ -1507,18 +1507,18 @@ contains if (grid_geometry == 3) then !$acc loop seq do i = 1, sys_size - flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 + flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0._wp end do flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb + 1) = & -xi_M*(rho_L*(vel_L(dir_idx(1))* & vel_L(dir_idx(1)) + & s_M*(xi_L*(dir_flg(dir_idx(1))*s_S + & - (1d0 - dir_flg(dir_idx(1)))* & + (1._wp - dir_flg(dir_idx(1)))* & vel_L(dir_idx(1))) - vel_L(dir_idx(1))))) & - xi_P*(rho_R*(vel_R(dir_idx(1))* & vel_R(dir_idx(1)) + & s_P*(xi_R*(dir_flg(dir_idx(1))*s_S + & - (1d0 - dir_flg(dir_idx(1)))* & + (1._wp - dir_flg(dir_idx(1)))* & vel_R(dir_idx(1))) - vel_R(dir_idx(1))))) flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) end if @@ -1540,23 +1540,23 @@ contains alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) end do - vel_L_rms = 0d0; vel_R_rms = 0d0 + vel_L_rms = 0._wp; vel_R_rms = 0._wp !$acc loop seq do i = 1, num_dims vel_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, contxe + i) vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, contxe + i) - vel_L_rms = vel_L_rms + vel_L(i)**2d0 - vel_R_rms = vel_R_rms + vel_R(i)**2d0 + vel_L_rms = vel_L_rms + vel_L(i)**2._wp + vel_R_rms = vel_R_rms + vel_R(i)**2._wp end do pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx) pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx) - rho_L = 0d0 - gamma_L = 0d0 - pi_inf_L = 0d0 - qv_L = 0d0 + rho_L = 0._wp + gamma_L = 0._wp + pi_inf_L = 0._wp + qv_L = 0._wp ! Retain this in the refactor if (mpp_lim .and. (num_fluids > 2)) then @@ -1582,10 +1582,10 @@ contains qv_L = qvs(1) end if - rho_R = 0d0 - gamma_R = 0d0 - pi_inf_R = 0d0 - qv_R = 0d0 + rho_R = 0._wp + gamma_R = 0._wp + pi_inf_R = 0._wp + qv_R = 0._wp if (mpp_lim .and. (num_fluids > 2)) then !$acc loop seq @@ -1616,15 +1616,15 @@ contains do i = 1, 2 Re_L(i) = dflt_real - if (Re_size(i) > 0) Re_L(i) = 0d0 + if (Re_size(i) > 0) Re_L(i) = 0._wp !$acc loop seq do q = 1, Re_size(i) - Re_L(i) = (1d0 - qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q)))/Res(i, q) & + Re_L(i) = (1._wp - qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + Re_idx(i, q)))/Res(i, q) & + Re_L(i) end do - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) + Re_L(i) = 1._wp/max(Re_L(i), sgm_eps) end do @@ -1632,15 +1632,15 @@ contains do i = 1, 2 Re_R(i) = dflt_real - if (Re_size(i) > 0) Re_R(i) = 0d0 + if (Re_size(i) > 0) Re_R(i) = 0._wp !$acc loop seq do q = 1, Re_size(i) - Re_R(i) = (1d0 - qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q)))/Res(i, q) & + Re_R(i) = (1._wp - qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + Re_idx(i, q)))/Res(i, q) & + Re_R(i) end do - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) + Re_R(i) = 1._wp/max(Re_R(i), sgm_eps) end do end if end if @@ -1670,15 +1670,15 @@ contains nbub_L = qL_prim_rs${XYZ}$_vf(j, k, l, n_idx) nbub_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, n_idx) else - nbub_L_denom = 0d0 - nbub_R_denom = 0d0 + nbub_L_denom = 0._wp + nbub_R_denom = 0._wp !$acc loop seq do i = 1, nb - nbub_L_denom = nbub_L_denom + (R0_L(i)**3d0)*weight(i) - nbub_R_denom = nbub_R_denom + (R0_R(i)**3d0)*weight(i) + nbub_L_denom = nbub_L_denom + (R0_L(i)**3._wp)*weight(i) + nbub_R_denom = nbub_R_denom + (R0_R(i)**3._wp)*weight(i) end do - nbub_L = (3.d0/(4.d0*pi))*qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + num_fluids)/nbub_L_denom - nbub_R = (3.d0/(4.d0*pi))*qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + num_fluids)/nbub_R_denom + nbub_L = (3._wp/(4._wp*pi))*qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + num_fluids)/nbub_L_denom + nbub_R = (3._wp/(4._wp*pi))*qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + num_fluids)/nbub_R_denom end if else !nb stored in 0th moment of first R0 bin in variable conversion module @@ -1690,8 +1690,8 @@ contains do i = 1, nb if (.not. qbmm) then if (polytropic) then - pbw_L(i) = f_cpbw_KM(R0(i), R0_L(i), V0_L(i), 0d0) - pbw_R(i) = f_cpbw_KM(R0(i), R0_R(i), V0_R(i), 0d0) + pbw_L(i) = f_cpbw_KM(R0(i), R0_L(i), V0_L(i), 0._wp) + pbw_R(i) = f_cpbw_KM(R0(i), R0_R(i), V0_R(i), 0._wp) else pbw_L(i) = f_cpbw_KM(R0(i), R0_L(i), V0_L(i), P0_L(i)) pbw_R(i) = f_cpbw_KM(R0(i), R0_R(i), V0_R(i), P0_R(i)) @@ -1710,25 +1710,25 @@ contains R3V2Rbar = mom_sp_rs${XYZ}$_vf(j + 1, k, l, 3) else - PbwR3Lbar = 0d0 - PbwR3Rbar = 0d0 + PbwR3Lbar = 0._wp + PbwR3Rbar = 0._wp - R3Lbar = 0d0 - R3Rbar = 0d0 + R3Lbar = 0._wp + R3Rbar = 0._wp - R3V2Lbar = 0d0 - R3V2Rbar = 0d0 + R3V2Lbar = 0._wp + R3V2Rbar = 0._wp !$acc loop seq do i = 1, nb - PbwR3Lbar = PbwR3Lbar + pbw_L(i)*(R0_L(i)**3.d0)*weight(i) - PbwR3Rbar = PbwR3Rbar + pbw_R(i)*(R0_R(i)**3.d0)*weight(i) + PbwR3Lbar = PbwR3Lbar + pbw_L(i)*(R0_L(i)**3._wp)*weight(i) + PbwR3Rbar = PbwR3Rbar + pbw_R(i)*(R0_R(i)**3._wp)*weight(i) - R3Lbar = R3Lbar + (R0_L(i)**3.d0)*weight(i) - R3Rbar = R3Rbar + (R0_R(i)**3.d0)*weight(i) + R3Lbar = R3Lbar + (R0_L(i)**3._wp)*weight(i) + R3Rbar = R3Rbar + (R0_R(i)**3._wp)*weight(i) - R3V2Lbar = R3V2Lbar + (R0_L(i)**3.d0)*(V0_L(i)**2.d0)*weight(i) - R3V2Rbar = R3V2Rbar + (R0_R(i)**3.d0)*(V0_R(i)**2.d0)*weight(i) + R3V2Lbar = R3V2Lbar + (R0_L(i)**3._wp)*(V0_L(i)**2._wp)*weight(i) + R3V2Rbar = R3V2Rbar + (R0_R(i)**3._wp)*(V0_R(i)**2._wp)*weight(i) end do end if @@ -1752,11 +1752,11 @@ contains rho_avg = 5d-1*(rho_L + rho_R) H_avg = 5d-1*(H_L + H_R) gamma_avg = 5d-1*(gamma_L + gamma_R) - vel_avg_rms = 0d0 + vel_avg_rms = 0._wp !$acc loop seq do i = 1, num_dims - vel_avg_rms = vel_avg_rms + (5d-1*(vel_L(i) + vel_R(i)))**2d0 + vel_avg_rms = vel_avg_rms + (5d-1*(vel_L(i) + vel_R(i)))**2._wp end do end if @@ -1776,7 +1776,7 @@ contains if (any(Re_size > 0)) then !$acc loop seq do i = 1, 2 - Re_avg_rs${XYZ}$_vf(j, k, l, i) = 2d0/(1d0/Re_L(i) + 1d0/Re_R(i)) + Re_avg_rs${XYZ}$_vf(j, k, l, i) = 2._wp/(1._wp/Re_L(i) + 1._wp/Re_R(i)) end do end if @@ -1801,12 +1801,12 @@ contains pres_SR = pres_SL - Ms_L = max(1d0, sqrt(1d0 + ((5d-1 + gamma_L)/(1d0 + gamma_L))* & - (pres_SL/pres_L - 1d0)*pres_L/ & - ((pres_L + pi_inf_L/(1d0 + gamma_L))))) - Ms_R = max(1d0, sqrt(1d0 + ((5d-1 + gamma_R)/(1d0 + gamma_R))* & - (pres_SR/pres_R - 1d0)*pres_R/ & - ((pres_R + pi_inf_R/(1d0 + gamma_R))))) + Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* & + (pres_SL/pres_L - 1._wp)*pres_L/ & + ((pres_L + pi_inf_L/(1._wp + gamma_L))))) + Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* & + (pres_SR/pres_R - 1._wp)*pres_R/ & + ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R @@ -1818,7 +1818,7 @@ contains ! follows Einfeldt et al. ! s_M/P = min/max(0.,s_L/R) - s_M = min(0d0, s_L); s_P = max(0d0, s_R) + s_M = min(0._wp, s_L); s_P = max(0._wp, s_R) ! goes with q_star_L/R = xi_L/R * (variable) ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) ) @@ -1833,21 +1833,21 @@ contains if (low_Mach == 1) then @:compute_low_Mach_correction() else - pcorr = 0d0 + pcorr = 0._wp end if !$acc loop seq do i = 1, contxe flux_rs${XYZ}$_vf(j, k, l, i) = & xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & - *(vel_L(dir_idx(1)) + s_M*(xi_L - 1d0)) & + *(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & - *(vel_R(dir_idx(1)) + s_P*(xi_R - 1d0)) + *(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) end do if (bubbles .and. (num_fluids > 1)) then ! Kill mass transport @ gas density - flux_rs${XYZ}$_vf(j, k, l, contxe) = 0.d0 + flux_rs${XYZ}$_vf(j, k, l, contxe) = 0._wp end if ! Momentum flux. @@ -1861,13 +1861,13 @@ contains xi_M*(rho_L*(vel_L(dir_idx(1))* & vel_L(dir_idx(i)) + & s_M*(xi_L*(dir_flg(dir_idx(i))*s_S + & - (1d0 - dir_flg(dir_idx(i)))* & + (1._wp - dir_flg(dir_idx(i)))* & vel_L(dir_idx(i))) - vel_L(dir_idx(i)))) + & dir_flg(dir_idx(i))*(pres_L - ptilde_L)) & + xi_P*(rho_R*(vel_R(dir_idx(1))* & vel_R(dir_idx(i)) + & s_P*(xi_R*(dir_flg(dir_idx(i))*s_S + & - (1d0 - dir_flg(dir_idx(i)))* & + (1._wp - dir_flg(dir_idx(i)))* & vel_R(dir_idx(i))) - vel_R(dir_idx(i)))) + & dir_flg(dir_idx(i))*(pres_R - ptilde_R)) & + (s_M/s_L)*(s_P/s_R)*dir_flg(dir_idx(i))*pcorr @@ -1893,9 +1893,9 @@ contains do i = advxb, advxe flux_rs${XYZ}$_vf(j, k, l, i) = & xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & - *(vel_L(dir_idx(1)) + s_M*(xi_L - 1d0)) & + *(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & - *(vel_R(dir_idx(1)) + s_P*(xi_R - 1d0)) + *(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) end do ! Source for volume fraction advection equation @@ -1904,12 +1904,12 @@ contains vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(i)) = & xi_M*(vel_L(dir_idx(i)) + & dir_flg(dir_idx(i))* & - s_M*(xi_L - 1d0)) & + s_M*(xi_L - 1._wp)) & + xi_P*(vel_R(dir_idx(i)) + & dir_flg(dir_idx(i))* & - s_P*(xi_R - 1d0)) + s_P*(xi_R - 1._wp)) - !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(idxi)%sf(j,k,l) = 0d0 + !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(idxi)%sf(j,k,l) = 0._wp end do flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, dir_idx(1)) @@ -1919,25 +1919,25 @@ contains do i = bubxb, bubxe flux_rs${XYZ}$_vf(j, k, l, i) = & xi_M*nbub_L*qL_prim_rs${XYZ}$_vf(j, k, l, i) & - *(vel_L(dir_idx(1)) + s_M*(xi_L - 1d0)) & + *(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & + xi_P*nbub_R*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & - *(vel_R(dir_idx(1)) + s_P*(xi_R - 1d0)) + *(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) end do if (qbmm) then flux_rs${XYZ}$_vf(j, k, l, bubxb) = & xi_M*nbub_L & - *(vel_L(dir_idx(1)) + s_M*(xi_L - 1d0)) & + *(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & + xi_P*nbub_R & - *(vel_R(dir_idx(1)) + s_P*(xi_R - 1d0)) + *(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) end if if (adv_n) then flux_rs${XYZ}$_vf(j, k, l, n_idx) = & xi_M*nbub_L & - *(vel_L(dir_idx(1)) + s_M*(xi_L - 1d0)) & + *(vel_L(dir_idx(1)) + s_M*(xi_L - 1._wp)) & + xi_P*nbub_R & - *(vel_R(dir_idx(1)) + s_P*(xi_R - 1d0)) + *(vel_R(dir_idx(1)) + s_P*(xi_R - 1._wp)) end if ! Geometrical source flux for cylindrical coordinates @@ -1953,17 +1953,17 @@ contains xi_M*(rho_L*(vel_L(dir_idx(1))* & vel_L(dir_idx(1)) + & s_M*(xi_L*(dir_flg(dir_idx(1))*s_S + & - (1d0 - dir_flg(dir_idx(1)))* & + (1._wp - dir_flg(dir_idx(1)))* & vel_L(dir_idx(1))) - vel_L(dir_idx(1))))) & + xi_P*(rho_R*(vel_R(dir_idx(1))* & vel_R(dir_idx(1)) + & s_P*(xi_R*(dir_flg(dir_idx(1))*s_S + & - (1d0 - dir_flg(dir_idx(1)))* & + (1._wp - dir_flg(dir_idx(1)))* & vel_R(dir_idx(1))) - vel_R(dir_idx(1))))) ! Geometrical source of the void fraction(s) is zero !$acc loop seq do i = advxb, advxe - flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 + flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0._wp end do end if #:endif @@ -1971,19 +1971,19 @@ contains if (grid_geometry == 3) then !$acc loop seq do i = 1, sys_size - flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 + flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0._wp end do flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb + 1) = & -xi_M*(rho_L*(vel_L(dir_idx(1))* & vel_L(dir_idx(1)) + & s_M*(xi_L*(dir_flg(dir_idx(1))*s_S + & - (1d0 - dir_flg(dir_idx(1)))* & + (1._wp - dir_flg(dir_idx(1)))* & vel_L(dir_idx(1))) - vel_L(dir_idx(1))))) & - xi_P*(rho_R*(vel_R(dir_idx(1))* & vel_R(dir_idx(1)) + & s_P*(xi_R*(dir_flg(dir_idx(1))*s_S + & - (1d0 - dir_flg(dir_idx(1)))* & + (1._wp - dir_flg(dir_idx(1)))* & vel_R(dir_idx(1))) - vel_R(dir_idx(1))))) flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) @@ -2008,38 +2008,38 @@ contains alpha_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) end do - vel_L_rms = 0d0; vel_R_rms = 0d0 + vel_L_rms = 0._wp; vel_R_rms = 0._wp !$acc loop seq do i = 1, num_dims vel_L(i) = qL_prim_rs${XYZ}$_vf(j, k, l, contxe + i) vel_R(i) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, contxe + i) - vel_L_rms = vel_L_rms + vel_L(i)**2d0 - vel_R_rms = vel_R_rms + vel_R(i)**2d0 + vel_L_rms = vel_L_rms + vel_L(i)**2._wp + vel_R_rms = vel_R_rms + vel_R(i)**2._wp end do pres_L = qL_prim_rs${XYZ}$_vf(j, k, l, E_idx) pres_R = qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx) - rho_L = 0d0 - gamma_L = 0d0 - pi_inf_L = 0d0 - qv_L = 0d0 + rho_L = 0._wp + gamma_L = 0._wp + pi_inf_L = 0._wp + qv_L = 0._wp - rho_R = 0d0 - gamma_R = 0d0 - pi_inf_R = 0d0 - qv_R = 0d0 + rho_R = 0._wp + gamma_R = 0._wp + pi_inf_R = 0._wp + qv_R = 0._wp - alpha_L_sum = 0d0 - alpha_R_sum = 0d0 + alpha_L_sum = 0._wp + alpha_R_sum = 0._wp ! Change this by splitting it into the cases ! present in the bubbles if (mpp_lim) then !$acc loop seq do i = 1, num_fluids - qL_prim_rs${XYZ}$_vf(j, k, l, i) = max(0d0, qL_prim_rs${XYZ}$_vf(j, k, l, i)) - qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) = min(max(0d0, qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i)), 1d0) + qL_prim_rs${XYZ}$_vf(j, k, l, i) = max(0._wp, qL_prim_rs${XYZ}$_vf(j, k, l, i)) + qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) = min(max(0._wp, qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i)), 1._wp) alpha_L_sum = alpha_L_sum + qL_prim_rs${XYZ}$_vf(j, k, l, E_idx + i) end do @@ -2050,8 +2050,8 @@ contains !$acc loop seq do i = 1, num_fluids - qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) = max(0d0, qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)) - qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) = min(max(0d0, qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i)), 1d0) + qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) = max(0._wp, qR_prim_rs${XYZ}$_vf(j + 1, k, l, i)) + qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) = min(max(0._wp, qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i)), 1._wp) alpha_R_sum = alpha_R_sum + qR_prim_rs${XYZ}$_vf(j + 1, k, l, E_idx + i) end do @@ -2079,7 +2079,7 @@ contains do i = 1, 2 Re_L(i) = dflt_real - if (Re_size(i) > 0) Re_L(i) = 0d0 + if (Re_size(i) > 0) Re_L(i) = 0._wp !$acc loop seq do q = 1, Re_size(i) @@ -2087,7 +2087,7 @@ contains + Re_L(i) end do - Re_L(i) = 1d0/max(Re_L(i), sgm_eps) + Re_L(i) = 1._wp/max(Re_L(i), sgm_eps) end do @@ -2095,7 +2095,7 @@ contains do i = 1, 2 Re_R(i) = dflt_real - if (Re_size(i) > 0) Re_R(i) = 0d0 + if (Re_size(i) > 0) Re_R(i) = 0._wp !$acc loop seq do q = 1, Re_size(i) @@ -2103,7 +2103,7 @@ contains + Re_R(i) end do - Re_R(i) = 1d0/max(Re_R(i), sgm_eps) + Re_R(i) = 1._wp/max(Re_R(i), sgm_eps) end do end if @@ -2131,7 +2131,7 @@ contains if (any(Re_size > 0)) then !$acc loop seq do i = 1, 2 - Re_avg_rs${XYZ}$_vf(j, k, l, i) = 2d0/(1d0/Re_L(i) + 1d0/Re_R(i)) + Re_avg_rs${XYZ}$_vf(j, k, l, i) = 2._wp/(1._wp/Re_L(i) + 1._wp/Re_R(i)) end do end if @@ -2157,12 +2157,12 @@ contains pres_SR = pres_SL - Ms_L = max(1d0, sqrt(1d0 + ((5d-1 + gamma_L)/(1d0 + gamma_L))* & - (pres_SL/pres_L - 1d0)*pres_L/ & - ((pres_L + pi_inf_L/(1d0 + gamma_L))))) - Ms_R = max(1d0, sqrt(1d0 + ((5d-1 + gamma_R)/(1d0 + gamma_R))* & - (pres_SR/pres_R - 1d0)*pres_R/ & - ((pres_R + pi_inf_R/(1d0 + gamma_R))))) + Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* & + (pres_SL/pres_L - 1._wp)*pres_L/ & + ((pres_L + pi_inf_L/(1._wp + gamma_L))))) + Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* & + (pres_SR/pres_R - 1._wp)*pres_R/ & + ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(idx1) - c_L*Ms_L s_R = vel_R(idx1) + c_R*Ms_R @@ -2174,7 +2174,7 @@ contains ! follows Einfeldt et al. ! s_M/P = min/max(0.,s_L/R) - s_M = min(0d0, s_L); s_P = max(0d0, s_R) + s_M = min(0._wp, s_L); s_P = max(0._wp, s_R) ! goes with q_star_L/R = xi_L/R * (variable) ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) ) @@ -2189,16 +2189,16 @@ contains if (low_Mach == 1) then @:compute_low_Mach_correction() else - pcorr = 0d0 + pcorr = 0._wp end if !$acc loop seq do i = 1, contxe flux_rs${XYZ}$_vf(j, k, l, i) = & xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & - *(vel_L(idx1) + s_M*(xi_L - 1d0)) & + *(vel_L(idx1) + s_M*(xi_L - 1._wp)) & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & - *(vel_R(idx1) + s_P*(xi_R - 1d0)) + *(vel_R(idx1) + s_P*(xi_R - 1._wp)) end do ! Momentum flux. @@ -2210,13 +2210,13 @@ contains xi_M*(rho_L*(vel_L(idx1)* & vel_L(idxi) + & s_M*(xi_L*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))* & + (1._wp - dir_flg(idxi))* & vel_L(idxi)) - vel_L(idxi))) + & dir_flg(idxi)*(pres_L)) & + xi_P*(rho_R*(vel_R(idx1)* & vel_R(idxi) + & s_P*(xi_R*(dir_flg(idxi)*s_S + & - (1d0 - dir_flg(idxi))* & + (1._wp - dir_flg(idxi))* & vel_R(idxi)) - vel_R(idxi))) + & dir_flg(idxi)*(pres_R)) & + (s_M/s_L)*(s_P/s_R)*dir_flg(idxi)*pcorr @@ -2240,9 +2240,9 @@ contains do i = advxb, advxe flux_rs${XYZ}$_vf(j, k, l, i) = & xi_M*qL_prim_rs${XYZ}$_vf(j, k, l, i) & - *(vel_L(idx1) + s_M*(xi_L - 1d0)) & + *(vel_L(idx1) + s_M*(xi_L - 1._wp)) & + xi_P*qR_prim_rs${XYZ}$_vf(j + 1, k, l, i) & - *(vel_R(idx1) + s_P*(xi_R - 1d0)) + *(vel_R(idx1) + s_P*(xi_R - 1._wp)) end do ! Source for volume fraction advection equation @@ -2252,12 +2252,12 @@ contains vel_src_rs${XYZ}$_vf(j, k, l, idxi) = & xi_M*(vel_L(idxi) + & dir_flg(idxi)* & - s_M*(xi_L - 1d0)) & + s_M*(xi_L - 1._wp)) & + xi_P*(vel_R(idxi) + & dir_flg(idxi)* & - s_P*(xi_R - 1d0)) + s_P*(xi_R - 1._wp)) - !if ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0d0 + !if ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp end do flux_src_rs${XYZ}$_vf(j, k, l, advxb) = vel_src_rs${XYZ}$_vf(j, k, l, idx1) @@ -2276,17 +2276,17 @@ contains xi_M*(rho_L*(vel_L(idx1)* & vel_L(idx1) + & s_M*(xi_L*(dir_flg(idx1)*s_S + & - (1d0 - dir_flg(idx1))* & + (1._wp - dir_flg(idx1))* & vel_L(idx1)) - vel_L(idx1)))) & + xi_P*(rho_R*(vel_R(idx1)* & vel_R(idx1) + & s_P*(xi_R*(dir_flg(idx1)*s_S + & - (1d0 - dir_flg(idx1))* & + (1._wp - dir_flg(idx1))* & vel_R(idx1)) - vel_R(idx1)))) ! Geometrical source of the void fraction(s) is zero !$acc loop seq do i = advxb, advxe - flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 + flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0._wp end do end if #:endif @@ -2294,19 +2294,19 @@ contains if (grid_geometry == 3) then !$acc loop seq do i = 1, sys_size - flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0d0 + flux_gsrc_rs${XYZ}$_vf(j, k, l, i) = 0._wp end do flux_gsrc_rs${XYZ}$_vf(j, k, l, momxb + 1) = & -xi_M*(rho_L*(vel_L(idx1)* & vel_L(idx1) + & s_M*(xi_L*(dir_flg(idx1)*s_S + & - (1d0 - dir_flg(idx1))* & + (1._wp - dir_flg(idx1))* & vel_L(idx1)) - vel_L(idx1)))) & - xi_P*(rho_R*(vel_R(idx1)* & vel_R(idx1) + & s_P*(xi_R*(dir_flg(idx1)*s_S + & - (1d0 - dir_flg(idx1))* & + (1._wp - dir_flg(idx1))* & vel_R(idx1)) - vel_R(idx1)))) flux_gsrc_rs${XYZ}$_vf(j, k, l, momxe) = flux_rs${XYZ}$_vf(j, k, l, momxb + 1) @@ -2547,13 +2547,13 @@ contains if (norm_dir == 1) then is1 = ix; is2 = iy; is3 = iz - dir_idx = (/1, 2, 3/); dir_flg = (/1d0, 0d0, 0d0/) + dir_idx = (/1, 2, 3/); dir_flg = (/1._wp, 0._wp, 0._wp/) elseif (norm_dir == 2) then is1 = iy; is2 = ix; is3 = iz - dir_idx = (/2, 1, 3/); dir_flg = (/0d0, 1d0, 0d0/) + dir_idx = (/2, 1, 3/); dir_flg = (/0._wp, 1._wp, 0._wp/) else is1 = iz; is2 = iy; is3 = ix - dir_idx = (/3, 1, 2/); dir_flg = (/0d0, 0d0, 1d0/) + dir_idx = (/3, 1, 2/); dir_flg = (/0._wp, 0._wp, 1._wp/) end if !$acc update device(is1, is2, is3) @@ -2929,7 +2929,7 @@ contains do l = is3%beg, is3%end do k = is2%beg, is2%end do j = is1%beg, is1%end - flux_src_vf(i)%sf(j, k, l) = 0d0 + flux_src_vf(i)%sf(j, k, l) = 0._wp end do end do end do @@ -2961,7 +2961,7 @@ contains do l = is3%beg, is3%end do j = is1%beg, is1%end do k = is2%beg, is2%end - flux_src_vf(i)%sf(k, j, l) = 0d0 + flux_src_vf(i)%sf(k, j, l) = 0._wp end do end do end do @@ -2992,7 +2992,7 @@ contains do j = is1%beg, is1%end do k = is2%beg, is2%end do l = is3%beg, is3%end - flux_src_vf(i)%sf(l, k, j) = 0d0 + flux_src_vf(i)%sf(l, k, j) = 0._wp end do end do end do @@ -3086,7 +3086,7 @@ contains dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j + 1, k, l)) - tau_Re(1, 1) = (4d0/3d0)*dvel_avg_dx(1)/ & + tau_Re(1, 1) = (4._wp/3._wp)*dvel_avg_dx(1)/ & Re_avg_rsx_vf(j, k, l, 1) flux_src_vf(momxb)%sf(j, k, l) = & @@ -3150,7 +3150,7 @@ contains dvel_avg_dx(2) = 5d-1*(dvelL_dx_vf(2)%sf(j, k, l) & + dvelR_dx_vf(2)%sf(j + 1, k, l)) - tau_Re(1, 1) = -(2d0/3d0)*(dvel_avg_dy(2) + & + tau_Re(1, 1) = -(2._wp/3._wp)*(dvel_avg_dy(2) + & avg_vel(2)/y_cc(k))/ & Re_avg_rsx_vf(j, k, l, 1) @@ -3221,7 +3221,7 @@ contains dvel_avg_dx(3) = 5d-1*(dvelL_dx_vf(3)%sf(j, k, l) & + dvelR_dx_vf(3)%sf(j + 1, k, l)) - tau_Re(1, 1) = -(2d0/3d0)*dvel_avg_dz(3)/y_cc(k)/ & + tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dz(3)/y_cc(k)/ & Re_avg_rsx_vf(j, k, l, 1) tau_Re(1, 3) = (dvel_avg_dz(1)/y_cc(k) + dvel_avg_dx(3))/ & @@ -3302,10 +3302,10 @@ contains tau_Re(2, 1) = (dvel_avg_dy(1) + dvel_avg_dx(2))/ & Re_avg_rsy_vf(k, j, l, 1) - tau_Re(2, 2) = (4d0*dvel_avg_dy(2) & - - 2d0*dvel_avg_dx(1) & - - 2d0*avg_vel(2)/y_cb(k))/ & - (3d0*Re_avg_rsy_vf(k, j, l, 1)) + tau_Re(2, 2) = (4._wp*dvel_avg_dy(2) & + - 2._wp*dvel_avg_dx(1) & + - 2._wp*avg_vel(2)/y_cb(k))/ & + (3._wp*Re_avg_rsy_vf(k, j, l, 1)) !$acc loop seq do i = 1, 2 @@ -3380,7 +3380,7 @@ contains dvel_avg_dy(3) = 5d-1*(dvelL_dy_vf(3)%sf(j, k, l) & + dvelR_dy_vf(3)%sf(j, k + 1, l)) - tau_Re(2, 2) = -(2d0/3d0)*dvel_avg_dz(3)/y_cb(k)/ & + tau_Re(2, 2) = -(2._wp/3._wp)*dvel_avg_dz(3)/y_cb(k)/ & Re_avg_rsy_vf(k, j, l, 1) tau_Re(2, 3) = ((dvel_avg_dz(2) - avg_vel(3))/ & @@ -3477,11 +3477,11 @@ contains Re_avg_rsz_vf(l, k, j, 1)/ & y_cc(k) - tau_Re(3, 3) = (4d0*dvel_avg_dz(3)/y_cc(k) & - - 2d0*dvel_avg_dx(1) & - - 2d0*dvel_avg_dy(2) & - + 4d0*avg_vel(2)/y_cc(k))/ & - (3d0*Re_avg_rsz_vf(l, k, j, 1))/ & + tau_Re(3, 3) = (4._wp*dvel_avg_dz(3)/y_cc(k) & + - 2._wp*dvel_avg_dx(1) & + - 2._wp*dvel_avg_dy(2) & + + 4._wp*avg_vel(2)/y_cc(k))/ & + (3._wp*Re_avg_rsz_vf(l, k, j, 1))/ & y_cc(k) !$acc loop seq @@ -3610,7 +3610,7 @@ contains dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j + 1, k, l)) - tau_Re(1, 1) = (4d0/3d0)*dvel_avg_dx(1)/ & + tau_Re(1, 1) = (4._wp/3._wp)*dvel_avg_dx(1)/ & Re_avg_rsx_vf(j, k, l, 1) flux_src_vf(momxb)%sf(j, k, l) = & @@ -3671,7 +3671,7 @@ contains dvel_avg_dx(2) = 5d-1*(dvelL_dx_vf(2)%sf(j, k, l) & + dvelR_dx_vf(2)%sf(j + 1, k, l)) - tau_Re(1, 1) = -(2d0/3d0)*dvel_avg_dy(2)/ & + tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dy(2)/ & Re_avg_rsx_vf(j, k, l, 1) tau_Re(1, 2) = (dvel_avg_dy(1) + dvel_avg_dx(2))/ & @@ -3740,7 +3740,7 @@ contains dvel_avg_dx(3) = 5d-1*(dvelL_dx_vf(3)%sf(j, k, l) & + dvelR_dx_vf(3)%sf(j + 1, k, l)) - tau_Re(1, 1) = -(2d0/3d0)*dvel_avg_dz(3)/ & + tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dz(3)/ & Re_avg_rsx_vf(j, k, l, 1) tau_Re(1, 3) = (dvel_avg_dz(1) + dvel_avg_dx(3))/ & @@ -3816,9 +3816,9 @@ contains tau_Re(2, 1) = (dvel_avg_dy(1) + dvel_avg_dx(2))/ & Re_avg_rsy_vf(k, j, l, 1) - tau_Re(2, 2) = (4d0*dvel_avg_dy(2) & - - 2d0*dvel_avg_dx(1))/ & - (3d0*Re_avg_rsy_vf(k, j, l, 1)) + tau_Re(2, 2) = (4._wp*dvel_avg_dy(2) & + - 2._wp*dvel_avg_dx(1))/ & + (3._wp*Re_avg_rsy_vf(k, j, l, 1)) !$acc loop seq do i = 1, 2 @@ -3886,7 +3886,7 @@ contains dvel_avg_dy(3) = 5d-1*(dvelL_dy_vf(3)%sf(j, k, l) & + dvelR_dy_vf(3)%sf(j, k + 1, l)) - tau_Re(2, 2) = -(2d0/3d0)*dvel_avg_dz(3)/ & + tau_Re(2, 2) = -(2._wp/3._wp)*dvel_avg_dz(3)/ & Re_avg_rsy_vf(k, j, l, 1) tau_Re(2, 3) = (dvel_avg_dz(2) + dvel_avg_dy(3))/ & @@ -3974,10 +3974,10 @@ contains tau_Re(3, 2) = (dvel_avg_dz(2) + dvel_avg_dy(3))/ & Re_avg_rsz_vf(l, k, j, 1) - tau_Re(3, 3) = (4d0*dvel_avg_dz(3) & - - 2d0*dvel_avg_dx(1) & - - 2d0*dvel_avg_dy(2))/ & - (3d0*Re_avg_rsz_vf(l, k, j, 1)) + tau_Re(3, 3) = (4._wp*dvel_avg_dz(3) & + - 2._wp*dvel_avg_dx(1) & + - 2._wp*dvel_avg_dy(2))/ & + (3._wp*Re_avg_rsz_vf(l, k, j, 1)) !$acc loop seq do i = 1, 3 diff --git a/src/simulation/m_sim_helpers.f90 b/src/simulation/m_sim_helpers.f90 index 547ae128ad..30f05fded3 100644 --- a/src/simulation/m_sim_helpers.f90 +++ b/src/simulation/m_sim_helpers.f90 @@ -55,9 +55,9 @@ subroutine s_compute_enthalpy(q_prim_vf, pres, rho, gamma, pi_inf, Re, H, alpha, vel(i) = q_prim_vf(contxe + i)%sf(j, k, l) end do - vel_sum = 0d0 + vel_sum = 0._wp do i = 1, num_dims - vel_sum = vel_sum + vel(i)**2d0 + vel_sum = vel_sum + vel(i)**2._wp end do pres = q_prim_vf(E_idx)%sf(j, k, l) @@ -92,10 +92,10 @@ subroutine s_compute_stability_from_dt(vel, c, rho, Re_l, j, k, l, icfl_sf, vcfl if (grid_geometry == 3) then if (k == 0) then - fltr_dtheta = 2d0*pi*y_cb(0)/3d0 + fltr_dtheta = 2._wp*pi*y_cb(0)/3._wp elseif (k <= fourier_rings) then - Nfq = min(floor(2d0*real(k, wp)*pi), (p + 1)/2 + 1) - fltr_dtheta = 2d0*pi*y_cb(k - 1)/real(Nfq, wp) + Nfq = min(floor(2._wp*real(k, wp)*pi), (p + 1)/2 + 1) + fltr_dtheta = 2._wp*pi*y_cb(k - 1)/real(Nfq, wp) else fltr_dtheta = y_cb(k - 1)*dz(l) end if @@ -117,20 +117,20 @@ subroutine s_compute_stability_from_dt(vel, c, rho, Re_l, j, k, l, icfl_sf, vcfl if (grid_geometry == 3) then vcfl_sf(j, k, l) = maxval(dt/Re_l/rho) & - /min(dx(j), dy(k), fltr_dtheta)**2d0 + /min(dx(j), dy(k), fltr_dtheta)**2._wp Rc_sf(j, k, l) = min(dx(j)*(abs(vel(1)) + c), & dy(k)*(abs(vel(2)) + c), & fltr_dtheta*(abs(vel(3)) + c)) & - /maxval(1d0/Re_l) + /maxval(1._wp/Re_l) else vcfl_sf(j, k, l) = maxval(dt/Re_l/rho) & - /min(dx(j), dy(k), dz(l))**2d0 + /min(dx(j), dy(k), dz(l))**2._wp Rc_sf(j, k, l) = min(dx(j)*(abs(vel(1)) + c), & dy(k)*(abs(vel(2)) + c), & dz(l)*(abs(vel(3)) + c)) & - /maxval(1d0/Re_l) + /maxval(1._wp/Re_l) end if end if @@ -142,11 +142,11 @@ subroutine s_compute_stability_from_dt(vel, c, rho, Re_l, j, k, l, icfl_sf, vcfl if (any(Re_size > 0)) then - vcfl_sf(j, k, l) = maxval(dt/Re_l/rho)/min(dx(j), dy(k))**2d0 + vcfl_sf(j, k, l) = maxval(dt/Re_l/rho)/min(dx(j), dy(k))**2._wp Rc_sf(j, k, l) = min(dx(j)*(abs(vel(1)) + c), & dy(k)*(abs(vel(2)) + c)) & - /maxval(1d0/Re_l) + /maxval(1._wp/Re_l) end if @@ -156,9 +156,9 @@ subroutine s_compute_stability_from_dt(vel, c, rho, Re_l, j, k, l, icfl_sf, vcfl if (any(Re_size > 0)) then - vcfl_sf(j, k, l) = maxval(dt/Re_l/rho)/dx(j)**2d0 + vcfl_sf(j, k, l) = maxval(dt/Re_l/rho)/dx(j)**2._wp - Rc_sf(j, k, l) = dx(j)*(abs(vel(1)) + c)/maxval(1d0/Re_l) + Rc_sf(j, k, l) = dx(j)*(abs(vel(1)) + c)/maxval(1._wp/Re_l) end if @@ -187,10 +187,10 @@ subroutine s_compute_dt_from_cfl(vel, c, max_dt, rho, Re_l, j, k, l) if (grid_geometry == 3) then if (k == 0) then - fltr_dtheta = 2d0*pi*y_cb(0)/3d0 + fltr_dtheta = 2._wp*pi*y_cb(0)/3._wp elseif (k <= fourier_rings) then - Nfq = min(floor(2d0*real(k, wp)*pi), (p + 1)/2 + 1) - fltr_dtheta = 2d0*pi*y_cb(k - 1)/real(Nfq, wp) + Nfq = min(floor(2._wp*real(k, wp)*pi), (p + 1)/2 + 1) + fltr_dtheta = 2._wp*pi*y_cb(k - 1)/real(Nfq, wp) else fltr_dtheta = y_cb(k - 1)*dz(l) end if @@ -210,10 +210,10 @@ subroutine s_compute_dt_from_cfl(vel, c, max_dt, rho, Re_l, j, k, l) if (any(Re_size > 0)) then if (grid_geometry == 3) then - vcfl_dt = cfl_target*(min(dx(j), dy(k), fltr_dtheta)**2d0) & + vcfl_dt = cfl_target*(min(dx(j), dy(k), fltr_dtheta)**2._wp) & /minval(1/(rho*Re_l)) else - vcfl_dt = cfl_target*(min(dx(j), dy(k), dz(l))**2d0) & + vcfl_dt = cfl_target*(min(dx(j), dy(k), dz(l))**2._wp) & /minval(1/(rho*Re_l)) end if end if @@ -224,7 +224,7 @@ subroutine s_compute_dt_from_cfl(vel, c, max_dt, rho, Re_l, j, k, l) dy(k)/(abs(vel(2)) + c)) if (any(Re_size > 0)) then - vcfl_dt = cfl_target*(min(dx(j), dy(k))**2d0)/maxval((1/Re_l)/rho) + vcfl_dt = cfl_target*(min(dx(j), dy(k))**2._wp)/maxval((1/Re_l)/rho) end if else @@ -232,7 +232,7 @@ subroutine s_compute_dt_from_cfl(vel, c, max_dt, rho, Re_l, j, k, l) icfl_dt = cfl_target*(dx(j)/(abs(vel(1)) + c)) if (any(Re_size > 0)) then - vcfl_dt = cfl_target*(dx(j)**2d0)/minval(1/(rho*Re_l)) + vcfl_dt = cfl_target*(dx(j)**2._wp)/minval(1/(rho*Re_l)) end if end if diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 460783d520..e669c2d786 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -285,7 +285,7 @@ contains end if dx(0:m) = x_cb(0:m) - x_cb(-1:m - 1) - x_cc(0:m) = x_cb(-1:m - 1) + dx(0:m)/2d0 + x_cc(0:m) = x_cb(-1:m - 1) + dx(0:m)/2._wp if (ib) then do i = 1, num_ibs @@ -314,7 +314,7 @@ contains end if dy(0:n) = y_cb(0:n) - y_cb(-1:n - 1) - y_cc(0:n) = y_cb(-1:n - 1) + dy(0:n)/2d0 + y_cc(0:n) = y_cb(-1:n - 1) + dy(0:n)/2._wp end if ! ================================================================== @@ -337,7 +337,7 @@ contains end if dz(0:p) = z_cb(0:p) - z_cb(-1:p - 1) - z_cc(0:p) = z_cb(-1:p - 1) + dz(0:p)/2d0 + z_cc(0:p) = z_cb(-1:p - 1) + dz(0:p)/2._wp end if ! ================================================================== @@ -499,7 +499,7 @@ contains ! Computing the cell width distribution dx(0:m) = x_cb(0:m) - x_cb(-1:m - 1) ! Computing the cell center locations - x_cc(0:m) = x_cb(-1:m - 1) + dx(0:m)/2d0 + x_cc(0:m) = x_cb(-1:m - 1) + dx(0:m)/2._wp if (ib) then do i = 1, num_ibs @@ -530,7 +530,7 @@ contains ! Computing the cell width distribution dy(0:n) = y_cb(0:n) - y_cb(-1:n - 1) ! Computing the cell center locations - y_cc(0:n) = y_cb(-1:n - 1) + dy(0:n)/2d0 + y_cc(0:n) = y_cb(-1:n - 1) + dy(0:n)/2._wp if (p > 0) then ! Read in cell boundary locations in z-direction @@ -551,7 +551,7 @@ contains ! Computing the cell width distribution dz(0:p) = z_cb(0:p) - z_cb(-1:p - 1) ! Computing the cell center locations - z_cc(0:p) = z_cb(-1:p - 1) + dz(0:p)/2d0 + z_cc(0:p) = z_cb(-1:p - 1) + dz(0:p)/2._wp end if end if @@ -586,8 +586,8 @@ contains m_MOK = int(m_glb + 1, MPI_OFFSET_KIND) n_MOK = int(n_glb + 1, MPI_OFFSET_KIND) p_MOK = int(p_glb + 1, MPI_OFFSET_KIND) - WP_MOK = int(8d0, MPI_OFFSET_KIND) - MOK = int(1d0, MPI_OFFSET_KIND) + WP_MOK = int(8._wp, MPI_OFFSET_KIND) + MOK = int(1._wp, MPI_OFFSET_KIND) str_MOK = int(name_len, MPI_OFFSET_KIND) NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) @@ -679,8 +679,8 @@ contains m_MOK = int(m_glb + 1, MPI_OFFSET_KIND) n_MOK = int(n_glb + 1, MPI_OFFSET_KIND) p_MOK = int(p_glb + 1, MPI_OFFSET_KIND) - WP_MOK = int(8d0, MPI_OFFSET_KIND) - MOK = int(1d0, MPI_OFFSET_KIND) + WP_MOK = int(8._wp, MPI_OFFSET_KIND) + MOK = int(1._wp, MPI_OFFSET_KIND) str_MOK = int(name_len, MPI_OFFSET_KIND) NVARS_MOK = int(sys_size, MPI_OFFSET_KIND) @@ -859,7 +859,7 @@ contains ! Computing the cell-center locations buffer, at the beginning of ! the coordinate direction, from the cell-width distribution buffer do i = 1, buff_size - x_cc(-i) = x_cc(1 - i) - (dx(1 - i) + dx(-i))/2d0 + x_cc(-i) = x_cc(1 - i) - (dx(1 - i) + dx(-i))/2._wp end do ! Populating the cell-width distribution buffer, at the end of the @@ -890,7 +890,7 @@ contains ! Populating the cell-center locations buffer, at the end of the ! coordinate direction, from buffer of the cell-width distribution do i = 1, buff_size - x_cc(m + i) = x_cc(m + (i - 1)) + (dx(m + (i - 1)) + dx(m + i))/2d0 + x_cc(m + i) = x_cc(m + (i - 1)) + (dx(m + (i - 1)) + dx(m + i))/2._wp end do ! END: Population of Buffers in x-direction ======================== @@ -927,7 +927,7 @@ contains ! Computing the cell-center locations buffer, at the beginning of ! the coordinate direction, from the cell-width distribution buffer do i = 1, buff_size - y_cc(-i) = y_cc(1 - i) - (dy(1 - i) + dy(-i))/2d0 + y_cc(-i) = y_cc(1 - i) - (dy(1 - i) + dy(-i))/2._wp end do ! Populating the cell-width distribution buffer, at the end of the @@ -958,7 +958,7 @@ contains ! Populating the cell-center locations buffer, at the end of the ! coordinate direction, from buffer of the cell-width distribution do i = 1, buff_size - y_cc(n + i) = y_cc(n + (i - 1)) + (dy(n + (i - 1)) + dy(n + i))/2d0 + y_cc(n + i) = y_cc(n + (i - 1)) + (dy(n + (i - 1)) + dy(n + i))/2._wp end do ! END: Population of Buffers in y-direction ======================== @@ -995,7 +995,7 @@ contains ! Computing the cell-center locations buffer, at the beginning of ! the coordinate direction, from the cell-width distribution buffer do i = 1, buff_size - z_cc(-i) = z_cc(1 - i) - (dz(1 - i) + dz(-i))/2d0 + z_cc(-i) = z_cc(1 - i) - (dz(1 - i) + dz(-i))/2._wp end do ! Populating the cell-width distribution buffer, at the end of the @@ -1026,7 +1026,7 @@ contains ! Populating the cell-center locations buffer, at the end of the ! coordinate direction, from buffer of the cell-width distribution do i = 1, buff_size - z_cc(p + i) = z_cc(p + (i - 1)) + (dz(p + (i - 1)) + dz(p + i))/2d0 + z_cc(p + i) = z_cc(p + (i - 1)) + (dz(p + (i - 1)) + dz(p + i))/2._wp end do ! END: Population of Buffers in z-direction ======================== @@ -1060,7 +1060,7 @@ contains call s_convert_to_mixture_variables(v_vf, j, k, l, rho, gamma, pi_inf, qv, Re) - dyn_pres = 0d0 + dyn_pres = 0._wp do i = mom_idx%beg, mom_idx%end dyn_pres = dyn_pres + 5d-1*v_vf(i)%sf(j, k, l)*v_vf(i)%sf(j, k, l) & /max(rho, sgm_eps) @@ -1072,7 +1072,7 @@ contains end do end if - call s_compute_pressure(v_vf(E_idx)%sf(j, k, l), 0d0, & + call s_compute_pressure(v_vf(E_idx)%sf(j, k, l), 0._wp, & dyn_pres, pi_inf, gamma, rho, qv, rhoYks, pres) do i = 1, num_fluids @@ -1120,7 +1120,7 @@ contains if (cfl_dt) then if (proc_rank == 0 .and. mod(t_step - t_step_start, t_step_print) == 0) then print '(" ["I3"%] Time "ES16.6" dt = "ES16.6" @ Time Step = "I8"")', & - int(ceiling(100d0*(mytime/t_stop))), & + int(ceiling(100._wp*(mytime/t_stop))), & mytime, & dt, & t_step @@ -1128,7 +1128,7 @@ contains else if (proc_rank == 0 .and. mod(t_step - t_step_start, t_step_print) == 0) then print '(" ["I3"%] Time step "I8" of "I0" @ t_step = "I0"")', & - int(ceiling(100d0*(real(t_step - t_step_start)/(t_step_stop - t_step_start + 1)))), & + int(ceiling(100._wp*(real(t_step - t_step_start)/(t_step_stop - t_step_start + 1)))), & t_step - t_step_start + 1, & t_step_stop - t_step_start + 1, & t_step @@ -1194,8 +1194,8 @@ contains end if if (proc_rank == 0) then - time_final = 0d0 - io_time_final = 0d0 + time_final = 0._wp + io_time_final = 0._wp if (num_procs == 1) then time_final = time_avg io_time_final = io_time_avg @@ -1300,9 +1300,9 @@ contains end if !Initialize pb based on surface tension for qbmm (polytropic) if (qbmm .and. polytropic .and. (.not. f_is_default(Web))) then - pb0 = pref + 2d0*fluid_pp(1)%ss/(R0*R0ref) + pb0 = pref + 2._wp*fluid_pp(1)%ss/(R0*R0ref) pb0 = pb0/pref - pref = 1d0 + pref = 1._wp end if #if defined(MFC_OpenACC) && defined(MFC_MEMORY_DUMP) diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp index 9b9ac45f5c..ddeb9faaeb 100644 --- a/src/simulation/m_surface_tension.fpp +++ b/src/simulation/m_surface_tension.fpp @@ -114,21 +114,21 @@ contains w1L = gL_x(j, k, l, 1) w2L = gL_x(j, k, l, 2) - w3L = 0d0 + w3L = 0._wp if (p > 0) w3L = gL_x(j, k, l, 3) w1R = gR_x(j + 1, k, l, 1) w2R = gR_x(j + 1, k, l, 2) - w3R = 0d0 + w3R = 0._wp if (p > 0) w3R = gR_x(j + 1, k, l, 3) normWL = gL_x(j, k, l, num_dims + 1) normWR = gR_x(j + 1, k, l, num_dims + 1) - w1 = (w1L + w1R)/2d0 - w2 = (w2L + w2R)/2d0 - w3 = (w3L + w3R)/2d0 - normW = (normWL + normWR)/2d0 + w1 = (w1L + w1R)/2._wp + w2 = (w2L + w2R)/2._wp + w3 = (w3L + w3R)/2._wp + normW = (normWL + normWR)/2._wp if (normW > capillary_cutoff) then @:compute_capilary_stress_tensor() @@ -160,21 +160,21 @@ contains w1L = gL_y(k, j, l, 1) w2L = gL_y(k, j, l, 2) - w3L = 0d0 + w3L = 0._wp if (p > 0) w3L = gL_y(k, j, l, 3) w1R = gR_y(k + 1, j, l, 1) w2R = gR_y(k + 1, j, l, 2) - w3R = 0d0 + w3R = 0._wp if (p > 0) w3R = gR_y(k + 1, j, l, 3) normWL = gL_y(k, j, l, num_dims + 1) normWR = gR_y(k + 1, j, l, num_dims + 1) - w1 = (w1L + w1R)/2d0 - w2 = (w2L + w2R)/2d0 - w3 = (w3L + w3R)/2d0 - normW = (normWL + normWR)/2d0 + w1 = (w1L + w1R)/2._wp + w2 = (w2L + w2R)/2._wp + w3 = (w3L + w3R)/2._wp + normW = (normWL + normWR)/2._wp if (normW > capillary_cutoff) then @:compute_capilary_stress_tensor() @@ -206,21 +206,21 @@ contains w1L = gL_z(l, k, j, 1) w2L = gL_z(l, k, j, 2) - w3L = 0d0 + w3L = 0._wp if (p > 0) w3L = gL_z(l, k, j, 3) w1R = gR_z(l + 1, k, j, 1) w2R = gR_z(l + 1, k, j, 2) - w3R = 0d0 + w3R = 0._wp if (p > 0) w3R = gR_z(l + 1, k, j, 3) normWL = gL_z(l, k, j, num_dims + 1) normWR = gR_z(l + 1, k, j, num_dims + 1) - w1 = (w1L + w1R)/2d0 - w2 = (w2L + w2R)/2d0 - w3 = (w3L + w3R)/2d0 - normW = (normWL + normWR)/2d0 + w1 = (w1L + w1R)/2._wp + w2 = (w2L + w2R)/2._wp + w3 = (w3L + w3R)/2._wp + normW = (normWL + normWR)/2._wp if (normW > capillary_cutoff) then @:compute_capilary_stress_tensor() @@ -263,7 +263,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - c_divs(1)%sf(j, k, l) = 1d0/(x_cc(j + 1) - x_cc(j - 1))* & + c_divs(1)%sf(j, k, l) = 1._wp/(x_cc(j + 1) - x_cc(j - 1))* & (q_prim_vf(c_idx)%sf(j + 1, k, l) - q_prim_vf(c_idx)%sf(j - 1, k, l)) end do end do @@ -273,7 +273,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - c_divs(2)%sf(j, k, l) = 1d0/(y_cc(k + 1) - y_cc(k - 1))* & + c_divs(2)%sf(j, k, l) = 1._wp/(y_cc(k + 1) - y_cc(k - 1))* & (q_prim_vf(c_idx)%sf(j, k + 1, l) - q_prim_vf(c_idx)%sf(j, k - 1, l)) end do end do @@ -284,7 +284,7 @@ contains do l = 0, p do k = 0, n do j = 0, m - c_divs(3)%sf(j, k, l) = 1d0/(z_cc(l + 1) - z_cc(l - 1))* & + c_divs(3)%sf(j, k, l) = 1._wp/(z_cc(l + 1) - z_cc(l - 1))* & (q_prim_vf(c_idx)%sf(j, k, l + 1) - q_prim_vf(c_idx)%sf(j, k, l - 1)) end do end do @@ -295,12 +295,12 @@ contains do l = 0, p do k = 0, n do j = 0, m - c_divs(num_dims + 1)%sf(j, k, l) = 0d0 + c_divs(num_dims + 1)%sf(j, k, l) = 0._wp !s$acc loop seq do i = 1, num_dims c_divs(num_dims + 1)%sf(j, k, l) = & c_divs(num_dims + 1)%sf(j, k, l) + & - c_divs(i)%sf(j, k, l)**2d0 + c_divs(i)%sf(j, k, l)**2._wp end do c_divs(num_dims + 1)%sf(j, k, l) = & sqrt(c_divs(num_dims + 1)%sf(j, k, l)) diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 4bf86eae46..f5b65be4a0 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -541,7 +541,7 @@ contains q_cons_ts(1)%vf(i)%sf(j, k, l) = & (q_cons_ts(1)%vf(i)%sf(j, k, l) & + q_cons_ts(2)%vf(i)%sf(j, k, l) & - + dt*rhs_vf(i)%sf(j, k, l))/2d0 + + dt*rhs_vf(i)%sf(j, k, l))/2._wp end do end do end do @@ -557,7 +557,7 @@ contains pb_ts(1)%sf(j, k, l, q, i) = & (pb_ts(1)%sf(j, k, l, q, i) & + pb_ts(2)%sf(j, k, l, q, i) & - + dt*rhs_pb(j, k, l, q, i))/2d0 + + dt*rhs_pb(j, k, l, q, i))/2._wp end do end do end do @@ -575,7 +575,7 @@ contains mv_ts(1)%sf(j, k, l, q, i) = & (mv_ts(1)%sf(j, k, l, q, i) & + mv_ts(2)%sf(j, k, l, q, i) & - + dt*rhs_mv(j, k, l, q, i))/2d0 + + dt*rhs_mv(j, k, l, q, i))/2._wp end do end do end do @@ -584,7 +584,7 @@ contains end if call nvtxStartRange("body_forces") - if (bodyForces) call s_apply_bodyforces(q_cons_ts(1)%vf, q_prim_vf, rhs_vf, 2d0*dt/3d0) + if (bodyForces) call s_apply_bodyforces(q_cons_ts(1)%vf, q_prim_vf, rhs_vf, 2._wp*dt/3._wp) call nvtxEndRange if (grid_geometry == 3) call s_apply_fourier_filter(q_cons_ts(1)%vf) @@ -724,9 +724,9 @@ contains do k = 0, n do j = 0, m q_cons_ts(2)%vf(i)%sf(j, k, l) = & - (3d0*q_cons_ts(1)%vf(i)%sf(j, k, l) & + (3._wp*q_cons_ts(1)%vf(i)%sf(j, k, l) & + q_cons_ts(2)%vf(i)%sf(j, k, l) & - + dt*rhs_vf(i)%sf(j, k, l))/4d0 + + dt*rhs_vf(i)%sf(j, k, l))/4._wp end do end do end do @@ -740,9 +740,9 @@ contains do j = 0, m do q = 1, nnode pb_ts(2)%sf(j, k, l, q, i) = & - (3d0*pb_ts(1)%sf(j, k, l, q, i) & + (3._wp*pb_ts(1)%sf(j, k, l, q, i) & + pb_ts(2)%sf(j, k, l, q, i) & - + dt*rhs_pb(j, k, l, q, i))/4d0 + + dt*rhs_pb(j, k, l, q, i))/4._wp end do end do end do @@ -758,9 +758,9 @@ contains do j = 0, m do q = 1, nnode mv_ts(2)%sf(j, k, l, q, i) = & - (3d0*mv_ts(1)%sf(j, k, l, q, i) & + (3._wp*mv_ts(1)%sf(j, k, l, q, i) & + mv_ts(2)%sf(j, k, l, q, i) & - + dt*rhs_mv(j, k, l, q, i))/4d0 + + dt*rhs_mv(j, k, l, q, i))/4._wp end do end do end do @@ -769,7 +769,7 @@ contains end if call nvtxStartRange("body_forces") - if (bodyForces) call s_apply_bodyforces(q_cons_ts(2)%vf, q_prim_vf, rhs_vf, dt/4d0) + if (bodyForces) call s_apply_bodyforces(q_cons_ts(2)%vf, q_prim_vf, rhs_vf, dt/4._wp) call nvtxEndRange if (grid_geometry == 3) call s_apply_fourier_filter(q_cons_ts(2)%vf) @@ -799,8 +799,8 @@ contains do j = 0, m q_cons_ts(1)%vf(i)%sf(j, k, l) = & (q_cons_ts(1)%vf(i)%sf(j, k, l) & - + 2d0*q_cons_ts(2)%vf(i)%sf(j, k, l) & - + 2d0*dt*rhs_vf(i)%sf(j, k, l))/3d0 + + 2._wp*q_cons_ts(2)%vf(i)%sf(j, k, l) & + + 2._wp*dt*rhs_vf(i)%sf(j, k, l))/3._wp end do end do end do @@ -815,8 +815,8 @@ contains do q = 1, nnode pb_ts(1)%sf(j, k, l, q, i) = & (pb_ts(1)%sf(j, k, l, q, i) & - + 2d0*pb_ts(2)%sf(j, k, l, q, i) & - + 2d0*dt*rhs_pb(j, k, l, q, i))/3d0 + + 2._wp*pb_ts(2)%sf(j, k, l, q, i) & + + 2._wp*dt*rhs_pb(j, k, l, q, i))/3._wp end do end do end do @@ -833,8 +833,8 @@ contains do q = 1, nnode mv_ts(1)%sf(j, k, l, q, i) = & (mv_ts(1)%sf(j, k, l, q, i) & - + 2d0*mv_ts(2)%sf(j, k, l, q, i) & - + 2d0*dt*rhs_mv(j, k, l, q, i))/3d0 + + 2._wp*mv_ts(2)%sf(j, k, l, q, i) & + + 2._wp*dt*rhs_mv(j, k, l, q, i))/3._wp end do end do end do @@ -843,7 +843,7 @@ contains end if call nvtxStartRange("body_forces") - if (bodyForces) call s_apply_bodyforces(q_cons_ts(1)%vf, q_prim_vf, rhs_vf, 2d0*dt/3d0) + if (bodyForces) call s_apply_bodyforces(q_cons_ts(1)%vf, q_prim_vf, rhs_vf, 2._wp*dt/3._wp) call nvtxEndRange if (grid_geometry == 3) call s_apply_fourier_filter(q_cons_ts(1)%vf) diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp index 004c1d88cb..6056ee157f 100644 --- a/src/simulation/m_viscous.fpp +++ b/src/simulation/m_viscous.fpp @@ -99,7 +99,7 @@ contains do j = is1_viscous%beg, is1_viscous%end !$acc loop seq do i = momxb, E_idx - tau_Re_vf(i)%sf(j, k, l) = 0d0 + tau_Re_vf(i)%sf(j, k, l) = 0._wp end do end do end do @@ -114,16 +114,16 @@ contains do i = 1, num_fluids alpha_rho_visc(i) = q_prim_vf(i)%sf(j, k, l) if (bubbles .and. num_fluids == 1) then - alpha_visc(i) = 1d0 - q_prim_vf(E_idx + i)%sf(j, k, l) + alpha_visc(i) = 1._wp - q_prim_vf(E_idx + i)%sf(j, k, l) else alpha_visc(i) = q_prim_vf(E_idx + i)%sf(j, k, l) end if end do if (bubbles) then - rho_visc = 0d0 - gamma_visc = 0d0 - pi_inf_visc = 0d0 + rho_visc = 0._wp + gamma_visc = 0._wp + pi_inf_visc = 0._wp if (mpp_lim .and. (model_eqns == 2) .and. (num_fluids > 2)) then !$acc loop seq @@ -145,17 +145,17 @@ contains pi_inf_visc = pi_infs(1) end if else - rho_visc = 0d0 - gamma_visc = 0d0 - pi_inf_visc = 0d0 + rho_visc = 0._wp + gamma_visc = 0._wp + pi_inf_visc = 0._wp - alpha_visc_sum = 0d0 + alpha_visc_sum = 0._wp if (mpp_lim) then !$acc loop seq do i = 1, num_fluids - alpha_rho_visc(i) = max(0d0, alpha_rho_visc(i)) - alpha_visc(i) = min(max(0d0, alpha_visc(i)), 1d0) + alpha_rho_visc(i) = max(0._wp, alpha_rho_visc(i)) + alpha_visc(i) = min(max(0._wp, alpha_visc(i)), 1._wp) alpha_visc_sum = alpha_visc_sum + alpha_visc(i) end do @@ -175,14 +175,14 @@ contains do i = 1, 2 Re_visc(i) = dflt_real - if (Re_size(i) > 0) Re_visc(i) = 0d0 + if (Re_size(i) > 0) Re_visc(i) = 0._wp !$acc loop seq do q = 1, Re_size(i) Re_visc(i) = alpha_visc(Re_idx(i, q))/Res_viscous(i, q) & + Re_visc(i) end do - Re_visc(i) = 1d0/max(Re_visc(i), sgm_eps) + Re_visc(i) = 1._wp/max(Re_visc(i), sgm_eps) end do end if @@ -192,10 +192,10 @@ contains grad_x_vf(2)%sf(j, k, l))/ & Re_visc(1) - tau_Re(2, 2) = (4d0*grad_y_vf(2)%sf(j, k, l) & - - 2d0*grad_x_vf(1)%sf(j, k, l) & - - 2d0*q_prim_vf(momxb + 1)%sf(j, k, l)/y_cc(k))/ & - (3d0*Re_visc(1)) + tau_Re(2, 2) = (4._wp*grad_y_vf(2)%sf(j, k, l) & + - 2._wp*grad_x_vf(1)%sf(j, k, l) & + - 2._wp*q_prim_vf(momxb + 1)%sf(j, k, l)/y_cc(k))/ & + (3._wp*Re_visc(1)) !$acc loop seq do i = 1, 2 tau_Re_vf(contxe + i)%sf(j, k, l) = & @@ -221,16 +221,16 @@ contains do i = 1, num_fluids alpha_rho_visc(i) = q_prim_vf(i)%sf(j, k, l) if (bubbles .and. num_fluids == 1) then - alpha_visc(i) = 1d0 - q_prim_vf(E_idx + i)%sf(j, k, l) + alpha_visc(i) = 1._wp - q_prim_vf(E_idx + i)%sf(j, k, l) else alpha_visc(i) = q_prim_vf(E_idx + i)%sf(j, k, l) end if end do if (bubbles) then - rho_visc = 0d0 - gamma_visc = 0d0 - pi_inf_visc = 0d0 + rho_visc = 0._wp + gamma_visc = 0._wp + pi_inf_visc = 0._wp if (mpp_lim .and. (model_eqns == 2) .and. (num_fluids > 2)) then !$acc loop seq @@ -252,17 +252,17 @@ contains pi_inf_visc = pi_infs(1) end if else - rho_visc = 0d0 - gamma_visc = 0d0 - pi_inf_visc = 0d0 + rho_visc = 0._wp + gamma_visc = 0._wp + pi_inf_visc = 0._wp - alpha_visc_sum = 0d0 + alpha_visc_sum = 0._wp if (mpp_lim) then !$acc loop seq do i = 1, num_fluids - alpha_rho_visc(i) = max(0d0, alpha_rho_visc(i)) - alpha_visc(i) = min(max(0d0, alpha_visc(i)), 1d0) + alpha_rho_visc(i) = max(0._wp, alpha_rho_visc(i)) + alpha_visc(i) = min(max(0._wp, alpha_visc(i)), 1._wp) alpha_visc_sum = alpha_visc_sum + alpha_visc(i) end do @@ -282,14 +282,14 @@ contains do i = 1, 2 Re_visc(i) = dflt_real - if (Re_size(i) > 0) Re_visc(i) = 0d0 + if (Re_size(i) > 0) Re_visc(i) = 0._wp !$acc loop seq do q = 1, Re_size(i) Re_visc(i) = alpha_visc(Re_idx(i, q))/Res_viscous(i, q) & + Re_visc(i) end do - Re_visc(i) = 1d0/max(Re_visc(i), sgm_eps) + Re_visc(i) = 1._wp/max(Re_visc(i), sgm_eps) end do end if @@ -325,16 +325,16 @@ contains do i = 1, num_fluids alpha_rho_visc(i) = q_prim_vf(i)%sf(j, k, l) if (bubbles .and. num_fluids == 1) then - alpha_visc(i) = 1d0 - q_prim_vf(E_idx + i)%sf(j, k, l) + alpha_visc(i) = 1._wp - q_prim_vf(E_idx + i)%sf(j, k, l) else alpha_visc(i) = q_prim_vf(E_idx + i)%sf(j, k, l) end if end do if (bubbles) then - rho_visc = 0d0 - gamma_visc = 0d0 - pi_inf_visc = 0d0 + rho_visc = 0._wp + gamma_visc = 0._wp + pi_inf_visc = 0._wp if (mpp_lim .and. (model_eqns == 2) .and. (num_fluids > 2)) then !$acc loop seq @@ -356,17 +356,17 @@ contains pi_inf_visc = pi_infs(1) end if else - rho_visc = 0d0 - gamma_visc = 0d0 - pi_inf_visc = 0d0 + rho_visc = 0._wp + gamma_visc = 0._wp + pi_inf_visc = 0._wp - alpha_visc_sum = 0d0 + alpha_visc_sum = 0._wp if (mpp_lim) then !$acc loop seq do i = 1, num_fluids - alpha_rho_visc(i) = max(0d0, alpha_rho_visc(i)) - alpha_visc(i) = min(max(0d0, alpha_visc(i)), 1d0) + alpha_rho_visc(i) = max(0._wp, alpha_rho_visc(i)) + alpha_visc(i) = min(max(0._wp, alpha_visc(i)), 1._wp) alpha_visc_sum = alpha_visc_sum + alpha_visc(i) end do @@ -386,20 +386,20 @@ contains do i = 1, 2 Re_visc(i) = dflt_real - if (Re_size(i) > 0) Re_visc(i) = 0d0 + if (Re_size(i) > 0) Re_visc(i) = 0._wp !$acc loop seq do q = 1, Re_size(i) Re_visc(i) = alpha_visc(Re_idx(i, q))/Res_viscous(i, q) & + Re_visc(i) end do - Re_visc(i) = 1d0/max(Re_visc(i), sgm_eps) + Re_visc(i) = 1._wp/max(Re_visc(i), sgm_eps) end do end if end if - tau_Re(2, 2) = -(2d0/3d0)*grad_z_vf(3)%sf(j, k, l)/y_cc(k)/ & + tau_Re(2, 2) = -(2._wp/3._wp)*grad_z_vf(3)%sf(j, k, l)/y_cc(k)/ & Re_visc(1) tau_Re(2, 3) = ((grad_z_vf(2)%sf(j, k, l) - & @@ -433,16 +433,16 @@ contains do i = 1, num_fluids alpha_rho_visc(i) = q_prim_vf(i)%sf(j, k, l) if (bubbles .and. num_fluids == 1) then - alpha_visc(i) = 1d0 - q_prim_vf(E_idx + i)%sf(j, k, l) + alpha_visc(i) = 1._wp - q_prim_vf(E_idx + i)%sf(j, k, l) else alpha_visc(i) = q_prim_vf(E_idx + i)%sf(j, k, l) end if end do if (bubbles) then - rho_visc = 0d0 - gamma_visc = 0d0 - pi_inf_visc = 0d0 + rho_visc = 0._wp + gamma_visc = 0._wp + pi_inf_visc = 0._wp if (mpp_lim .and. (model_eqns == 2) .and. (num_fluids > 2)) then !$acc loop seq @@ -464,17 +464,17 @@ contains pi_inf_visc = pi_infs(1) end if else - rho_visc = 0d0 - gamma_visc = 0d0 - pi_inf_visc = 0d0 + rho_visc = 0._wp + gamma_visc = 0._wp + pi_inf_visc = 0._wp - alpha_visc_sum = 0d0 + alpha_visc_sum = 0._wp if (mpp_lim) then !$acc loop seq do i = 1, num_fluids - alpha_rho_visc(i) = max(0d0, alpha_rho_visc(i)) - alpha_visc(i) = min(max(0d0, alpha_visc(i)), 1d0) + alpha_rho_visc(i) = max(0._wp, alpha_rho_visc(i)) + alpha_visc(i) = min(max(0._wp, alpha_visc(i)), 1._wp) alpha_visc_sum = alpha_visc_sum + alpha_visc(i) end do @@ -494,14 +494,14 @@ contains do i = 1, 2 Re_visc(i) = dflt_real - if (Re_size(i) > 0) Re_visc(i) = 0d0 + if (Re_size(i) > 0) Re_visc(i) = 0._wp !$acc loop seq do q = 1, Re_size(i) Re_visc(i) = alpha_visc(Re_idx(i, q))/Res_viscous(i, q) & + Re_visc(i) end do - Re_visc(i) = 1d0/max(Re_visc(i), sgm_eps) + Re_visc(i) = 1._wp/max(Re_visc(i), sgm_eps) end do end if @@ -1235,7 +1235,7 @@ contains !$acc loop seq do i = iv%beg, iv%end dv_ds_vf(i)%sf(j, k, l) = & - 1d0/((1d0 + wa_flg)*dL(j)) & + 1._wp/((1._wp + wa_flg)*dL(j)) & *(wa_flg*vL_vf(i)%sf(j + 1, k, l) & + vR_vf(i)%sf(j, k, l) & - vL_vf(i)%sf(j, k, l) & @@ -1263,7 +1263,7 @@ contains !$acc loop seq do i = iv%beg, iv%end dv_ds_vf(i)%sf(j, k, l) = & - 1d0/((1d0 + wa_flg)*dL(k)) & + 1._wp/((1._wp + wa_flg)*dL(k)) & *(wa_flg*vL_vf(i)%sf(j, k + 1, l) & + vR_vf(i)%sf(j, k, l) & - vL_vf(i)%sf(j, k, l) & @@ -1291,7 +1291,7 @@ contains !$acc loop seq do i = iv%beg, iv%end dv_ds_vf(i)%sf(j, k, l) = & - 1d0/((1d0 + wa_flg)*dL(l)) & + 1._wp/((1._wp + wa_flg)*dL(l)) & *(wa_flg*vL_vf(i)%sf(j, k, l + 1) & + vR_vf(i)%sf(j, k, l) & - vL_vf(i)%sf(j, k, l) & @@ -1397,10 +1397,10 @@ contains do l = is3_viscous%beg, is3_viscous%end do k = is2_viscous%beg, is2_viscous%end grad_x%sf(is1_viscous%beg, k, l) = & - (-3d0*var%sf(is1_viscous%beg, k, l) + 4d0*var%sf(is1_viscous%beg + 1, k, l) - var%sf(is1_viscous%beg + 2, k, l))/ & + (-3._wp*var%sf(is1_viscous%beg, k, l) + 4._wp*var%sf(is1_viscous%beg + 1, k, l) - var%sf(is1_viscous%beg + 2, k, l))/ & (x_cc(is1_viscous%beg + 2) - x_cc(is1_viscous%beg)) grad_x%sf(is1_viscous%end, k, l) = & - (3d0*var%sf(is1_viscous%end, k, l) - 4d0*var%sf(is1_viscous%end - 1, k, l) + var%sf(is1_viscous%end - 2, k, l))/ & + (3._wp*var%sf(is1_viscous%end, k, l) - 4._wp*var%sf(is1_viscous%end - 1, k, l) + var%sf(is1_viscous%end - 2, k, l))/ & (x_cc(is1_viscous%end) - x_cc(is1_viscous%end - 2)) end do end do @@ -1409,10 +1409,10 @@ contains do l = is3_viscous%beg, is3_viscous%end do j = is1_viscous%beg, is1_viscous%end grad_y%sf(j, is2_viscous%beg, l) = & - (-3d0*var%sf(j, is2_viscous%beg, l) + 4d0*var%sf(j, is2_viscous%beg + 1, l) - var%sf(j, is2_viscous%beg + 2, l))/ & + (-3._wp*var%sf(j, is2_viscous%beg, l) + 4._wp*var%sf(j, is2_viscous%beg + 1, l) - var%sf(j, is2_viscous%beg + 2, l))/ & (y_cc(is2_viscous%beg + 2) - y_cc(is2_viscous%beg)) grad_y%sf(j, is2_viscous%end, l) = & - (3d0*var%sf(j, is2_viscous%end, l) - 4d0*var%sf(j, is2_viscous%end - 1, l) + var%sf(j, is2_viscous%end - 2, l))/ & + (3._wp*var%sf(j, is2_viscous%end, l) - 4._wp*var%sf(j, is2_viscous%end - 1, l) + var%sf(j, is2_viscous%end - 2, l))/ & (y_cc(is2_viscous%end) - y_cc(is2_viscous%end - 2)) end do end do @@ -1421,10 +1421,10 @@ contains do k = is2_viscous%beg, is2_viscous%end do j = is1_viscous%beg, is1_viscous%end grad_z%sf(j, k, is3_viscous%beg) = & - (-3d0*var%sf(j, k, is3_viscous%beg) + 4d0*var%sf(j, k, is3_viscous%beg + 1) - var%sf(j, k, is3_viscous%beg + 2))/ & + (-3._wp*var%sf(j, k, is3_viscous%beg) + 4._wp*var%sf(j, k, is3_viscous%beg + 1) - var%sf(j, k, is3_viscous%beg + 2))/ & (z_cc(is3_viscous%beg + 2) - z_cc(is3_viscous%beg)) grad_z%sf(j, k, is3_viscous%end) = & - (3d0*var%sf(j, k, is3_viscous%end) - 4d0*var%sf(j, k, is3_viscous%end - 1) + var%sf(j, k, is3_viscous%end - 2))/ & + (3._wp*var%sf(j, k, is3_viscous%end) - 4._wp*var%sf(j, k, is3_viscous%end - 1) + var%sf(j, k, is3_viscous%end - 2))/ & (z_cc(is3_viscous%end) - z_cc(is3_viscous%end - 2)) end do end do @@ -1435,7 +1435,7 @@ contains !$acc parallel loop collapse(2) gang vector default(present) do l = is3_viscous%beg, is3_viscous%end do k = is2_viscous%beg, is2_viscous%end - grad_x%sf(0, k, l) = (-3d0*var%sf(0, k, l) + 4d0*var%sf(1, k, l) - var%sf(2, k, l))/ & + grad_x%sf(0, k, l) = (-3._wp*var%sf(0, k, l) + 4._wp*var%sf(1, k, l) - var%sf(2, k, l))/ & (x_cc(2) - x_cc(0)) end do end do @@ -1444,7 +1444,7 @@ contains !$acc parallel loop collapse(2) gang vector default(present) do l = is3_viscous%beg, is3_viscous%end do k = is2_viscous%beg, is2_viscous%end - grad_x%sf(m, k, l) = (3d0*var%sf(m, k, l) - 4d0*var%sf(m - 1, k, l) + var%sf(m - 2, k, l))/ & + grad_x%sf(m, k, l) = (3._wp*var%sf(m, k, l) - 4._wp*var%sf(m - 1, k, l) + var%sf(m - 2, k, l))/ & (x_cc(m) - x_cc(m - 2)) end do end do @@ -1454,7 +1454,7 @@ contains !$acc parallel loop collapse(2) gang vector default(present) do l = is3_viscous%beg, is3_viscous%end do j = is1_viscous%beg, is1_viscous%end - grad_y%sf(j, 0, l) = (-3d0*var%sf(j, 0, l) + 4d0*var%sf(j, 1, l) - var%sf(j, 2, l))/ & + grad_y%sf(j, 0, l) = (-3._wp*var%sf(j, 0, l) + 4._wp*var%sf(j, 1, l) - var%sf(j, 2, l))/ & (y_cc(2) - y_cc(0)) end do end do @@ -1463,7 +1463,7 @@ contains !$acc parallel loop collapse(2) gang vector default(present) do l = is3_viscous%beg, is3_viscous%end do j = is1_viscous%beg, is1_viscous%end - grad_y%sf(j, n, l) = (3d0*var%sf(j, n, l) - 4d0*var%sf(j, n - 1, l) + var%sf(j, n - 2, l))/ & + grad_y%sf(j, n, l) = (3._wp*var%sf(j, n, l) - 4._wp*var%sf(j, n - 1, l) + var%sf(j, n - 2, l))/ & (y_cc(n) - y_cc(n - 2)) end do end do @@ -1474,7 +1474,7 @@ contains do k = is2_viscous%beg, is2_viscous%end do j = is1_viscous%beg, is1_viscous%end grad_z%sf(j, k, 0) = & - (-3d0*var%sf(j, k, 0) + 4d0*var%sf(j, k, 1) - var%sf(j, k, 2))/ & + (-3._wp*var%sf(j, k, 0) + 4._wp*var%sf(j, k, 1) - var%sf(j, k, 2))/ & (z_cc(2) - z_cc(0)) end do end do @@ -1484,7 +1484,7 @@ contains do k = is2_viscous%beg, is2_viscous%end do j = is1_viscous%beg, is1_viscous%end grad_z%sf(j, k, p) = & - (3d0*var%sf(j, k, p) - 4d0*var%sf(j, k, p - 1) + var%sf(j, k, p - 2))/ & + (3._wp*var%sf(j, k, p) - 4._wp*var%sf(j, k, p - 1) + var%sf(j, k, p - 2))/ & (z_cc(p) - z_cc(p - 2)) end do end do diff --git a/src/simulation/m_weno.fpp b/src/simulation/m_weno.fpp index 9417186fdc..82cbfc0aab 100644 --- a/src/simulation/m_weno.fpp +++ b/src/simulation/m_weno.fpp @@ -308,13 +308,13 @@ contains d_cbL_${XYZ}$ (0, i + 1) = (s_cb(i - 1) - s_cb(i))/ & (s_cb(i - 1) - s_cb(i + 2)) - d_cbR_${XYZ}$ (1, i + 1) = 1d0 - d_cbR_${XYZ}$ (0, i + 1) - d_cbL_${XYZ}$ (1, i + 1) = 1d0 - d_cbL_${XYZ}$ (0, i + 1) + d_cbR_${XYZ}$ (1, i + 1) = 1._wp - d_cbR_${XYZ}$ (0, i + 1) + d_cbL_${XYZ}$ (1, i + 1) = 1._wp - d_cbL_${XYZ}$ (0, i + 1) - beta_coef_${XYZ}$ (i + 1, 0, 0) = 4d0*(s_cb(i) - s_cb(i + 1))**2d0/ & - (s_cb(i) - s_cb(i + 2))**2d0 - beta_coef_${XYZ}$ (i + 1, 1, 0) = 4d0*(s_cb(i) - s_cb(i + 1))**2d0/ & - (s_cb(i - 1) - s_cb(i + 1))**2d0 + beta_coef_${XYZ}$ (i + 1, 0, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/ & + (s_cb(i) - s_cb(i + 2))**2._wp + beta_coef_${XYZ}$ (i + 1, 1, 0) = 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp/ & + (s_cb(i - 1) - s_cb(i + 1))**2._wp end do @@ -324,13 +324,13 @@ contains ! the WENO reconstruction if (null_weights) then if (bc_s%beg == -4) then - d_cbR_${XYZ}$ (1, 0) = 0d0; d_cbR_${XYZ}$ (0, 0) = 1d0 - d_cbL_${XYZ}$ (1, 0) = 0d0; d_cbL_${XYZ}$ (0, 0) = 1d0 + d_cbR_${XYZ}$ (1, 0) = 0._wp; d_cbR_${XYZ}$ (0, 0) = 1._wp + d_cbL_${XYZ}$ (1, 0) = 0._wp; d_cbL_${XYZ}$ (0, 0) = 1._wp end if if (bc_s%end == -4) then - d_cbR_${XYZ}$ (0, s) = 0d0; d_cbR_${XYZ}$ (1, s) = 1d0 - d_cbL_${XYZ}$ (0, s) = 0d0; d_cbL_${XYZ}$ (1, s) = 1d0 + d_cbR_${XYZ}$ (0, s) = 0._wp; d_cbR_${XYZ}$ (1, s) = 1._wp + d_cbL_${XYZ}$ (0, s) = 0._wp; d_cbL_${XYZ}$ (1, s) = 1._wp end if end if ! END: Computing WENO3 Coefficients ================================ @@ -395,72 +395,72 @@ contains ((s_cb(i) - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3)))/ & ((s_cb(i - 2) - s_cb(i + 2))*(s_cb(i - 2) - s_cb(i + 3))) - d_cbR_${XYZ}$ (1, i + 1) = 1d0 - d_cbR_${XYZ}$ (0, i + 1) - d_cbR_${XYZ}$ (2, i + 1) - d_cbL_${XYZ}$ (1, i + 1) = 1d0 - d_cbL_${XYZ}$ (0, i + 1) - d_cbL_${XYZ}$ (2, i + 1) + d_cbR_${XYZ}$ (1, i + 1) = 1._wp - d_cbR_${XYZ}$ (0, i + 1) - d_cbR_${XYZ}$ (2, i + 1) + d_cbL_${XYZ}$ (1, i + 1) = 1._wp - d_cbL_${XYZ}$ (0, i + 1) - d_cbL_${XYZ}$ (2, i + 1) beta_coef_${XYZ}$ (i + 1, 0, 0) = & - 4d0*(s_cb(i) - s_cb(i + 1))**2d0*(10d0*(s_cb(i + 1) - & - s_cb(i))**2d0 + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - & - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2d0)/((s_cb(i) - & - s_cb(i + 3))**2d0*(s_cb(i + 1) - s_cb(i + 3))**2d0) + 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - & + s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - & + s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/((s_cb(i) - & + s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp) beta_coef_${XYZ}$ (i + 1, 0, 1) = & - 4d0*(s_cb(i) - s_cb(i + 1))**2d0*(19d0*(s_cb(i + 1) - & - s_cb(i))**2d0 - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - & - s_cb(i + 1)) + 2d0*(s_cb(i + 2) - s_cb(i))*((s_cb(i + 2) - & + 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - & + s_cb(i))**2._wp - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - & + s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i))*((s_cb(i + 2) - & s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - & - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3))**2d0*(s_cb(i + 3) - & + s_cb(i + 2))*(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - & s_cb(i + 1))) beta_coef_${XYZ}$ (i + 1, 0, 2) = & - 4d0*(s_cb(i) - s_cb(i + 1))**2d0*(10d0*(s_cb(i + 1) - & - s_cb(i))**2d0 + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - & + 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - & + s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - & s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) + ((s_cb(i + 2) - & - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2d0)/((s_cb(i) - & - s_cb(i + 2))**2d0*(s_cb(i) - s_cb(i + 3))**2d0) + s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - & + s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp) beta_coef_${XYZ}$ (i + 1, 1, 0) = & - 4d0*(s_cb(i) - s_cb(i + 1))**2d0*(10d0*(s_cb(i + 1) - & - s_cb(i))**2d0 + (s_cb(i) - s_cb(i - 1))**2d0 + (s_cb(i) - & + 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - & + s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - & s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) - & - s_cb(i + 2))**2d0*(s_cb(i) - s_cb(i + 2))**2d0) + s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp) beta_coef_${XYZ}$ (i + 1, 1, 1) = & - 4d0*(s_cb(i) - s_cb(i + 1))**2d0*((s_cb(i) - & - s_cb(i + 1))*((s_cb(i) - s_cb(i - 1)) + 20d0*(s_cb(i + 1) - & - s_cb(i))) + (2d0*(s_cb(i) - s_cb(i - 1)) + (s_cb(i + 1) - & + 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - & + s_cb(i + 1))*((s_cb(i) - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - & + s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) + (s_cb(i + 1) - & s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - & - s_cb(i - 1))*(s_cb(i - 1) - s_cb(i + 2))**2d0*(s_cb(i + 2) - & + s_cb(i - 1))*(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - & s_cb(i))) beta_coef_${XYZ}$ (i + 1, 1, 2) = & - 4d0*(s_cb(i) - s_cb(i + 1))**2d0*(10d0*(s_cb(i + 1) - & - s_cb(i))**2d0 + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - & - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2d0)/ & - ((s_cb(i - 1) - s_cb(i + 1))**2d0*(s_cb(i - 1) - & - s_cb(i + 2))**2d0) + 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - & + s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - & + s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/ & + ((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - & + s_cb(i + 2))**2._wp) beta_coef_${XYZ}$ (i + 1, 2, 0) = & - 4d0*(s_cb(i) - s_cb(i + 1))**2d0*(12d0*(s_cb(i + 1) - & - s_cb(i))**2d0 + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - & - s_cb(i - 1)))**2d0 + 3d0*((s_cb(i) - s_cb(i - 2)) + & + 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - & + s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - & + s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) - s_cb(i - 2)) + & (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/ & - ((s_cb(i - 2) - s_cb(i + 1))**2d0*(s_cb(i - 1) - & - s_cb(i + 1))**2d0) + ((s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - & + s_cb(i + 1))**2._wp) beta_coef_${XYZ}$ (i + 1, 2, 1) = & - 4d0*(s_cb(i) - s_cb(i + 1))**2d0*(19d0*(s_cb(i + 1) - & - s_cb(i))**2d0 + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - & - s_cb(i + 1))) + 2d0*(s_cb(i + 1) - s_cb(i - 1))*((s_cb(i) - & + 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - & + s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - & + s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i - 1))*((s_cb(i) - & s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) - & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2d0*(s_cb(i + 1) - & + s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - & s_cb(i - 1))) beta_coef_${XYZ}$ (i + 1, 2, 2) = & - 4d0*(s_cb(i) - s_cb(i + 1))**2d0*(10d0*(s_cb(i + 1) - & - s_cb(i))**2d0 + (s_cb(i) - s_cb(i - 1))**2d0 + (s_cb(i) - & + 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - & + s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - & s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) - & - s_cb(i))**2d0*(s_cb(i - 2) - s_cb(i + 1))**2d0) + s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp) end do @@ -470,17 +470,17 @@ contains ! the WENO reconstruction if (null_weights) then if (bc_s%beg == -4) then - d_cbR_${XYZ}$ (1:2, 0) = 0d0; d_cbR_${XYZ}$ (0, 0) = 1d0 - d_cbL_${XYZ}$ (1:2, 0) = 0d0; d_cbL_${XYZ}$ (0, 0) = 1d0 - d_cbR_${XYZ}$ (2, 1) = 0d0; d_cbR_${XYZ}$ (:, 1) = d_cbR_${XYZ}$ (:, 1)/sum(d_cbR_${XYZ}$ (:, 1)) - d_cbL_${XYZ}$ (2, 1) = 0d0; d_cbL_${XYZ}$ (:, 1) = d_cbL_${XYZ}$ (:, 1)/sum(d_cbL_${XYZ}$ (:, 1)) + d_cbR_${XYZ}$ (1:2, 0) = 0._wp; d_cbR_${XYZ}$ (0, 0) = 1._wp + d_cbL_${XYZ}$ (1:2, 0) = 0._wp; d_cbL_${XYZ}$ (0, 0) = 1._wp + d_cbR_${XYZ}$ (2, 1) = 0._wp; d_cbR_${XYZ}$ (:, 1) = d_cbR_${XYZ}$ (:, 1)/sum(d_cbR_${XYZ}$ (:, 1)) + d_cbL_${XYZ}$ (2, 1) = 0._wp; d_cbL_${XYZ}$ (:, 1) = d_cbL_${XYZ}$ (:, 1)/sum(d_cbL_${XYZ}$ (:, 1)) end if if (bc_s%end == -4) then - d_cbR_${XYZ}$ (0, s - 1) = 0d0; d_cbR_${XYZ}$ (:, s - 1) = d_cbR_${XYZ}$ (:, s - 1)/sum(d_cbR_${XYZ}$ (:, s - 1)) - d_cbL_${XYZ}$ (0, s - 1) = 0d0; d_cbL_${XYZ}$ (:, s - 1) = d_cbL_${XYZ}$ (:, s - 1)/sum(d_cbL_${XYZ}$ (:, s - 1)) - d_cbR_${XYZ}$ (0:1, s) = 0d0; d_cbR_${XYZ}$ (2, s) = 1d0 - d_cbL_${XYZ}$ (0:1, s) = 0d0; d_cbL_${XYZ}$ (2, s) = 1d0 + d_cbR_${XYZ}$ (0, s - 1) = 0._wp; d_cbR_${XYZ}$ (:, s - 1) = d_cbR_${XYZ}$ (:, s - 1)/sum(d_cbR_${XYZ}$ (:, s - 1)) + d_cbL_${XYZ}$ (0, s - 1) = 0._wp; d_cbL_${XYZ}$ (:, s - 1) = d_cbL_${XYZ}$ (:, s - 1)/sum(d_cbL_${XYZ}$ (:, s - 1)) + d_cbR_${XYZ}$ (0:1, s) = 0._wp; d_cbR_${XYZ}$ (2, s) = 1._wp + d_cbL_${XYZ}$ (0:1, s) = 0._wp; d_cbL_${XYZ}$ (2, s) = 1._wp end if end if end if @@ -611,13 +611,13 @@ contains elseif (mapped_weno) then alpha = d_cbL_${XYZ}$ (:, j)/(beta*beta) omega = alpha/sum(alpha) - alpha = (d_cbL_${XYZ}$ (:, j)*(1d0 + d_cbL_${XYZ}$ (:, j) - 3d0*omega) + omega**2d0) & - *(omega/(d_cbL_${XYZ}$ (:, j)**2d0 + omega*(1d0 - 2d0*d_cbL_${XYZ}$ (:, j)))) + alpha = (d_cbL_${XYZ}$ (:, j)*(1._wp + d_cbL_${XYZ}$ (:, j) - 3._wp*omega) + omega**2._wp) & + *(omega/(d_cbL_${XYZ}$ (:, j)**2._wp + omega*(1._wp - 2._wp*d_cbL_${XYZ}$ (:, j)))) elseif (wenoz) then ! Borges, et al. (2008) tau5 = abs(beta(1) - beta(0)) - alpha = d_cbL_${XYZ}$ (:, j)*(1d0 + tau5/beta) + alpha = d_cbL_${XYZ}$ (:, j)*(1._wp + tau5/beta) end if @@ -638,11 +638,11 @@ contains elseif (mapped_weno) then alpha = d_cbR_${XYZ}$ (:, j)/(beta*beta) omega = alpha/sum(alpha) - alpha = (d_cbR_${XYZ}$ (:, j)*(1d0 + d_cbR_${XYZ}$ (:, j) - 3d0*omega) + omega**2d0) & - *(omega/(d_cbR_${XYZ}$ (:, j)**2d0 + omega*(1d0 - 2d0*d_cbR_${XYZ}$ (:, j)))) + alpha = (d_cbR_${XYZ}$ (:, j)*(1._wp + d_cbR_${XYZ}$ (:, j) - 3._wp*omega) + omega**2._wp) & + *(omega/(d_cbR_${XYZ}$ (:, j)**2._wp + omega*(1._wp - 2._wp*d_cbR_${XYZ}$ (:, j)))) elseif (wenoz) then - alpha = d_cbR_${XYZ}$ (:, j)*(1d0 + tau5/beta) + alpha = d_cbR_${XYZ}$ (:, j)*(1._wp + tau5/beta) end if @@ -706,21 +706,21 @@ contains elseif (mapped_weno) then alpha = d_cbL_${XYZ}$ (:, j)/(beta*beta) omega = alpha/sum(alpha) - alpha = (d_cbL_${XYZ}$ (:, j)*(1d0 + d_cbL_${XYZ}$ (:, j) - 3d0*omega) + omega**2d0) & - *(omega/(d_cbL_${XYZ}$ (:, j)**2d0 + omega*(1d0 - 2d0*d_cbL_${XYZ}$ (:, j)))) + alpha = (d_cbL_${XYZ}$ (:, j)*(1._wp + d_cbL_${XYZ}$ (:, j) - 3._wp*omega) + omega**2._wp) & + *(omega/(d_cbL_${XYZ}$ (:, j)**2._wp + omega*(1._wp - 2._wp*d_cbL_${XYZ}$ (:, j)))) elseif (wenoz) then ! Borges, et al. (2008) tau5 = abs(beta(2) - beta(0)) ! Equation 25 - alpha = d_cbL_${XYZ}$ (:, j)*(1d0 + tau5/beta) ! Equation 28 (note: weno_eps was already added to beta) + alpha = d_cbL_${XYZ}$ (:, j)*(1._wp + tau5/beta) ! Equation 28 (note: weno_eps was already added to beta) elseif (teno) then ! Fu, et al. (2016) ! Fu's code: https://dx.doi.org/10.13140/RG.2.2.36250.34247 tau5 = abs(beta(2) - beta(0)) - alpha = (1d0 + tau5/beta)**6d0 ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6) + alpha = (1._wp + tau5/beta)**6._wp ! Equation 22 (reuse alpha as gamma; pick C=1 & q=6) omega = alpha/sum(alpha) ! Equation 25 (reuse omega as xi) - delta = merge(0d0, 1d0, omega < teno_CT) ! Equation 26 + delta = merge(0._wp, 1._wp, omega < teno_CT) ! Equation 26 alpha = delta*d_cbL_${XYZ}$ (:, j) ! Equation 27 end if @@ -747,11 +747,11 @@ contains elseif (mapped_weno) then alpha = d_cbR_${XYZ}$ (:, j)/(beta*beta) omega = alpha/sum(alpha) - alpha = (d_cbR_${XYZ}$ (:, j)*(1d0 + d_cbR_${XYZ}$ (:, j) - 3d0*omega) + omega**2d0) & - *(omega/(d_cbR_${XYZ}$ (:, j)**2d0 + omega*(1d0 - 2d0*d_cbR_${XYZ}$ (:, j)))) + alpha = (d_cbR_${XYZ}$ (:, j)*(1._wp + d_cbR_${XYZ}$ (:, j) - 3._wp*omega) + omega**2._wp) & + *(omega/(d_cbR_${XYZ}$ (:, j)**2._wp + omega*(1._wp - 2._wp*d_cbR_${XYZ}$ (:, j)))) elseif (wenoz) then - alpha = d_cbR_${XYZ}$ (:, j)*(1d0 + tau5/beta) + alpha = d_cbR_${XYZ}$ (:, j)*(1._wp + tau5/beta) elseif (teno) then alpha = delta*d_cbR_${XYZ}$ (:, j) @@ -932,18 +932,18 @@ contains real(wp) :: vL_min, vR_min real(wp) :: vL_max, vR_max - real(wp), parameter :: alpha = 2d0 !> + real(wp), parameter :: alpha = 2._wp !> !! Determines the maximum Courant–Friedrichs–Lewy (CFL) number that !! may be utilized with the scheme. In theory, for stability, a CFL !! number less than 1/(1+alpha) is necessary. The default value for !! alpha is 2. - real(wp), parameter :: beta = 4d0/3d0 !< + real(wp), parameter :: beta = 4._wp/3._wp !< !! Determines the amount of freedom available from utilizing a large !! value for the local curvature. The default value for beta is 4/3. - real(wp), parameter :: alpha_mp = 2d0 - real(wp), parameter :: beta_mp = 4d0/3d0 + real(wp), parameter :: alpha_mp = 2._wp + real(wp), parameter :: beta_mp = 4._wp/3._wp !$acc parallel loop gang vector collapse (4) default(present) private(d) do l = is3_weno%beg, is3_weno%end @@ -953,27 +953,27 @@ contains d(-1) = v_rs_ws(j, k, l, i) & + v_rs_ws(j - 2, k, l, i) & - v_rs_ws(j - 1, k, l, i) & - *2d0 + *2._wp d(0) = v_rs_ws(j + 1, k, l, i) & + v_rs_ws(j - 1, k, l, i) & - v_rs_ws(j, k, l, i) & - *2d0 + *2._wp d(1) = v_rs_ws(j + 2, k, l, i) & + v_rs_ws(j, k, l, i) & - v_rs_ws(j + 1, k, l, i) & - *2d0 + *2._wp - d_MD = (sign(1d0, 4d0*d(-1) - d(0)) + sign(1d0, 4d0*d(0) - d(-1))) & - *abs((sign(1d0, 4d0*d(-1) - d(0)) + sign(1d0, d(-1))) & - *(sign(1d0, 4d0*d(-1) - d(0)) + sign(1d0, d(0)))) & - *min(abs(4d0*d(-1) - d(0)), abs(d(-1)), & - abs(4d0*d(0) - d(-1)), abs(d(0)))/8d0 + d_MD = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1))) & + *abs((sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1))) & + *(sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, d(0)))) & + *min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), & + abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp - d_LC = (sign(1d0, 4d0*d(0) - d(1)) + sign(1d0, 4d0*d(1) - d(0))) & - *abs((sign(1d0, 4d0*d(0) - d(1)) + sign(1d0, d(0))) & - *(sign(1d0, 4d0*d(0) - d(1)) + sign(1d0, d(1)))) & - *min(abs(4d0*d(0) - d(1)), abs(d(0)), & - abs(4d0*d(1) - d(0)), abs(d(1)))/8d0 + d_LC = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0))) & + *abs((sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, d(0))) & + *(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, d(1)))) & + *min(abs(4._wp*d(0) - d(1)), abs(d(0)), & + abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp vL_UL = v_rs_ws(j, k, l, i) & - (v_rs_ws(j + 1, k, l, i) & @@ -1012,27 +1012,27 @@ contains d(-1) = v_rs_ws(j, k, l, i) & + v_rs_ws(j - 2, k, l, i) & - v_rs_ws(j - 1, k, l, i) & - *2d0 + *2._wp d(0) = v_rs_ws(j + 1, k, l, i) & + v_rs_ws(j - 1, k, l, i) & - v_rs_ws(j, k, l, i) & - *2d0 + *2._wp d(1) = v_rs_ws(j + 2, k, l, i) & + v_rs_ws(j, k, l, i) & - v_rs_ws(j + 1, k, l, i) & - *2d0 - - d_MD = (sign(1d0, 4d0*d(0) - d(1)) + sign(1d0, 4d0*d(1) - d(0))) & - *abs((sign(1d0, 4d0*d(0) - d(1)) + sign(1d0, d(0))) & - *(sign(1d0, 4d0*d(0) - d(1)) + sign(1d0, d(1)))) & - *min(abs(4d0*d(0) - d(1)), abs(d(0)), & - abs(4d0*d(1) - d(0)), abs(d(1)))/8d0 - - d_LC = (sign(1d0, 4d0*d(-1) - d(0)) + sign(1d0, 4d0*d(0) - d(-1))) & - *abs((sign(1d0, 4d0*d(-1) - d(0)) + sign(1d0, d(-1))) & - *(sign(1d0, 4d0*d(-1) - d(0)) + sign(1d0, d(0)))) & - *min(abs(4d0*d(-1) - d(0)), abs(d(-1)), & - abs(4d0*d(0) - d(-1)), abs(d(0)))/8d0 + *2._wp + + d_MD = (sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, 4._wp*d(1) - d(0))) & + *abs((sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, d(0))) & + *(sign(1._wp, 4._wp*d(0) - d(1)) + sign(1._wp, d(1)))) & + *min(abs(4._wp*d(0) - d(1)), abs(d(0)), & + abs(4._wp*d(1) - d(0)), abs(d(1)))/8._wp + + d_LC = (sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, 4._wp*d(0) - d(-1))) & + *abs((sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, d(-1))) & + *(sign(1._wp, 4._wp*d(-1) - d(0)) + sign(1._wp, d(0)))) & + *min(abs(4._wp*d(-1) - d(0)), abs(d(-1)), & + abs(4._wp*d(0) - d(-1)), abs(d(0)))/8._wp vR_UL = v_rs_ws(j, k, l, i) & + (v_rs_ws(j, k, l, i) & diff --git a/src/simulation/p_main.fpp b/src/simulation/p_main.fpp index 37c13f5743..b167e42c64 100644 --- a/src/simulation/p_main.fpp +++ b/src/simulation/p_main.fpp @@ -54,7 +54,7 @@ program p_main else t_step = t_step_start if (t_step == 0) then - mytime = 0d0 + mytime = 0._wp else mytime = t_step*dt end if From 5ea9a80dba7bd36dce83cf6acf4d667a31ccbfb4 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Fri, 20 Sep 2024 14:26:12 -0700 Subject: [PATCH 03/68] Replace MPI_DOUBLE_PRECISION with constant declared in common, fix bugs with syscheck module --- src/common/m_eigen_solver.f90 | 2 +- src/common/m_mpi_common.fpp | 26 +-- src/common/m_phase_change.fpp | 6 +- src/common/m_precision_select.f90 | 2 +- src/post_process/m_data_input.f90 | 18 +- src/post_process/m_derived_variables.fpp | 6 +- src/post_process/m_mpi_proxy.fpp | 204 +++++++++++------------ src/pre_process/m_data_output.fpp | 26 +-- src/pre_process/m_grid.f90 | 6 +- src/pre_process/m_mpi_proxy.fpp | 18 +- src/pre_process/m_patches.fpp | 4 +- src/pre_process/m_start_up.fpp | 14 +- src/simulation/m_bubbles.fpp | 2 +- src/simulation/m_cbc.fpp | 4 +- src/simulation/m_data_output.fpp | 18 +- src/simulation/m_hypoelastic.fpp | 16 +- src/simulation/m_mpi_proxy.fpp | 82 ++++----- src/simulation/m_rhs.fpp | 6 +- src/simulation/m_riemann_solvers.fpp | 42 ++--- src/simulation/m_start_up.fpp | 32 ++-- src/simulation/m_weno.fpp | 70 ++++---- src/syscheck/syscheck.fpp | 2 +- 22 files changed, 303 insertions(+), 303 deletions(-) diff --git a/src/common/m_eigen_solver.f90 b/src/common/m_eigen_solver.f90 index 2c24806385..80198afbbb 100644 --- a/src/common/m_eigen_solver.f90 +++ b/src/common/m_eigen_solver.f90 @@ -354,7 +354,7 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) integer :: i, j, k, l, ml, en, ii, jj, ll, nn, ip1, itn, its, lp1, enm1, iend real(wp) :: si, sr, ti, tr, xi, xr, xxi, xxr, yi, yr, zzi, zzr, & - norm, tst1, tst2, c, d + norm, tst1, tst2, c, d ! ierr = 0 ! .......... initialize eigenvector matrix .......... diff --git a/src/common/m_mpi_common.fpp b/src/common/m_mpi_common.fpp index 0f7994fafe..28da5fcee8 100644 --- a/src/common/m_mpi_common.fpp +++ b/src/common/m_mpi_common.fpp @@ -118,7 +118,7 @@ contains ! Define the view for each variable do i = 1, sys_size call MPI_TYPE_CREATE_SUBARRAY(num_dims, sizes_glb, sizes_loc, start_idx, & - MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), ierr) + MPI_ORDER_FORTRAN, mpi_p, MPI_IO_DATA%view(i), ierr) call MPI_TYPE_COMMIT(MPI_IO_DATA%view(i), ierr) end do @@ -126,7 +126,7 @@ contains if (qbmm .and. .not. polytropic) then do i = sys_size + 1, sys_size + 2*nb*4 call MPI_TYPE_CREATE_SUBARRAY(num_dims, sizes_glb, sizes_loc, start_idx, & - MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), ierr) + MPI_ORDER_FORTRAN, mpi_p, MPI_IO_DATA%view(i), ierr) call MPI_TYPE_COMMIT(MPI_IO_DATA%view(i), ierr) end do @@ -167,7 +167,7 @@ contains #endif call MPI_TYPE_CREATE_SUBARRAY(1, airfoil_glb, airfoil_loc, airfoil_start, & - MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, MPI_IO_airfoil_IB_DATA%view(1), ierr) + MPI_ORDER_FORTRAN, mpi_p, MPI_IO_airfoil_IB_DATA%view(1), ierr) call MPI_TYPE_COMMIT(MPI_IO_airfoil_IB_DATA%view(1), ierr) #ifdef MFC_PRE_PROCESS @@ -177,7 +177,7 @@ contains end do #endif call MPI_TYPE_CREATE_SUBARRAY(1, airfoil_glb, airfoil_loc, airfoil_start, & - MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, MPI_IO_airfoil_IB_DATA%view(2), ierr) + MPI_ORDER_FORTRAN, mpi_p, MPI_IO_airfoil_IB_DATA%view(2), ierr) call MPI_TYPE_COMMIT(MPI_IO_airfoil_IB_DATA%view(2), ierr) end if @@ -197,7 +197,7 @@ contains #ifdef MFC_MPI - call MPI_GATHER(time_avg, 1, MPI_DOUBLE_PRECISION, proc_time(0), 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_GATHER(time_avg, 1, mpi_p, proc_time(0), 1, mpi_p, 0, MPI_COMM_WORLD, ierr) #endif @@ -242,15 +242,15 @@ contains ! Reducing local extrema of ICFL, VCFL, CCFL and Rc numbers to their ! global extrema and bookkeeping the results on the rank 0 processor call MPI_REDUCE(icfl_max_loc, icfl_max_glb, 1, & - MPI_DOUBLE_PRECISION, MPI_MAX, 0, & + mpi_p, MPI_MAX, 0, & MPI_COMM_WORLD, ierr) if (any(Re_size > 0)) then call MPI_REDUCE(vcfl_max_loc, vcfl_max_glb, 1, & - MPI_DOUBLE_PRECISION, MPI_MAX, 0, & + mpi_p, MPI_MAX, 0, & MPI_COMM_WORLD, ierr) call MPI_REDUCE(Rc_min_loc, Rc_min_glb, 1, & - MPI_DOUBLE_PRECISION, MPI_MIN, 0, & + mpi_p, MPI_MIN, 0, & MPI_COMM_WORLD, ierr) end if @@ -274,7 +274,7 @@ contains #ifdef MFC_MPI ! Performing the reduction procedure - call MPI_ALLREDUCE(var_loc, var_glb, 1, MPI_DOUBLE_PRECISION, & + call MPI_ALLREDUCE(var_loc, var_glb, 1, mpi_p, & MPI_SUM, MPI_COMM_WORLD, ierr) #endif @@ -296,7 +296,7 @@ contains #ifdef MFC_MPI ! Performing the reduction procedure - call MPI_ALLREDUCE(var_loc, var_glb, 1, MPI_DOUBLE_PRECISION, & + call MPI_ALLREDUCE(var_loc, var_glb, 1, mpi_p, & MPI_MIN, MPI_COMM_WORLD, ierr) #endif @@ -318,7 +318,7 @@ contains #ifdef MFC_MPI ! Performing the reduction procedure - call MPI_ALLREDUCE(var_loc, var_glb, 1, MPI_DOUBLE_PRECISION, & + call MPI_ALLREDUCE(var_loc, var_glb, 1, mpi_p, & MPI_MAX, MPI_COMM_WORLD, ierr) #endif @@ -342,10 +342,10 @@ contains ! Performing reduction procedure and eventually storing its result ! into the variable that was initially inputted into the subroutine - call MPI_REDUCE(var_loc, var_glb, 1, MPI_DOUBLE_PRECISION, & + call MPI_REDUCE(var_loc, var_glb, 1, mpi_p, & MPI_MIN, 0, MPI_COMM_WORLD, ierr) - call MPI_BCAST(var_glb, 1, MPI_DOUBLE_PRECISION, & + call MPI_BCAST(var_glb, 1, mpi_p, & 0, MPI_COMM_WORLD, ierr) var_loc = var_glb diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 2fe110d92c..9264a14b62 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -382,7 +382,7 @@ contains ! updating common pressure for the newton solver pS = pO + ((1.0_wp - gp)/gpp)/(1.0_wp - (1.0_wp - gp + DABS(1.0_wp - gp)) & - /(2.0_wp*gpp)*hp) + /(2.0_wp*gpp)*hp) end do ! common temperature @@ -430,8 +430,8 @@ contains p_infpTg = p_infpT if (((pS < 0.0_wp) .and. ((q_cons_vf(lp + contxb - 1)%sf(j, k, l) & - + q_cons_vf(vp + contxb - 1)%sf(j, k, l)) > ((rhoe & - - gs_min(lp)*ps_inf(lp)/(gs_min(lp) - 1))/qvs(lp)))) .or. & + + q_cons_vf(vp + contxb - 1)%sf(j, k, l)) > ((rhoe & + - gs_min(lp)*ps_inf(lp)/(gs_min(lp) - 1))/qvs(lp)))) .or. & ((pS >= 0.0_wp) .and. (pS < 1.0d-1))) then ! improve this initial condition diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90 index f9dde6ffbd..a95ffbb736 100644 --- a/src/common/m_precision_select.f90 +++ b/src/common/m_precision_select.f90 @@ -20,4 +20,4 @@ module m_precision_select integer, parameter :: mpi_p = -100 #endif -end module m_precision_select \ No newline at end of file +end module m_precision_select diff --git a/src/post_process/m_data_input.f90 b/src/post_process/m_data_input.f90 index ba9543ec4f..4977f3a004 100644 --- a/src/post_process/m_data_input.f90 +++ b/src/post_process/m_data_input.f90 @@ -283,7 +283,7 @@ subroutine s_read_parallel_data_files(t_step) if (file_exist) then data_size = m_glb + 2 call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr) - call MPI_FILE_READ(ifile, x_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) + call MPI_FILE_READ(ifile, x_cb_glb, data_size, mpi_p, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting...') @@ -304,7 +304,7 @@ subroutine s_read_parallel_data_files(t_step) if (file_exist) then data_size = n_glb + 2 call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr) - call MPI_FILE_READ(ifile, y_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) + call MPI_FILE_READ(ifile, y_cb_glb, data_size, mpi_p, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting...') @@ -325,7 +325,7 @@ subroutine s_read_parallel_data_files(t_step) if (file_exist) then data_size = p_glb + 2 call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr) - call MPI_FILE_READ(ifile, z_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) + call MPI_FILE_READ(ifile, z_cb_glb, data_size, mpi_p, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting...') @@ -375,14 +375,14 @@ subroutine s_read_parallel_data_files(t_step) var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_READ_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do else do i = 1, adv_idx%end var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_READ_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do end if @@ -451,10 +451,10 @@ subroutine s_read_parallel_data_files(t_step) ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) call MPI_FILE_READ_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do else do i = 1, sys_size @@ -463,10 +463,10 @@ subroutine s_read_parallel_data_files(t_step) ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) call MPI_FILE_READ_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do end if diff --git a/src/post_process/m_derived_variables.fpp b/src/post_process/m_derived_variables.fpp index 7705ecda1b..536d4289f5 100644 --- a/src/post_process/m_derived_variables.fpp +++ b/src/post_process/m_derived_variables.fpp @@ -208,7 +208,7 @@ contains blkmod2 = ((fluid_pp(2)%gamma + 1._wp)*q_prim_vf(E_idx)%sf(i, j, k) + & fluid_pp(2)%pi_inf)/fluid_pp(2)%gamma q_sf(i, j, k) = (1._wp/(rho_sf(i, j, k)*(q_prim_vf(adv_idx%beg)%sf(i, j, k)/blkmod1 + & - (1._wp - q_prim_vf(adv_idx%beg)%sf(i, j, k))/blkmod2))) + (1._wp - q_prim_vf(adv_idx%beg)%sf(i, j, k))/blkmod2))) end if if (mixture_err .and. q_sf(i, j, k) < 0._wp) then @@ -237,8 +237,8 @@ contains type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf real(wp), dimension(-offset_x%beg:m + offset_x%end, & - -offset_y%beg:n + offset_y%end, & - -offset_z%beg:p + offset_z%end), & + -offset_y%beg:n + offset_y%end, & + -offset_z%beg:p + offset_z%end), & intent(inout) :: q_sf real(wp) :: top, bottom, slope !< Flux limiter calcs diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp index e057d55bd9..f121ee1e40 100644 --- a/src/post_process/m_mpi_proxy.fpp +++ b/src/post_process/m_mpi_proxy.fpp @@ -181,19 +181,19 @@ contains call MPI_BCAST(alpha_wrt(1), num_fluids_max, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) do i = 1, num_fluids_max - call MPI_BCAST(fluid_pp(i)%gamma, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - call MPI_BCAST(fluid_pp(i)%pi_inf, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - call MPI_BCAST(fluid_pp(i)%cv, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - call MPI_BCAST(fluid_pp(i)%qv, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - call MPI_BCAST(fluid_pp(i)%qvp, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) - call MPI_BCAST(fluid_pp(i)%G, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(fluid_pp(i)%gamma, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(fluid_pp(i)%pi_inf, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(fluid_pp(i)%cv, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(fluid_pp(i)%qv, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(fluid_pp(i)%qvp, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(fluid_pp(i)%G, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) end do #:for VAR in [ 'pref', 'rhoref', 'R0ref', 'poly_sigma', 'Web', 'Ca', & & 'Re_inv', 'sigma', 't_save', 't_stop' ] - call MPI_BCAST(${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(${VAR}$, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) #:endfor - call MPI_BCAST(schlieren_alpha(1), num_fluids_max, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(schlieren_alpha(1), num_fluids_max, mpi_p, 0, MPI_COMM_WORLD, ierr) #endif end subroutine s_mpi_bcast_user_inputs @@ -262,7 +262,7 @@ contains tmp_num_procs_y = num_procs_y tmp_num_procs_z = num_procs_z fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - - (n + 1)/tmp_num_procs_y) + - (n + 1)/tmp_num_procs_y) ! Searching for optimal computational domain distribution do i = 1, num_procs @@ -306,9 +306,9 @@ contains tmp_num_procs_y = num_procs_y tmp_num_procs_z = num_procs_z fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - - (n + 1)/tmp_num_procs_y) & + - (n + 1)/tmp_num_procs_y) & + 10._wp*abs((n + 1)/tmp_num_procs_y & - - (p + 1)/tmp_num_procs_z) + - (p + 1)/tmp_num_procs_z) ! Searching for optimal computational domain distribution do i = 1, num_procs @@ -448,7 +448,7 @@ contains tmp_num_procs_x = num_procs_x tmp_num_procs_y = num_procs_y fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - - (n + 1)/tmp_num_procs_y) + - (n + 1)/tmp_num_procs_y) ! Searching for optimal computational domain distribution do i = 1, num_procs @@ -666,9 +666,9 @@ contains ! Sending/receiving the data to/from bc_x%end/bc_x%beg call MPI_SENDRECV(dx(m - buff_size + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_x%end, 0, & + mpi_p, bc_x%end, 0, & dx(-buff_size), buff_size, & - MPI_DOUBLE_PRECISION, bc_x%beg, 0, & + mpi_p, bc_x%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -677,9 +677,9 @@ contains ! Sending/receiving the data to/from bc_x%beg/bc_x%beg call MPI_SENDRECV(dx(0), buff_size, & - MPI_DOUBLE_PRECISION, bc_x%beg, 1, & + mpi_p, bc_x%beg, 1, & dx(-buff_size), buff_size, & - MPI_DOUBLE_PRECISION, bc_x%beg, 0, & + mpi_p, bc_x%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -692,9 +692,9 @@ contains ! Sending/receiving the data to/from bc_x%beg/bc_x%end call MPI_SENDRECV(dx(0), buff_size, & - MPI_DOUBLE_PRECISION, bc_x%beg, 1, & + mpi_p, bc_x%beg, 1, & dx(m + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_x%end, 1, & + mpi_p, bc_x%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -703,9 +703,9 @@ contains ! Sending/receiving the data to/from bc_x%end/bc_x%end call MPI_SENDRECV(dx(m - buff_size + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_x%end, 0, & + mpi_p, bc_x%end, 0, & dx(m + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_x%end, 1, & + mpi_p, bc_x%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -726,9 +726,9 @@ contains ! Sending/receiving the data to/from bc_y%end/bc_y%beg call MPI_SENDRECV(dy(n - buff_size + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_y%end, 0, & + mpi_p, bc_y%end, 0, & dy(-buff_size), buff_size, & - MPI_DOUBLE_PRECISION, bc_y%beg, 0, & + mpi_p, bc_y%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -737,9 +737,9 @@ contains ! Sending/receiving the data to/from bc_y%beg/bc_y%beg call MPI_SENDRECV(dy(0), buff_size, & - MPI_DOUBLE_PRECISION, bc_y%beg, 1, & + mpi_p, bc_y%beg, 1, & dy(-buff_size), buff_size, & - MPI_DOUBLE_PRECISION, bc_y%beg, 0, & + mpi_p, bc_y%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -752,9 +752,9 @@ contains ! Sending/receiving the data to/from bc_y%beg/bc_y%end call MPI_SENDRECV(dy(0), buff_size, & - MPI_DOUBLE_PRECISION, bc_y%beg, 1, & + mpi_p, bc_y%beg, 1, & dy(n + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_y%end, 1, & + mpi_p, bc_y%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -763,9 +763,9 @@ contains ! Sending/receiving the data to/from bc_y%end/bc_y%end call MPI_SENDRECV(dy(n - buff_size + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_y%end, 0, & + mpi_p, bc_y%end, 0, & dy(n + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_y%end, 1, & + mpi_p, bc_y%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -786,9 +786,9 @@ contains ! Sending/receiving the data to/from bc_z%end/bc_z%beg call MPI_SENDRECV(dz(p - buff_size + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_z%end, 0, & + mpi_p, bc_z%end, 0, & dz(-buff_size), buff_size, & - MPI_DOUBLE_PRECISION, bc_z%beg, 0, & + mpi_p, bc_z%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -797,9 +797,9 @@ contains ! Sending/receiving the data to/from bc_z%beg/bc_z%beg call MPI_SENDRECV(dz(0), buff_size, & - MPI_DOUBLE_PRECISION, bc_z%beg, 1, & + mpi_p, bc_z%beg, 1, & dz(-buff_size), buff_size, & - MPI_DOUBLE_PRECISION, bc_z%beg, 0, & + mpi_p, bc_z%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -812,9 +812,9 @@ contains ! Sending/receiving the data to/from bc_z%beg/bc_z%end call MPI_SENDRECV(dz(0), buff_size, & - MPI_DOUBLE_PRECISION, bc_z%beg, 1, & + mpi_p, bc_z%beg, 1, & dz(p + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_z%end, 1, & + mpi_p, bc_z%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -823,9 +823,9 @@ contains ! Sending/receiving the data to/from bc_z%end/bc_z%end call MPI_SENDRECV(dz(p - buff_size + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_z%end, 0, & + mpi_p, bc_z%end, 0, & dz(p + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_z%end, 1, & + mpi_p, bc_z%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -889,10 +889,10 @@ contains ! Sending/receiving the data to/from bc_x%end/bc_x%beg call MPI_SENDRECV(q_cons_buffer_out(0), & buff_size*sys_size*(n + 1)*(p + 1), & - MPI_DOUBLE_PRECISION, bc_x%end, 0, & + mpi_p, bc_x%end, 0, & q_cons_buffer_in(0), & buff_size*sys_size*(n + 1)*(p + 1), & - MPI_DOUBLE_PRECISION, bc_x%beg, 0, & + mpi_p, bc_x%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -917,10 +917,10 @@ contains ! Sending/receiving the data to/from bc_x%beg/bc_x%beg call MPI_SENDRECV(q_cons_buffer_out(0), & buff_size*sys_size*(n + 1)*(p + 1), & - MPI_DOUBLE_PRECISION, bc_x%beg, 1, & + mpi_p, bc_x%beg, 1, & q_cons_buffer_in(0), & buff_size*sys_size*(n + 1)*(p + 1), & - MPI_DOUBLE_PRECISION, bc_x%beg, 0, & + mpi_p, bc_x%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -969,10 +969,10 @@ contains ! Sending/receiving the data to/from bc_x%beg/bc_x%end call MPI_SENDRECV(q_cons_buffer_out(0), & buff_size*sys_size*(n + 1)*(p + 1), & - MPI_DOUBLE_PRECISION, bc_x%beg, 1, & + mpi_p, bc_x%beg, 1, & q_cons_buffer_in(0), & buff_size*sys_size*(n + 1)*(p + 1), & - MPI_DOUBLE_PRECISION, bc_x%end, 1, & + mpi_p, bc_x%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -997,10 +997,10 @@ contains ! Sending/receiving the data to/from bc_x%end/bc_x%end call MPI_SENDRECV(q_cons_buffer_out(0), & buff_size*sys_size*(n + 1)*(p + 1), & - MPI_DOUBLE_PRECISION, bc_x%end, 0, & + mpi_p, bc_x%end, 0, & q_cons_buffer_in(0), & buff_size*sys_size*(n + 1)*(p + 1), & - MPI_DOUBLE_PRECISION, bc_x%end, 1, & + mpi_p, bc_x%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -1059,11 +1059,11 @@ contains ! Sending/receiving the data to/from bc_y%end/bc_y%beg call MPI_SENDRECV(q_cons_buffer_out(0), buff_size* & sys_size*(m + 2*buff_size + 1)* & - (p + 1), MPI_DOUBLE_PRECISION, & + (p + 1), mpi_p, & bc_y%end, 0, q_cons_buffer_in(0), & buff_size*sys_size* & (m + 2*buff_size + 1)*(p + 1), & - MPI_DOUBLE_PRECISION, bc_y%beg, 0, & + mpi_p, bc_y%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -1089,11 +1089,11 @@ contains ! Sending/receiving the data to/from bc_y%beg/bc_y%beg call MPI_SENDRECV(q_cons_buffer_out(0), buff_size* & sys_size*(m + 2*buff_size + 1)* & - (p + 1), MPI_DOUBLE_PRECISION, & + (p + 1), mpi_p, & bc_y%beg, 1, q_cons_buffer_in(0), & buff_size*sys_size* & (m + 2*buff_size + 1)*(p + 1), & - MPI_DOUBLE_PRECISION, bc_y%beg, 0, & + mpi_p, bc_y%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -1144,11 +1144,11 @@ contains ! Sending/receiving the data to/from bc_y%beg/bc_y%end call MPI_SENDRECV(q_cons_buffer_out(0), buff_size* & sys_size*(m + 2*buff_size + 1)* & - (p + 1), MPI_DOUBLE_PRECISION, & + (p + 1), mpi_p, & bc_y%beg, 1, q_cons_buffer_in(0), & buff_size*sys_size* & (m + 2*buff_size + 1)*(p + 1), & - MPI_DOUBLE_PRECISION, bc_y%end, 1, & + mpi_p, bc_y%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -1175,11 +1175,11 @@ contains ! Sending/receiving the data to/from bc_y%end/bc_y%end call MPI_SENDRECV(q_cons_buffer_out(0), buff_size* & sys_size*(m + 2*buff_size + 1)* & - (p + 1), MPI_DOUBLE_PRECISION, & + (p + 1), mpi_p, & bc_y%end, 0, q_cons_buffer_in(0), & buff_size*sys_size* & (m + 2*buff_size + 1)*(p + 1), & - MPI_DOUBLE_PRECISION, bc_y%end, 1, & + mpi_p, bc_y%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -1241,11 +1241,11 @@ contains call MPI_SENDRECV(q_cons_buffer_out(0), buff_size* & sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1), & - MPI_DOUBLE_PRECISION, bc_z%end, 0, & + mpi_p, bc_z%end, 0, & q_cons_buffer_in(0), buff_size* & sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1), & - MPI_DOUBLE_PRECISION, bc_z%beg, 0, & + mpi_p, bc_z%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -1273,11 +1273,11 @@ contains call MPI_SENDRECV(q_cons_buffer_out(0), buff_size* & sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1), & - MPI_DOUBLE_PRECISION, bc_z%beg, 1, & + mpi_p, bc_z%beg, 1, & q_cons_buffer_in(0), buff_size* & sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1), & - MPI_DOUBLE_PRECISION, bc_z%beg, 0, & + mpi_p, bc_z%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -1331,11 +1331,11 @@ contains call MPI_SENDRECV(q_cons_buffer_out(0), buff_size* & sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1), & - MPI_DOUBLE_PRECISION, bc_z%beg, 1, & + mpi_p, bc_z%beg, 1, & q_cons_buffer_in(0), buff_size* & sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1), & - MPI_DOUBLE_PRECISION, bc_z%end, 1, & + mpi_p, bc_z%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -1364,11 +1364,11 @@ contains call MPI_SENDRECV(q_cons_buffer_out(0), buff_size* & sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1), & - MPI_DOUBLE_PRECISION, bc_z%end, 0, & + mpi_p, bc_z%end, 0, & q_cons_buffer_in(0), buff_size* & sys_size*(m + 2*buff_size + 1)* & (n + 2*buff_size + 1), & - MPI_DOUBLE_PRECISION, bc_z%end, 1, & + mpi_p, bc_z%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, & ierr) @@ -1422,102 +1422,102 @@ contains if (p > 0) then if (grid_geometry == 3) then ! Minimum spatial extent in the r-direction - call MPI_GATHERV(minval(y_cb), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(minval(y_cb), 1, mpi_p, & spatial_extents(1, 0), recvcounts, 6*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) ! Minimum spatial extent in the theta-direction - call MPI_GATHERV(minval(z_cb), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(minval(z_cb), 1, mpi_p, & spatial_extents(2, 0), recvcounts, 6*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) ! Minimum spatial extent in the z-direction - call MPI_GATHERV(minval(x_cb), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(minval(x_cb), 1, mpi_p, & spatial_extents(3, 0), recvcounts, 6*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) ! Maximum spatial extent in the r-direction - call MPI_GATHERV(maxval(y_cb), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(maxval(y_cb), 1, mpi_p, & spatial_extents(4, 0), recvcounts, 6*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) ! Maximum spatial extent in the theta-direction - call MPI_GATHERV(maxval(z_cb), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(maxval(z_cb), 1, mpi_p, & spatial_extents(5, 0), recvcounts, 6*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) ! Maximum spatial extent in the z-direction - call MPI_GATHERV(maxval(x_cb), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(maxval(x_cb), 1, mpi_p, & spatial_extents(6, 0), recvcounts, 6*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) else ! Minimum spatial extent in the x-direction - call MPI_GATHERV(minval(x_cb), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(minval(x_cb), 1, mpi_p, & spatial_extents(1, 0), recvcounts, 6*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) ! Minimum spatial extent in the y-direction - call MPI_GATHERV(minval(y_cb), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(minval(y_cb), 1, mpi_p, & spatial_extents(2, 0), recvcounts, 6*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) ! Minimum spatial extent in the z-direction - call MPI_GATHERV(minval(z_cb), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(minval(z_cb), 1, mpi_p, & spatial_extents(3, 0), recvcounts, 6*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) ! Maximum spatial extent in the x-direction - call MPI_GATHERV(maxval(x_cb), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(maxval(x_cb), 1, mpi_p, & spatial_extents(4, 0), recvcounts, 6*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) ! Maximum spatial extent in the y-direction - call MPI_GATHERV(maxval(y_cb), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(maxval(y_cb), 1, mpi_p, & spatial_extents(5, 0), recvcounts, 6*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) ! Maximum spatial extent in the z-direction - call MPI_GATHERV(maxval(z_cb), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(maxval(z_cb), 1, mpi_p, & spatial_extents(6, 0), recvcounts, 6*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) end if ! Simulation is 2D else ! Minimum spatial extent in the x-direction - call MPI_GATHERV(minval(x_cb), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(minval(x_cb), 1, mpi_p, & spatial_extents(1, 0), recvcounts, 4*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) ! Minimum spatial extent in the y-direction - call MPI_GATHERV(minval(y_cb), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(minval(y_cb), 1, mpi_p, & spatial_extents(2, 0), recvcounts, 4*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) ! Maximum spatial extent in the x-direction - call MPI_GATHERV(maxval(x_cb), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(maxval(x_cb), 1, mpi_p, & spatial_extents(3, 0), recvcounts, 4*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) ! Maximum spatial extent in the y-direction - call MPI_GATHERV(maxval(y_cb), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(maxval(y_cb), 1, mpi_p, & spatial_extents(4, 0), recvcounts, 4*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) end if @@ -1538,17 +1538,17 @@ contains ! Silo-HDF5 database format if (format == 1) then - call MPI_GATHERV(x_cc(0), m + 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(x_cc(0), m + 1, mpi_p, & x_root_cc(0), recvcounts, displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) ! Binary database format else - call MPI_GATHERV(x_cb(0), m + 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(x_cb(0), m + 1, mpi_p, & x_root_cb(0), recvcounts, displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, & + mpi_p, 0, MPI_COMM_WORLD, & ierr) if (proc_rank == 0) x_root_cb(-1) = x_cb(-1) @@ -1578,14 +1578,14 @@ contains #ifdef MFC_MPI ! Minimum flow variable extent - call MPI_GATHERV(minval(q_sf), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(minval(q_sf), 1, mpi_p, & data_extents(1, 0), recvcounts, 2*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + mpi_p, 0, MPI_COMM_WORLD, ierr) ! Maximum flow variable extent - call MPI_GATHERV(maxval(q_sf), 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(maxval(q_sf), 1, mpi_p, & data_extents(2, 0), recvcounts, 2*displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + mpi_p, 0, MPI_COMM_WORLD, ierr) #endif @@ -1612,9 +1612,9 @@ contains ! Gathering the sub-domain flow variable data from all the processes ! and putting it back together for the entire computational domain ! on the process with rank 0 - call MPI_GATHERV(q_sf(0, 0, 0), m + 1, MPI_DOUBLE_PRECISION, & + call MPI_GATHERV(q_sf(0, 0, 0), m + 1, mpi_p, & q_root_sf(0, 0, 0), recvcounts, displs, & - MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + mpi_p, 0, MPI_COMM_WORLD, ierr) #endif diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp index c76ea65452..53c1a2fc18 100644 --- a/src/pre_process/m_data_output.fpp +++ b/src/pre_process/m_data_output.fpp @@ -570,7 +570,7 @@ contains var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do !Additional variables pb and mv for non-polytropic qbmm if (qbmm .and. .not. polytropic) then @@ -578,7 +578,7 @@ contains var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do end if else @@ -587,7 +587,7 @@ contains var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do end if @@ -635,10 +635,10 @@ contains ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do !Additional variables pb and mv for non-polytropic qbmm if (qbmm .and. .not. polytropic) then @@ -648,10 +648,10 @@ contains ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do end if else @@ -662,10 +662,10 @@ contains ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do end if @@ -712,10 +712,10 @@ contains ! Initial displacement to skip at beginning of file disp = 0 - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_airfoil_IB_DATA%view(1), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_airfoil_IB_DATA%view(1), & 'native', mpi_info_int, ierr) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_airfoil_IB_DATA%var(1:Np), 3*Np, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) @@ -731,10 +731,10 @@ contains ! Initial displacement to skip at beginning of file disp = 0 - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_airfoil_IB_DATA%view(2), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_airfoil_IB_DATA%view(2), & 'native', mpi_info_int, ierr) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_airfoil_IB_DATA%var(Np + 1:2*Np), 3*Np, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) end if diff --git a/src/pre_process/m_grid.f90 b/src/pre_process/m_grid.f90 index c2178a8161..9f8e02918e 100644 --- a/src/pre_process/m_grid.f90 +++ b/src/pre_process/m_grid.f90 @@ -316,7 +316,7 @@ subroutine s_generate_parallel_grid data_size = m_glb + 2 call MPI_FILE_OPEN(MPI_COMM_SELF, file_loc, ior(MPI_MODE_WRONLY, MPI_MODE_CREATE), & mpi_info_int, ifile, ierr) - call MPI_FILE_WRITE(ifile, x_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) + call MPI_FILE_WRITE(ifile, x_cb_glb, data_size, mpi_p, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) if (n > 0) then @@ -324,7 +324,7 @@ subroutine s_generate_parallel_grid data_size = n_glb + 2 call MPI_FILE_OPEN(MPI_COMM_SELF, file_loc, ior(MPI_MODE_WRONLY, MPI_MODE_CREATE), & mpi_info_int, ifile, ierr) - call MPI_FILE_WRITE(ifile, y_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) + call MPI_FILE_WRITE(ifile, y_cb_glb, data_size, mpi_p, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) if (p > 0) then @@ -332,7 +332,7 @@ subroutine s_generate_parallel_grid data_size = p_glb + 2 call MPI_FILE_OPEN(MPI_COMM_SELF, file_loc, ior(MPI_MODE_WRONLY, MPI_MODE_CREATE), & mpi_info_int, ifile, ierr) - call MPI_FILE_WRITE(ifile, z_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) + call MPI_FILE_WRITE(ifile, z_cb_glb, data_size, mpi_p, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) end if end if diff --git a/src/pre_process/m_mpi_proxy.fpp b/src/pre_process/m_mpi_proxy.fpp index de0ad29d95..a54d23c928 100644 --- a/src/pre_process/m_mpi_proxy.fpp +++ b/src/pre_process/m_mpi_proxy.fpp @@ -69,7 +69,7 @@ contains & 'Web', 'Ca', 'Re_inv', 'sigR', 'sigV', 'rhoRV', 'palpha_eps', & & 'ptgalpha_eps', 'sigma', 'pi_fac', 'mixlayer_vel_coef', & & 'mixlayer_domain' ] - call MPI_BCAST(${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(${VAR}$, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) #:endfor do i = 1, num_patches_max @@ -85,14 +85,14 @@ contains & 'beta', 'smooth_coeff', 'rho', 'p0', 'm0', 'r0', 'v0', & & 'pres', 'gamma', 'pi_inf', 'hcid', 'cv', 'qv', 'qvp', & & 'model%threshold', 'cf_val'] - call MPI_BCAST(patch_icpp(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(patch_icpp(i)%${VAR}$, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) #:endfor call MPI_BCAST(patch_icpp(i)%model%filepath, len(patch_icpp(i)%model%filepath), MPI_CHARACTER, 0, MPI_COMM_WORLD, ierr) #:for VAR in [ 'model%translate', 'model%scale', 'model%rotate', & 'normal', 'radii', 'vel', 'tau_e', 'alpha_rho', 'alpha' ] - call MPI_BCAST(patch_icpp(i)%${VAR}$, size(patch_icpp(i)%${VAR}$), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(patch_icpp(i)%${VAR}$, size(patch_icpp(i)%${VAR}$), mpi_p, 0, MPI_COMM_WORLD, ierr) #:endfor call MPI_BCAST(patch_icpp(i)%model%spc, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) @@ -101,7 +101,7 @@ contains call MPI_BCAST(patch_ib(i)%geometry, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) #:for VAR in [ 'x_centroid', 'y_centroid', 'z_centroid', & & 'length_x', 'length_y', 'length_z', 'radius', 'c', 'p', 't', 'm', 'theta', 'slip'] - call MPI_BCAST(patch_ib(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(patch_ib(i)%${VAR}$, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) #:endfor end do @@ -109,7 +109,7 @@ contains do i = 1, num_fluids_max #:for VAR in [ 'gamma','pi_inf','mul0','ss','pv','gamma_v','M_v', & & 'mu_v','k_v', 'G', 'cv', 'qv', 'qvp' ] - call MPI_BCAST(fluid_pp(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(fluid_pp(i)%${VAR}$, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) #:endfor end do #endif @@ -180,7 +180,7 @@ contains tmp_num_procs_y = num_procs_y tmp_num_procs_z = num_procs_z fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - - (n + 1)/tmp_num_procs_y) + - (n + 1)/tmp_num_procs_y) ! Searching for optimal computational domain distribution do i = 1, num_procs @@ -224,9 +224,9 @@ contains tmp_num_procs_y = num_procs_y tmp_num_procs_z = num_procs_z fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - - (n + 1)/tmp_num_procs_y) & + - (n + 1)/tmp_num_procs_y) & + 10._wp*abs((n + 1)/tmp_num_procs_y & - - (p + 1)/tmp_num_procs_z) + - (p + 1)/tmp_num_procs_z) ! Searching for optimal computational domain distribution do i = 1, num_procs @@ -358,7 +358,7 @@ contains tmp_num_procs_x = num_procs_x tmp_num_procs_y = num_procs_y fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - - (n + 1)/tmp_num_procs_y) + - (n + 1)/tmp_num_procs_y) ! Searching for optimal computational domain distribution do i = 1, num_procs diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index 30eb6f67c0..815ca4551a 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -1507,7 +1507,7 @@ contains elseif (epsilon == 4._wp) then if (beta == 0._wp) then H = 3._wp/16._wp*sqrt(1._wp/pi)*(35._wp*cos(sph_phi)**4._wp - & - 3d1*cos(sph_phi)**2 + 3._wp) + 3d1*cos(sph_phi)**2 + 3._wp) elseif (beta == 1._wp) then H = -3._wp/8._wp*sqrt(5._wp/pi)*exp(cmplx_i*z_cc(k))* & sin(sph_phi)*(7._wp*cos(sph_phi)**3._wp - 3._wp*cos(sph_phi)) @@ -1524,7 +1524,7 @@ contains elseif (epsilon == 5._wp) then if (beta == 0._wp) then H = 1._wp/16._wp*sqrt(11._wp/pi)*(63._wp*cos(sph_phi)**5._wp - & - 7d1*cos(sph_phi)**3._wp + 15._wp*cos(sph_phi)) + 7d1*cos(sph_phi)**3._wp + 15._wp*cos(sph_phi)) elseif (beta == 1._wp) then H = -1._wp/16._wp*sqrt(165._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))* & sin(sph_phi)*(21._wp*cos(sph_phi)**4._wp - 14._wp*cos(sph_phi)**2 + 1._wp) diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index 5c31bafb10..8f3580c323 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -562,7 +562,7 @@ contains if (file_exist) then data_size = m_glb + 2 call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr) - call MPI_FILE_READ_ALL(ifile, x_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) + call MPI_FILE_READ_ALL(ifile, x_cb_glb, data_size, mpi_p, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting... ') @@ -587,7 +587,7 @@ contains if (file_exist) then data_size = n_glb + 2 call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr) - call MPI_FILE_READ_ALL(ifile, y_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) + call MPI_FILE_READ_ALL(ifile, y_cb_glb, data_size, mpi_p, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting... ') @@ -612,7 +612,7 @@ contains if (file_exist) then data_size = p_glb + 2 call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr) - call MPI_FILE_READ_ALL(ifile, z_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) + call MPI_FILE_READ_ALL(ifile, z_cb_glb, data_size, mpi_p, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting... ') @@ -706,10 +706,10 @@ contains ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do if (qbmm .and. .not. polytropic) then @@ -719,10 +719,10 @@ contains ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do end if diff --git a/src/simulation/m_bubbles.fpp b/src/simulation/m_bubbles.fpp index e2b0c8a2fd..3e2400641f 100644 --- a/src/simulation/m_bubbles.fpp +++ b/src/simulation/m_bubbles.fpp @@ -929,7 +929,7 @@ contains *(mass_n0(iR0) + mass_v0(iR0))/(mass_n0(iR0) + fmass_v) grad_T = -Re_trans_T(iR0)*(T_bar - Tw) f_bpres_dot = 3._wp*gamma_m*(-fV*fpb + fvflux*R_v*Tw & - + pb0(iR0)*k_mw*grad_T/Pe_T(iR0)/fR)/fR + + pb0(iR0)*k_mw*grad_T/Pe_T(iR0)/fR)/fR else f_bpres_dot = -3._wp*gamma_m*fV/fR*(fpb - pv) end if diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index b0508b8ff0..03c6a89d00 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -483,8 +483,8 @@ contains fd_coef_${XYZ}$ (:, cbc_loc_in) = 0._wp fd_coef_${XYZ}$ (0, cbc_loc_in) = -50._wp/(25._wp*ds(0) + 2._wp*ds(1) & - - 1d1*ds(2) + 1d1*ds(3) & - - 3._wp*ds(4)) + - 1d1*ds(2) + 1d1*ds(3) & + - 3._wp*ds(4)) fd_coef_${XYZ}$ (1, cbc_loc_in) = -48._wp*fd_coef_${XYZ}$ (0, cbc_loc_in)/25._wp fd_coef_${XYZ}$ (2, cbc_loc_in) = 36._wp*fd_coef_${XYZ}$ (0, cbc_loc_in)/25._wp fd_coef_${XYZ}$ (3, cbc_loc_in) = -16._wp*fd_coef_${XYZ}$ (0, cbc_loc_in)/25._wp diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 5bdd29cad2..f5231c85e4 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -820,7 +820,7 @@ contains var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do !Write pb and mv for non-polytropic qbmm if (qbmm .and. .not. polytropic) then @@ -828,7 +828,7 @@ contains var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do end if else @@ -836,7 +836,7 @@ contains var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do end if @@ -879,10 +879,10 @@ contains ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do !Write pb and mv for non-polytropic qbmm if (qbmm .and. .not. polytropic) then @@ -892,10 +892,10 @@ contains ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do end if else @@ -905,10 +905,10 @@ contains ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do end if diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index 4b18d26664..1b66e0df2b 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -229,7 +229,7 @@ contains q_prim_vf(strxb + 1)%sf(k, l, q)*dv_dy(k, l, q) - & q_prim_vf(strxb + 1)%sf(k, l, q)*dv_dy(k, l, q) + & 2._wp*G_K_field(k, l, q)*(1._wp/2._wp)*(du_dy(k, l, q) + & - dv_dx(k, l, q))) + dv_dx(k, l, q))) rhs_vf(strxb + 2)%sf(k, l, q) = rhs_vf(strxb + 2)%sf(k, l, q) + rho_K_field(k, l, q)* & (q_prim_vf(strxb + 1)%sf(k, l, q)*dv_dx(k, l, q) + & @@ -239,8 +239,8 @@ contains q_prim_vf(strxb + 2)%sf(k, l, q)*dv_dy(k, l, q) - & q_prim_vf(strxb + 2)%sf(k, l, q)*dv_dy(k, l, q) + & 2._wp*G_K_field(k, l, q)*(dv_dy(k, l, q) - (1._wp/3._wp)* & - (du_dx(k, l, q) + & - dv_dy(k, l, q)))) + (du_dx(k, l, q) + & + dv_dy(k, l, q)))) end do end do end do @@ -278,7 +278,7 @@ contains q_prim_vf(strxb + 3)%sf(k, l, q)*dw_dz(k, l, q) - & q_prim_vf(strxb + 3)%sf(k, l, q)*dw_dz(k, l, q) + & 2._wp*G_K_field(k, l, q)*(1._wp/2._wp)*(du_dz(k, l, q) + & - dw_dx(k, l, q))) + dw_dx(k, l, q))) rhs_vf(strxb + 4)%sf(k, l, q) = rhs_vf(strxb + 4)%sf(k, l, q) + rho_K_field(k, l, q)* & (q_prim_vf(strxb + 3)%sf(k, l, q)*dv_dx(k, l, q) + & @@ -291,7 +291,7 @@ contains q_prim_vf(strxb + 4)%sf(k, l, q)*dw_dz(k, l, q) - & q_prim_vf(strxb + 4)%sf(k, l, q)*dw_dz(k, l, q) + & 2._wp*G_K_field(k, l, q)*(1._wp/2._wp)*(dv_dz(k, l, q) + & - dw_dy(k, l, q))) + dw_dy(k, l, q))) rhs_vf(strxe)%sf(k, l, q) = rhs_vf(strxe)%sf(k, l, q) + rho_K_field(k, l, q)* & (q_prim_vf(strxe - 2)%sf(k, l, q)*dw_dx(k, l, q) + & @@ -304,9 +304,9 @@ contains q_prim_vf(strxe)%sf(k, l, q)*dw_dz(k, l, q) - & q_prim_vf(strxe)%sf(k, l, q)*dw_dz(k, l, q) + & 2._wp*G_K_field(k, l, q)*(dw_dz(k, l, q) - (1._wp/3._wp)* & - (du_dx(k, l, q) + & - dv_dy(k, l, q) + & - dw_dz(k, l, q)))) + (du_dx(k, l, q) + & + dv_dy(k, l, q) + & + dw_dz(k, l, q)))) end do end do end do diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index bbea5bb7b2..8bff7e8c52 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -183,7 +183,7 @@ contains #:for VAR in ['k_x', 'k_y', 'k_z', 'w_x', 'w_y', 'w_z', 'p_x', 'p_y', & & 'p_z', 'g_x', 'g_y', 'g_z'] - call MPI_BCAST(${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(${VAR}$, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) #:endfor #:for VAR in ['t_step_old', 'm', 'n', 'p', 'm_glb', 'n_glb', 'p_glb', & @@ -220,7 +220,7 @@ contains & 'bc_z%vb1','bc_z%vb2','bc_z%vb3','bc_z%ve1','bc_z%ve2','bc_z%ve3', & & 'x_domain%beg', 'x_domain%end', 'y_domain%beg', 'y_domain%end', & & 'z_domain%beg', 'z_domain%end', 't_stop', 't_save', 'cfl_target'] - call MPI_BCAST(${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(${VAR}$, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) #:endfor #:if not MFC_CASE_OPTIMIZATION @@ -235,22 +235,22 @@ contains do i = 1, num_fluids_max #:for VAR in [ 'gamma','pi_inf','mul0','ss','pv','gamma_v','M_v', & & 'mu_v','k_v','G', 'cv', 'qv', 'qvp' ] - call MPI_BCAST(fluid_pp(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(fluid_pp(i)%${VAR}$, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) #:endfor - call MPI_BCAST(fluid_pp(i)%Re(1), 2, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(fluid_pp(i)%Re(1), 2, mpi_p, 0, MPI_COMM_WORLD, ierr) end do do i = 1, num_ibs #:for VAR in [ 'radius', 'length_x', 'length_y', & & 'x_centroid', 'y_centroid', 'c', 'm', 'p', 't', 'theta', 'slip' ] - call MPI_BCAST(patch_ib(i)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(patch_ib(i)%${VAR}$, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) #:endfor call MPI_BCAST(patch_ib(i)%geometry, 2, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) end do do j = 1, num_probes_max do i = 1, 3 - call MPI_BCAST(acoustic(j)%loc(i), 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(acoustic(j)%loc(i), 1, mpi_p, 0, MPI_COMM_WORLD, ierr) end do call MPI_BCAST(acoustic(j)%dipole, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr) @@ -263,15 +263,15 @@ contains 'wavelength', 'frequency', 'gauss_sigma_dist', 'gauss_sigma_time', & 'npulse', 'dir', 'delay', 'foc_length', 'aperture', & 'element_spacing_angle', 'element_polygon_ratio', 'rotate_angle' ] - call MPI_BCAST(acoustic(j)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(acoustic(j)%${VAR}$, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) #:endfor #:for VAR in [ 'x','y','z' ] - call MPI_BCAST(probe(j)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(probe(j)%${VAR}$, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) #:endfor #:for VAR in [ 'xmin', 'xmax', 'ymin', 'ymax', 'zmin', 'zmax' ] - call MPI_BCAST(integral(j)%${VAR}$, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr) + call MPI_BCAST(integral(j)%${VAR}$, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) #:endfor end do @@ -335,7 +335,7 @@ contains tmp_num_procs_y = num_procs_y tmp_num_procs_z = num_procs_z fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - - (n + 1)/tmp_num_procs_y) + - (n + 1)/tmp_num_procs_y) ! Searching for optimal computational domain distribution do i = 1, num_procs @@ -379,9 +379,9 @@ contains tmp_num_procs_y = num_procs_y tmp_num_procs_z = num_procs_z fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - - (n + 1)/tmp_num_procs_y) & + - (n + 1)/tmp_num_procs_y) & + 10._wp*abs((n + 1)/tmp_num_procs_y & - - (p + 1)/tmp_num_procs_z) + - (p + 1)/tmp_num_procs_z) ! Optimization of the initial processor topology do i = 1, num_procs @@ -502,7 +502,7 @@ contains tmp_num_procs_x = num_procs_x tmp_num_procs_y = num_procs_y fct_min = 10._wp*abs((m + 1)/tmp_num_procs_x & - - (n + 1)/tmp_num_procs_y) + - (n + 1)/tmp_num_procs_y) ! Optimization of the initial processor topology do i = 1, num_procs @@ -682,9 +682,9 @@ contains ! Send/receive buffer to/from bc_x%end/bc_x%beg call MPI_SENDRECV( & dx(m - buff_size + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_x%end, 0, & + mpi_p, bc_x%end, 0, & dx(-buff_size), buff_size, & - MPI_DOUBLE_PRECISION, bc_x%beg, 0, & + mpi_p, bc_x%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) else ! PBC at the beginning only @@ -692,9 +692,9 @@ contains ! Send/receive buffer to/from bc_x%beg/bc_x%beg call MPI_SENDRECV( & dx(0), buff_size, & - MPI_DOUBLE_PRECISION, bc_x%beg, 1, & + mpi_p, bc_x%beg, 1, & dx(-buff_size), buff_size, & - MPI_DOUBLE_PRECISION, bc_x%beg, 0, & + mpi_p, bc_x%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) end if @@ -706,9 +706,9 @@ contains ! Send/receive buffer to/from bc_x%beg/bc_x%end call MPI_SENDRECV( & dx(0), buff_size, & - MPI_DOUBLE_PRECISION, bc_x%beg, 1, & + mpi_p, bc_x%beg, 1, & dx(m + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_x%end, 1, & + mpi_p, bc_x%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) else ! PBC at the end only @@ -716,9 +716,9 @@ contains ! Send/receive buffer to/from bc_x%end/bc_x%end call MPI_SENDRECV( & dx(m - buff_size + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_x%end, 0, & + mpi_p, bc_x%end, 0, & dx(m + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_x%end, 1, & + mpi_p, bc_x%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) end if @@ -736,9 +736,9 @@ contains ! Send/receive buffer to/from bc_y%end/bc_y%beg call MPI_SENDRECV( & dy(n - buff_size + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_y%end, 0, & + mpi_p, bc_y%end, 0, & dy(-buff_size), buff_size, & - MPI_DOUBLE_PRECISION, bc_y%beg, 0, & + mpi_p, bc_y%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) else ! PBC at the beginning only @@ -746,9 +746,9 @@ contains ! Send/receive buffer to/from bc_y%beg/bc_y%beg call MPI_SENDRECV( & dy(0), buff_size, & - MPI_DOUBLE_PRECISION, bc_y%beg, 1, & + mpi_p, bc_y%beg, 1, & dy(-buff_size), buff_size, & - MPI_DOUBLE_PRECISION, bc_y%beg, 0, & + mpi_p, bc_y%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) end if @@ -760,9 +760,9 @@ contains ! Send/receive buffer to/from bc_y%beg/bc_y%end call MPI_SENDRECV( & dy(0), buff_size, & - MPI_DOUBLE_PRECISION, bc_y%beg, 1, & + mpi_p, bc_y%beg, 1, & dy(n + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_y%end, 1, & + mpi_p, bc_y%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) else ! PBC at the end only @@ -770,9 +770,9 @@ contains ! Send/receive buffer to/from bc_y%end/bc_y%end call MPI_SENDRECV( & dy(n - buff_size + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_y%end, 0, & + mpi_p, bc_y%end, 0, & dy(n + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_y%end, 1, & + mpi_p, bc_y%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) end if @@ -790,9 +790,9 @@ contains ! Send/receive buffer to/from bc_z%end/bc_z%beg call MPI_SENDRECV( & dz(p - buff_size + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_z%end, 0, & + mpi_p, bc_z%end, 0, & dz(-buff_size), buff_size, & - MPI_DOUBLE_PRECISION, bc_z%beg, 0, & + mpi_p, bc_z%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) else ! PBC at the beginning only @@ -800,9 +800,9 @@ contains ! Send/receive buffer to/from bc_z%beg/bc_z%beg call MPI_SENDRECV( & dz(0), buff_size, & - MPI_DOUBLE_PRECISION, bc_z%beg, 1, & + mpi_p, bc_z%beg, 1, & dz(-buff_size), buff_size, & - MPI_DOUBLE_PRECISION, bc_z%beg, 0, & + mpi_p, bc_z%beg, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) end if @@ -814,9 +814,9 @@ contains ! Send/receive buffer to/from bc_z%beg/bc_z%end call MPI_SENDRECV( & dz(0), buff_size, & - MPI_DOUBLE_PRECISION, bc_z%beg, 1, & + mpi_p, bc_z%beg, 1, & dz(p + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_z%end, 1, & + mpi_p, bc_z%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) else ! PBC at the end only @@ -824,9 +824,9 @@ contains ! Send/receive buffer to/from bc_z%end/bc_z%end call MPI_SENDRECV( & dz(p - buff_size + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_z%end, 0, & + mpi_p, bc_z%end, 0, & dz(p + 1), buff_size, & - MPI_DOUBLE_PRECISION, bc_z%end, 1, & + mpi_p, bc_z%end, 1, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) end if @@ -1078,8 +1078,8 @@ contains #:endif call MPI_SENDRECV( & - p_send, buffer_count, MPI_DOUBLE_PRECISION, dst_proc, send_tag, & - p_recv, buffer_count, MPI_DOUBLE_PRECISION, src_proc, recv_tag, & + p_send, buffer_count, mpi_p, dst_proc, send_tag, & + p_recv, buffer_count, mpi_p, src_proc, recv_tag, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) #:if rdma_mpi @@ -2238,8 +2238,8 @@ contains #:endif call MPI_SENDRECV( & - p_send, buffer_count, MPI_DOUBLE_PRECISION, dst_proc, send_tag, & - p_recv, buffer_count, MPI_DOUBLE_PRECISION, src_proc, recv_tag, & + p_send, buffer_count, mpi_p, dst_proc, send_tag, & + p_recv, buffer_count, mpi_p, src_proc, recv_tag, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr) #:if rdma_mpi diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 2218b98fdd..d70df65b0c 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -726,9 +726,9 @@ contains real(wp), dimension(num_fluids) :: myalpha_rho, myalpha real(wp) :: tmp1, tmp2, tmp3, tmp4, & - c_gas, c_liquid, & - Cpbw, Cpinf, Cpinf_dot, & - myH, myHdot, rddot, alf_gas + c_gas, c_liquid, & + Cpbw, Cpinf, Cpinf_dot, & + myH, myHdot, rddot, alf_gas real(wp) :: n_tait, B_tait, angle, angle_z diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 769100a3c0..2d14710e2b 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -560,11 +560,11 @@ contains pres_SR = pres_SL Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* & - (pres_SL/pres_L - 1._wp)*pres_L/ & - ((pres_L + pi_inf_L/(1._wp + gamma_L))))) + (pres_SL/pres_L - 1._wp)*pres_L/ & + ((pres_L + pi_inf_L/(1._wp + gamma_L))))) Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* & - (pres_SR/pres_R - 1._wp)*pres_R/ & - ((pres_R + pi_inf_R/(1._wp + gamma_R))))) + (pres_SR/pres_R - 1._wp)*pres_R/ & + ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R @@ -1083,11 +1083,11 @@ contains pres_SR = pres_SL Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* & - (pres_SL/pres_L - 1._wp)*pres_L/ & - ((pres_L + pi_inf_L/(1._wp + gamma_L))))) + (pres_SL/pres_L - 1._wp)*pres_L/ & + ((pres_L + pi_inf_L/(1._wp + gamma_L))))) Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* & - (pres_SR/pres_R - 1._wp)*pres_R/ & - ((pres_R + pi_inf_R/(1._wp + gamma_R))))) + (pres_SR/pres_R - 1._wp)*pres_R/ & + ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R @@ -1375,11 +1375,11 @@ contains pres_SR = pres_SL Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* & - (pres_SL/pres_L - 1._wp)*pres_L/ & - ((pres_L + pi_inf_L/(1._wp + gamma_L))))) + (pres_SL/pres_L - 1._wp)*pres_L/ & + ((pres_L + pi_inf_L/(1._wp + gamma_L))))) Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* & - (pres_SR/pres_R - 1._wp)*pres_R/ & - ((pres_R + pi_inf_R/(1._wp + gamma_R))))) + (pres_SR/pres_R - 1._wp)*pres_R/ & + ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R @@ -1802,11 +1802,11 @@ contains pres_SR = pres_SL Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* & - (pres_SL/pres_L - 1._wp)*pres_L/ & - ((pres_L + pi_inf_L/(1._wp + gamma_L))))) + (pres_SL/pres_L - 1._wp)*pres_L/ & + ((pres_L + pi_inf_L/(1._wp + gamma_L))))) Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* & - (pres_SR/pres_R - 1._wp)*pres_R/ & - ((pres_R + pi_inf_R/(1._wp + gamma_R))))) + (pres_SR/pres_R - 1._wp)*pres_R/ & + ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R @@ -2158,11 +2158,11 @@ contains pres_SR = pres_SL Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* & - (pres_SL/pres_L - 1._wp)*pres_L/ & - ((pres_L + pi_inf_L/(1._wp + gamma_L))))) + (pres_SL/pres_L - 1._wp)*pres_L/ & + ((pres_L + pi_inf_L/(1._wp + gamma_L))))) Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* & - (pres_SR/pres_R - 1._wp)*pres_R/ & - ((pres_R + pi_inf_R/(1._wp + gamma_R))))) + (pres_SR/pres_R - 1._wp)*pres_R/ & + ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(idx1) - c_L*Ms_L s_R = vel_R(idx1) + c_R*Ms_R @@ -3151,7 +3151,7 @@ contains + dvelR_dx_vf(2)%sf(j + 1, k, l)) tau_Re(1, 1) = -(2._wp/3._wp)*(dvel_avg_dy(2) + & - avg_vel(2)/y_cc(k))/ & + avg_vel(2)/y_cc(k))/ & Re_avg_rsx_vf(j, k, l, 1) tau_Re(1, 2) = (dvel_avg_dy(1) + dvel_avg_dx(2))/ & diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index e669c2d786..a05c10e021 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -488,7 +488,7 @@ contains if (file_exist) then data_size = m_glb + 2 call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr) - call MPI_FILE_READ(ifile, x_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) + call MPI_FILE_READ(ifile, x_cb_glb, data_size, mpi_p, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting...') @@ -519,7 +519,7 @@ contains if (file_exist) then data_size = n_glb + 2 call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr) - call MPI_FILE_READ(ifile, y_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) + call MPI_FILE_READ(ifile, y_cb_glb, data_size, mpi_p, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting...') @@ -540,7 +540,7 @@ contains if (file_exist) then data_size = p_glb + 2 call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr) - call MPI_FILE_READ(ifile, z_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) + call MPI_FILE_READ(ifile, z_cb_glb, data_size, mpi_p, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else call s_mpi_abort('File '//trim(file_loc)//'is missing. Exiting...') @@ -598,7 +598,7 @@ contains var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do !Read pb and mv for non-polytropic qbmm if (qbmm .and. .not. polytropic) then @@ -606,7 +606,7 @@ contains var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do end if else @@ -614,7 +614,7 @@ contains var_MOK = int(i, MPI_OFFSET_KIND) call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do end if @@ -692,10 +692,10 @@ contains ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do !Read pb and mv for non-polytropic qbmm if (qbmm .and. .not. polytropic) then @@ -704,10 +704,10 @@ contains ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do end if else @@ -717,10 +717,10 @@ contains ! Initial displacement to skip at beginning of file disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_DATA%view(i), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), & 'native', mpi_info_int, ierr) call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end do end if @@ -778,10 +778,10 @@ contains ! Initial displacement to skip at beginning of file disp = 0 - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_airfoil_IB_DATA%view(1), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_airfoil_IB_DATA%view(1), & 'native', mpi_info_int, ierr) call MPI_FILE_READ(ifile, MPI_IO_airfoil_IB_DATA%var(1:Np), 3*Np, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end if @@ -795,10 +795,10 @@ contains ! Initial displacement to skip at beginning of file disp = 0 - call MPI_FILE_SET_VIEW(ifile, disp, MPI_DOUBLE_PRECISION, MPI_IO_airfoil_IB_DATA%view(2), & + call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_airfoil_IB_DATA%view(2), & 'native', mpi_info_int, ierr) call MPI_FILE_READ(ifile, MPI_IO_airfoil_IB_DATA%var(Np + 1:2*Np), 3*Np, & - MPI_DOUBLE_PRECISION, status, ierr) + mpi_p, status, ierr) end if do i = 1, Np diff --git a/src/simulation/m_weno.fpp b/src/simulation/m_weno.fpp index 82cbfc0aab..02997fddc2 100644 --- a/src/simulation/m_weno.fpp +++ b/src/simulation/m_weno.fpp @@ -400,67 +400,67 @@ contains beta_coef_${XYZ}$ (i + 1, 0, 0) = & 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - & - s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - & - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/((s_cb(i) - & - s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp) + s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - & + s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/((s_cb(i) - & + s_cb(i + 3))**2._wp*(s_cb(i + 1) - s_cb(i + 3))**2._wp) beta_coef_${XYZ}$ (i + 1, 0, 1) = & 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - & - s_cb(i))**2._wp - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - & - s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i))*((s_cb(i + 2) - & - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - & - s_cb(i + 2))*(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - & - s_cb(i + 1))) + s_cb(i))**2._wp - (s_cb(i + 1) - s_cb(i))*(s_cb(i + 3) - & + s_cb(i + 1)) + 2._wp*(s_cb(i + 2) - s_cb(i))*((s_cb(i + 2) - & + s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))))/((s_cb(i) - & + s_cb(i + 2))*(s_cb(i) - s_cb(i + 3))**2._wp*(s_cb(i + 3) - & + s_cb(i + 1))) beta_coef_${XYZ}$ (i + 1, 0, 2) = & 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - & - s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - & - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) + ((s_cb(i + 2) - & - s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - & - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp) + s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*((s_cb(i + 2) - & + s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1))) + ((s_cb(i + 2) - & + s_cb(i)) + (s_cb(i + 3) - s_cb(i + 1)))**2._wp)/((s_cb(i) - & + s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 3))**2._wp) beta_coef_${XYZ}$ (i + 1, 1, 0) = & 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - & - s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - & - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) - & - s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp) + s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - & + s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 1) - & + s_cb(i + 2))**2._wp*(s_cb(i) - s_cb(i + 2))**2._wp) beta_coef_${XYZ}$ (i + 1, 1, 1) = & 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*((s_cb(i) - & - s_cb(i + 1))*((s_cb(i) - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - & - s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) + (s_cb(i + 1) - & - s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - & - s_cb(i - 1))*(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - & - s_cb(i))) + s_cb(i + 1))*((s_cb(i) - s_cb(i - 1)) + 20._wp*(s_cb(i + 1) - & + s_cb(i))) + (2._wp*(s_cb(i) - s_cb(i - 1)) + (s_cb(i + 1) - & + s_cb(i)))*(s_cb(i + 2) - s_cb(i)))/((s_cb(i + 1) - & + s_cb(i - 1))*(s_cb(i - 1) - s_cb(i + 2))**2._wp*(s_cb(i + 2) - & + s_cb(i))) beta_coef_${XYZ}$ (i + 1, 1, 2) = & 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - & - s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - & - s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/ & + s_cb(i))**2._wp + (s_cb(i + 1) - s_cb(i))*(s_cb(i + 2) - & + s_cb(i + 1)) + (s_cb(i + 2) - s_cb(i + 1))**2._wp)/ & ((s_cb(i - 1) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - & - s_cb(i + 2))**2._wp) + s_cb(i + 2))**2._wp) beta_coef_${XYZ}$ (i + 1, 2, 0) = & 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(12._wp*(s_cb(i + 1) - & - s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - & - s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) - s_cb(i - 2)) + & - (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/ & + s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2)) + (s_cb(i) - & + s_cb(i - 1)))**2._wp + 3._wp*((s_cb(i) - s_cb(i - 2)) + & + (s_cb(i) - s_cb(i - 1)))*(s_cb(i + 1) - s_cb(i)))/ & ((s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i - 1) - & - s_cb(i + 1))**2._wp) + s_cb(i + 1))**2._wp) beta_coef_${XYZ}$ (i + 1, 2, 1) = & 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(19._wp*(s_cb(i + 1) - & - s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - & - s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i - 1))*((s_cb(i) - & - s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) - & - s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - & - s_cb(i - 1))) + s_cb(i))**2._wp + ((s_cb(i) - s_cb(i - 2))*(s_cb(i) - & + s_cb(i + 1))) + 2._wp*(s_cb(i + 1) - s_cb(i - 1))*((s_cb(i) - & + s_cb(i - 2)) + (s_cb(i + 1) - s_cb(i - 1))))/((s_cb(i - 2) - & + s_cb(i))*(s_cb(i - 2) - s_cb(i + 1))**2._wp*(s_cb(i + 1) - & + s_cb(i - 1))) beta_coef_${XYZ}$ (i + 1, 2, 2) = & 4._wp*(s_cb(i) - s_cb(i + 1))**2._wp*(10._wp*(s_cb(i + 1) - & - s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - & - s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) - & - s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp) + s_cb(i))**2._wp + (s_cb(i) - s_cb(i - 1))**2._wp + (s_cb(i) - & + s_cb(i - 1))*(s_cb(i + 1) - s_cb(i)))/((s_cb(i - 2) - & + s_cb(i))**2._wp*(s_cb(i - 2) - s_cb(i + 1))**2._wp) end do diff --git a/src/syscheck/syscheck.fpp b/src/syscheck/syscheck.fpp index 7fdb3cf1e7..de613a6f8d 100644 --- a/src/syscheck/syscheck.fpp +++ b/src/syscheck/syscheck.fpp @@ -53,7 +53,7 @@ program syscheck @:ACC(integer(acc_device_kind) :: devtype) @:ACC(integer :: i, num_devices) - @:ACC(real(wp), allocatable, dimension(:) :: arr) + @:ACC(real(kind(0d0)), allocatable, dimension(:) :: arr) @:ACC(integer, parameter :: N = 100) @:MPIC(call mpi_init(ierr)) From ad508523c1a8b1b24ec7012a0af4dd3c5097b4ea Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Sat, 21 Sep 2024 19:08:00 -0700 Subject: [PATCH 04/68] Incorporate patch file changes only, improve m_precision_select --- src/common/m_constants.fpp | 6 +- src/common/m_eigen_solver.f90 | 48 +++--- src/common/m_helper.fpp | 32 ++-- src/common/m_helper_basic.f90 | 4 +- src/common/m_phase_change.fpp | 46 +++--- src/common/m_precision_select.f90 | 32 +++- src/common/m_variables_conversion.fpp | 12 +- src/post_process/m_derived_variables.fpp | 16 +- src/pre_process/include/2dHardcodedIC.fpp | 2 +- src/pre_process/include/3dHardcodedIC.fpp | 2 +- src/pre_process/m_assign_variables.fpp | 20 +-- src/pre_process/m_grid.f90 | 8 +- src/pre_process/m_model.fpp | 2 +- src/pre_process/m_patches.fpp | 64 ++++---- src/pre_process/m_perturbation.fpp | 10 +- src/simulation/include/inline_riemann.fpp | 14 +- src/simulation/m_acoustic_src.fpp | 42 ++--- src/simulation/m_bubbles.fpp | 40 ++--- src/simulation/m_cbc.fpp | 10 +- src/simulation/m_compute_cbc.fpp | 10 +- src/simulation/m_compute_levelset.fpp | 12 +- src/simulation/m_data_output.fpp | 16 +- src/simulation/m_ibm.fpp | 24 +-- src/simulation/m_qbmm.fpp | 64 ++++---- src/simulation/m_rhs.fpp | 30 ++-- src/simulation/m_riemann_solvers.fpp | 190 +++++++++++----------- src/simulation/m_sim_helpers.f90 | 2 +- src/simulation/m_start_up.fpp | 6 +- src/simulation/m_time_steppers.fpp | 2 +- src/simulation/m_viscous.fpp | 24 +-- src/simulation/m_weno.fpp | 20 +-- 31 files changed, 414 insertions(+), 396 deletions(-) diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp index a8ef8697a6..fa6fba5152 100644 --- a/src/common/m_constants.fpp +++ b/src/common/m_constants.fpp @@ -9,10 +9,10 @@ module m_constants character, parameter :: dflt_char = ' ' !< Default string value real(wp), parameter :: dflt_real = -1d6 !< Default real value - real(wp), parameter :: sgm_eps = 1d-16 !< Segmentation tolerance - real(wp), parameter :: small_alf = 1d-11 !< Small alf tolerance + real(wp), parameter :: sgm_eps = 1e-16 !< Segmentation tolerance + real(wp), parameter :: small_alf = 1e-11 !< Small alf tolerance real(wp), parameter :: pi = 3.141592653589793_wp !< Pi - real(wp), parameter :: verysmall = 1.d-12 !< Very small number + real(wp), parameter :: verysmall = 1.e-12 !< Very small number integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils integer, parameter :: path_len = 400 !< Maximum path length diff --git a/src/common/m_eigen_solver.f90 b/src/common/m_eigen_solver.f90 index 80198afbbb..c460ae30cb 100644 --- a/src/common/m_eigen_solver.f90 +++ b/src/common/m_eigen_solver.f90 @@ -163,8 +163,8 @@ subroutine cbal(nm, nl, ar, ai, low, igh, scale) do 200 j = k, l if (j == i) go to 200 - c = c + dabs(ar(j, i)) + dabs(ai(j, i)) - r = r + dabs(ar(i, j)) + dabs(ai(i, j)) + c = c + abs(ar(j, i)) + abs(ai(j, i)) + r = r + abs(ar(i, j)) + abs(ai(i, j)) 200 end do ! .......... guard against zero c or r due to underflow .......... if (c == 0.0_wp .or. r == 0.0_wp) go to 270 @@ -243,7 +243,7 @@ subroutine corth(nm, nl, low, igh, ar, ai, ortr, orti) scale = 0.0_wp ! .......... scale column (algol tol then not needed) .......... do 90 i = ml, igh - scale = scale + dabs(ar(i, ml - 1)) + dabs(ai(i, ml - 1)) + scale = scale + abs(ar(i, ml - 1)) + abs(ai(i, ml - 1)) 90 end do if (scale == 0._wp) go to 180 mp = ml + igh @@ -255,7 +255,7 @@ subroutine corth(nm, nl, low, igh, ar, ai, ortr, orti) h = h + ortr(i)*ortr(i) + orti(i)*orti(i) 100 end do ! - g = dsqrt(h) + g = sqrt(h) call pythag(ortr(ml), orti(ml), f) if (f == 0._wp) go to 103 h = h + f*g @@ -375,8 +375,8 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) ! .......... for i=igh-1 step -1 until low+1 do -- .......... 105 do 140 ii = 1, iend i = igh - ii - if (dabs(ortr(i)) == 0._wp .and. dabs(orti(i)) == 0._wp) go to 140 - if (dabs(hr(i, i - 1)) == 0._wp .and. dabs(hi(i, i - 1)) == 0._wp) go to 140 + if (abs(ortr(i)) == 0._wp .and. abs(orti(i)) == 0._wp) go to 140 + if (abs(hr(i, i - 1)) == 0._wp .and. abs(hi(i, i - 1)) == 0._wp) go to 140 ! .......... norm below is negative of h formed in corth .......... norm = hr(i, i - 1)*ortr(i) + hi(i, i - 1)*orti(i) ip1 = i + 1 @@ -411,7 +411,7 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) ! do 170 i = l, igh ll = min0(i + 1, igh) - if (dabs(hi(i, i - 1)) == 0._wp) go to 170 + if (abs(hi(i, i - 1)) == 0._wp) go to 170 call pythag(hr(i, i - 1), hi(i, i - 1), norm) yr = hr(i, i - 1)/norm yi = hi(i, i - 1)/norm @@ -456,9 +456,9 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) 240 do 260 ll = low, en l = en + low - ll if (l == low) go to 300 - tst1 = dabs(hr(l - 1, l - 1)) + dabs(hi(l - 1, l - 1)) & - + dabs(hr(l, l)) + dabs(hi(l, l)) - tst2 = tst1 + dabs(hr(l, l - 1)) + tst1 = abs(hr(l - 1, l - 1)) + abs(hi(l - 1, l - 1)) & + + abs(hr(l, l)) + abs(hi(l, l)) + tst2 = tst1 + abs(hr(l, l - 1)) if (tst2 == tst1) go to 300 260 end do ! .......... form shift .......... @@ -481,7 +481,7 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) si = si - xxi go to 340 ! .......... form exceptional shift .......... -320 sr = dabs(hr(en, enm1)) + dabs(hr(enm1, en - 2)) +320 sr = abs(hr(en, enm1)) + abs(hr(enm1, en - 2)) si = 0.0_wp ! 340 do 360 i = low, en @@ -523,7 +523,7 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) 500 end do ! si = hi(en, en) - if (dabs(si) == 0._wp) go to 540 + if (abs(si) == 0._wp) go to 540 call pythag(hr(en, en), si, norm) sr = hr(en, en)/norm si = si/norm @@ -568,7 +568,7 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) 590 end do 600 end do ! - if (dabs(si) == 0._wp) go to 240 + if (abs(si) == 0._wp) go to 240 ! do 630 i = 1, en yr = hr(i, en) @@ -598,7 +598,7 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) ! do i = 1, nl do j = i, nl - tr = dabs(hr(i, j)) + dabs(hi(i, j)) + tr = abs(hr(i, j)) + abs(hi(i, j)) if (tr > norm) norm = tr end do end do @@ -635,7 +635,7 @@ subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) 765 continue call cdiv(zzr, zzi, yr, yi, hr(i, en), hi(i, en)) ! .......... overflow control .......... - tr = dabs(hr(i, en)) + dabs(hi(i, en)) + tr = abs(hr(i, en)) + abs(hi(i, en)) if (tr == 0.0_wp) go to 780 tst1 = tr tst2 = tst1 + 1.0_wp/tst1 @@ -709,12 +709,12 @@ end subroutine comqr2 !! transformed in their first ml columns subroutine cbabk2(nm, nl, low, igh, scale, ml, zr, zi) integer, intent(in) :: nm, nl, low, igh - double precision, intent(in) :: scale(nl) + real(wp), intent(in) :: scale(nl) integer, intent(in) :: ml - double precision, intent(inout) :: zr(nm, ml), zi(nm, ml) + real(wp), intent(inout) :: zr(nm, ml), zi(nm, ml) integer :: i, j, k, ii - double precision :: s + real(wp) :: s if (ml == 0) go to 200 if (igh == low) go to 120 @@ -757,14 +757,14 @@ subroutine csroot(xr, xi, yr, yi) real(wp), intent(in) :: xr, xi real(wp), intent(out) :: yr, yi ! -! (yr,yi) = complex dsqrt(xr,xi) +! (yr,yi) = complex sqrt(xr,xi) ! branch chosen so that yr .ge. 0.0 and sign(yi) .eq. sign(xi) ! real(wp) :: s, tr, ti, c tr = xr ti = xi call pythag(tr, ti, c) - s = dsqrt(0.5_wp*(c + dabs(tr))) + s = sqrt(0.5_wp*(c + abs(tr))) if (tr >= 0.0_wp) yr = s if (ti < 0.0_wp) s = -s if (tr <= 0.0_wp) yi = s @@ -786,7 +786,7 @@ subroutine cdiv(ar, ai, br, bi, cr, ci) ! cr = (ar*br + ai*bi) / (br**2._wp + bi**2._wp) ! ci = (ai*br - ar*bi) / (br**2._wp + bi**2._wp) - s = dabs(br) + dabs(bi) + s = abs(br) + abs(bi) ars = ar/s ais = ai/s brs = br/s @@ -801,12 +801,12 @@ subroutine pythag(a, b, c) real(wp), intent(in) :: a, b real(wp), intent(out) :: c ! -! finds dsqrt(a**2+b**2) without overflow or destructive underflow +! finds sqrt(a**2+b**2) without overflow or destructive underflow ! real(wp) :: p, r, s, t, u - p = dmax1(dabs(a), dabs(b)) + p = dmax1(abs(a), abs(b)) if (p == 0.0_wp) go to 20 - r = (dmin1(dabs(a), dabs(b))/p)**2 + r = (dmin1(abs(a), abs(b))/p)**2 10 continue t = 4.0_wp + r if (t == 4.0_wp) go to 20 diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp index a4062ab5cb..ab9bbcaaa7 100644 --- a/src/common/m_helper.fpp +++ b/src/common/m_helper.fpp @@ -68,7 +68,7 @@ contains real(wp) :: nR3 nR3 = dot_product(weights, nRtmp**3._wp) - ntmp = DSQRT((4._wp*pi/3._wp)*nR3/vftmp) + ntmp = sqrt((4._wp*pi/3._wp)*nR3/vftmp) !ntmp = (3._wp/(4._wp*pi))*0.00001 !print *, "nbub", ntmp @@ -153,8 +153,8 @@ contains if (thermal == 2) gamma_m = 1._wp temp = 293.15_wp - D_m = 0.242d-4 - uu = DSQRT(pl0/rhol0) + D_m = 0.242e-4 + uu = sqrt(pl0/rhol0) omega_ref = 3._wp*k_poly*Ca + 2._wp*(3._wp*k_poly - 1._wp)/Web @@ -163,10 +163,10 @@ contains R_n = Ru/M_n R_v = Ru/M_v ! phi_vn & phi_nv (phi_nn = phi_vv = 1) - phi_vn = (1._wp + DSQRT(mu_v/mu_n)*(M_n/M_v)**(0.25_wp))**2 & - /(DSQRT(8._wp)*DSQRT(1._wp + M_v/M_n)) - phi_nv = (1._wp + DSQRT(mu_n/mu_v)*(M_v/M_n)**(0.25_wp))**2 & - /(DSQRT(8._wp)*DSQRT(1._wp + M_n/M_v)) + phi_vn = (1._wp + sqrt(mu_v/mu_n)*(M_n/M_v)**(0.25_wp))**2 & + /(sqrt(8._wp)*sqrt(1._wp + M_v/M_n)) + phi_nv = (1._wp + sqrt(mu_n/mu_v)*(M_v/M_n)**(0.25_wp))**2 & + /(sqrt(8._wp)*sqrt(1._wp + M_n/M_v)) ! internal bubble pressure pb0 = pl0 + 2._wp*ss/(R0ref*R0) @@ -208,7 +208,7 @@ contains !end if ! natural frequencies - omegaN = DSQRT(3._wp*k_poly*Ca + 2._wp*(3._wp*k_poly - 1._wp)/(Web*R0))/R0 + omegaN = sqrt(3._wp*k_poly*Ca + 2._wp*(3._wp*k_poly - 1._wp)/(Web*R0))/R0 do ir = 1, Nb call s_transcoeff(omegaN(ir)*R0(ir), Pe_T(ir)*R0(ir), & Re_trans_T(ir), Im_trans_T(ir)) @@ -273,30 +273,30 @@ contains !R0mx = 150.D0 sd = poly_sigma - R0mn = 0.8_wp*DEXP(-2.8_wp*sd) - R0mx = 0.2_wp*DEXP(9.5_wp*sd) + 1._wp + R0mn = 0.8_wp*exp(-2.8_wp*sd) + R0mx = 0.2_wp*exp(9.5_wp*sd) + 1._wp ! phi = ln( R0 ) & return R0 do ir = 1, nb - phi(ir) = DLOG(R0mn) & - + dble(ir - 1)*DLOG(R0mx/R0mn)/dble(nb - 1) - R0(ir) = DEXP(phi(ir)) + phi(ir) = log(R0mn) & + + dble(ir - 1)*log(R0mx/R0mn)/dble(nb - 1) + R0(ir) = exp(phi(ir)) end do dphi = phi(2) - phi(1) ! weights for quadrature using Simpson's rule do ir = 2, nb - 1 ! Gaussian - tmp = DEXP(-0.5_wp*(phi(ir)/sd)**2)/DSQRT(2._wp*pi)/sd + tmp = exp(-0.5_wp*(phi(ir)/sd)**2)/sqrt(2._wp*pi)/sd if (mod(ir, 2) == 0) then weight(ir) = tmp*4._wp*dphi/3._wp else weight(ir) = tmp*2._wp*dphi/3._wp end if end do - tmp = DEXP(-0.5_wp*(phi(1)/sd)**2)/DSQRT(2._wp*pi)/sd + tmp = exp(-0.5_wp*(phi(1)/sd)**2)/sqrt(2._wp*pi)/sd weight(1) = tmp*dphi/3._wp - tmp = DEXP(-0.5_wp*(phi(nb)/sd)**2)/DSQRT(2._wp*pi)/sd + tmp = exp(-0.5_wp*(phi(nb)/sd)**2)/sqrt(2._wp*pi)/sd weight(nb) = tmp*dphi/3._wp end subroutine s_simpson diff --git a/src/common/m_helper_basic.f90 b/src/common/m_helper_basic.f90 index b5483998bb..9d358e29f1 100644 --- a/src/common/m_helper_basic.f90 +++ b/src/common/m_helper_basic.f90 @@ -22,7 +22,7 @@ module m_helper_basic !> This procedure checks if two floating point numbers of wp are within tolerance. !! @param a First number. !! @param b Second number. - !! @param tol_input Relative error (default = 1d-6). + !! @param tol_input Relative error (default = 1e-6). !! @return Result of the comparison. logical function f_approx_equal(a, b, tol_input) result(res) !$acc routine seq @@ -35,7 +35,7 @@ logical function f_approx_equal(a, b, tol_input) result(res) if (present(tol_input)) then tol = tol_input else - tol = 1d-6 + tol = 1e-6 end if if (a == b) then diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 9264a14b62..b6b4701995 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -54,7 +54,7 @@ module m_phase_change integer, parameter :: max_iter = 1e8 !< max # of iterations real(wp), parameter :: pCr = 4.94d7 !< Critical water pressure real(wp), parameter :: TCr = 385.05 + 273.15 !< Critical water temperature - real(wp), parameter :: mixM = 1.0d-8 !< threshold for 'mixture cell'. If Y < mixM, phase change does not happen + real(wp), parameter :: mixM = 1.0e-8 !< threshold for 'mixture cell'. If Y < mixM, phase change does not happen integer, parameter :: lp = 1 !< index for the liquid phase of the reacting fluid integer, parameter :: vp = 2 !< index for the vapor phase of the reacting fluid !> @} @@ -148,7 +148,7 @@ contains !$acc loop seq do i = momxb, momxe - dynE = dynE + 5.0d-1*q_cons_vf(i)%sf(j, k, l)**2/rho + dynE = dynE + 5.0e-1*q_cons_vf(i)%sf(j, k, l)**2/rho end do @@ -246,7 +246,7 @@ contains ! Calculations AFTER equilibrium ! entropy - sk(1:num_fluids) = cvs(1:num_fluids)*DLOG((TS**gs_min(1:num_fluids)) & + sk(1:num_fluids) = cvs(1:num_fluids)*log((TS**gs_min(1:num_fluids)) & /((pS + ps_inf(1:num_fluids))**(gs_min(1:num_fluids) - 1.0_wp))) + qvps(1:num_fluids) ! enthalpy @@ -357,7 +357,7 @@ contains ! Newton Solver for the pT-equilibrium ns = 0 ! change this relative error metric. 1E4 is just arbitrary - do while ((DABS(pS - pO) > palpha_eps) .and. (DABS((pS - pO)/pO) > palpha_eps/1e4) .or. (ns == 0)) + do while ((abs(pS - pO) > palpha_eps) .and. (abs((pS - pO)/pO) > palpha_eps/1e4) .or. (ns == 0)) ! increasing counter ns = ns + 1 @@ -381,7 +381,7 @@ contains hp = 1.0_wp/(rhoe + pS - mQ) + 1.0_wp/(pS + minval(p_infpT)) ! updating common pressure for the newton solver - pS = pO + ((1.0_wp - gp)/gpp)/(1.0_wp - (1.0_wp - gp + DABS(1.0_wp - gp)) & + pS = pO + ((1.0_wp - gp)/gpp)/(1.0_wp - (1.0_wp - gp + abs(1.0_wp - gp)) & /(2.0_wp*gpp)*hp) end do @@ -425,14 +425,14 @@ contains ns = 0 ! Relaxation factor - Om = 1.0d-3 + Om = 1.0e-3 p_infpTg = p_infpT if (((pS < 0.0_wp) .and. ((q_cons_vf(lp + contxb - 1)%sf(j, k, l) & + q_cons_vf(vp + contxb - 1)%sf(j, k, l)) > ((rhoe & - gs_min(lp)*ps_inf(lp)/(gs_min(lp) - 1))/qvs(lp)))) .or. & - ((pS >= 0.0_wp) .and. (pS < 1.0d-1))) then + ((pS >= 0.0_wp) .and. (pS < 1.0e-1))) then ! improve this initial condition pS = 1.0d4 @@ -446,8 +446,8 @@ contains ! improve this initial condition R2D(1) = 0.0_wp; R2D(2) = 0.0_wp DeltamP(1) = 0.0_wp; DeltamP(2) = 0.0_wp - do while (((DSQRT(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & - .and. ((DSQRT(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) & + do while (((sqrt(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & + .and. ((sqrt(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) & .or. (ns == 0)) ! Updating counter for the iterative procedure @@ -605,10 +605,10 @@ contains + mCVGP) dFdT = & - -(cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp))*DLOG(TS) & + -(cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp))*log(TS) & - (qvps(lp) - qvps(vp)) & - + cvs(lp)*(gs_min(lp) - 1)*DLOG(pS + ps_inf(lp)) & - - cvs(vp)*(gs_min(vp) - 1)*DLOG(pS + ps_inf(vp)) + + cvs(lp)*(gs_min(lp) - 1)*log(pS + ps_inf(lp)) & + - cvs(vp)*(gs_min(vp) - 1)*log(pS + ps_inf(vp)) dTdm = -(cvs(lp)*(gs_min(lp) - 1)/(pS + ps_inf(lp)) & - cvs(vp)*(gs_min(vp) - 1)/(pS + ps_inf(vp)))*TS**2 @@ -706,9 +706,9 @@ contains ! Gibbs Free Energy Equality condition (DG) R2D(1) = TS*((cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp)) & - *(1 - DLOG(TS)) - (qvps(lp) - qvps(vp)) & - + cvs(lp)*(gs_min(lp) - 1)*DLOG(pS + ps_inf(lp)) & - - cvs(vp)*(gs_min(vp) - 1)*DLOG(pS + ps_inf(vp))) & + *(1 - log(TS)) - (qvps(lp) - qvps(vp)) & + + cvs(lp)*(gs_min(lp) - 1)*log(pS + ps_inf(lp)) & + - cvs(vp)*(gs_min(vp) - 1)*log(pS + ps_inf(vp))) & + qvs(lp) - qvs(vp) ! Constant Energy Process condition (DE) @@ -754,24 +754,24 @@ contains ns = 0 ! underrelaxation factor - Om = 1.0d-3 - do while ((DABS(FT) > ptgalpha_eps) .or. (ns == 0)) + Om = 1.0e-3 + do while ((abs(FT) > ptgalpha_eps) .or. (ns == 0)) ! increasing counter ns = ns + 1 ! calculating residual FT = TSat*((cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp)) & - *(1 - DLOG(TSat)) - (qvps(lp) - qvps(vp)) & - + cvs(lp)*(gs_min(lp) - 1)*DLOG(pSat + ps_inf(lp)) & - - cvs(vp)*(gs_min(vp) - 1)*DLOG(pSat + ps_inf(vp))) & + *(1 - log(TSat)) - (qvps(lp) - qvps(vp)) & + + cvs(lp)*(gs_min(lp) - 1)*log(pSat + ps_inf(lp)) & + - cvs(vp)*(gs_min(vp) - 1)*log(pSat + ps_inf(vp))) & + qvs(lp) - qvs(vp) ! calculating the jacobian dFdT = & - -(cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp))*DLOG(TSat) & + -(cvs(lp)*gs_min(lp) - cvs(vp)*gs_min(vp))*log(TSat) & - (qvps(lp) - qvps(vp)) & - + cvs(lp)*(gs_min(lp) - 1)*DLOG(pSat + ps_inf(lp)) & - - cvs(vp)*(gs_min(vp) - 1)*DLOG(pSat + ps_inf(vp)) + + cvs(lp)*(gs_min(lp) - 1)*log(pSat + ps_inf(lp)) & + - cvs(vp)*(gs_min(vp) - 1)*log(pSat + ps_inf(vp)) ! updating saturation temperature TSat = TSat - Om*FT/dFdT diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90 index a95ffbb736..8d50ac185c 100644 --- a/src/common/m_precision_select.f90 +++ b/src/common/m_precision_select.f90 @@ -1,23 +1,41 @@ -!> -!! @file m_precision_select.f90 -!! @brief Contains module m_precision_select +!> @file m_precision_select.f90 +!> @brief Contains module m_precision_select !> @brief This file contains the definition of floating point used in MFC module m_precision_select #ifdef MFC_MPI - use mpi !< Message passing interface (MPI) module + use mpi !< Message Passing Interface (MPI) module #endif implicit none + ! Define the available precision types integer, parameter :: single_precision = selected_real_kind(6, 37) integer, parameter :: double_precision = selected_real_kind(15, 307) - integer, parameter :: wp = double_precision + ! Set the working precision (wp) to single or double precision + integer, parameter :: wp = single_precision ! Change this to single_precision if needed + #ifdef MFC_MPI - integer, parameter :: mpi_p = MPI_DOUBLE_PRECISION + ! Declare mpi_p as a module variable + integer :: mpi_p #else integer, parameter :: mpi_p = -100 #endif -end module m_precision_select +contains + + ! Subroutine to initialize mpi_p based on wp + subroutine initialize_precision() +#ifdef MFC_MPI + if (wp == single_precision) then + mpi_p = MPI_FLOAT + else if (wp == double_precision) then + mpi_p = MPI_DOUBLE_PRECISION + else + stop 'Unsupported precision kind.' + end if +#endif + end subroutine initialize_precision + +end module m_precision_select \ No newline at end of file diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index de7fdd5ef8..054255c797 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -189,7 +189,7 @@ contains Y_rs(i) = rhoYks(i)/rho end do - if (sum(Y_rs) > 1d-16) then + if (sum(Y_rs) > 1e-16) then call get_temperature(.true., energy - dyn_p, 1200._wp, Y_rs, T) call get_pressure(rho, T, Y_rs, pres) else @@ -295,7 +295,7 @@ contains alpha_K(i) = min(max(0._wp, alpha_K(i)), 1._wp) end do - alpha_K = alpha_K/max(sum(alpha_K), 1d-16) + alpha_K = alpha_K/max(sum(alpha_K), 1e-16) end if @@ -420,7 +420,7 @@ contains alpha_K(i) = min(max(0._wp, alpha_K(i)), 1._wp) end do - alpha_K = alpha_K/max(sum(alpha_K), 1d-16) + alpha_K = alpha_K/max(sum(alpha_K), 1e-16) end if @@ -987,7 +987,7 @@ contains if (model_eqns /= 4) then qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & /rho_K - dyn_pres_K = dyn_pres_K + 5d-1*qK_cons_vf(i)%sf(j, k, l) & + dyn_pres_K = dyn_pres_K + 5e-1*qK_cons_vf(i)%sf(j, k, l) & *qK_prim_vf(i)%sf(j, k, l) else qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & @@ -1349,7 +1349,7 @@ contains ! Computing the energy from the pressure E_K = gamma_K*pres_K + pi_inf_K & - + 5d-1*rho_K*vel_K_sum + qv_K + + 5e-1*rho_K*vel_K_sum + qv_K ! mass flux, this should be \alpha_i \rho_i u_i !$acc loop seq @@ -1468,7 +1468,7 @@ contains (rho*(1._wp - adv(num_fluids))) end if else - c = ((H - 5d-1*vel_sum)/gamma) + c = ((H - 5e-1*vel_sum)/gamma) end if if (mixture_err .and. c < 0._wp) then diff --git a/src/post_process/m_derived_variables.fpp b/src/post_process/m_derived_variables.fpp index 536d4289f5..530c654dd6 100644 --- a/src/post_process/m_derived_variables.fpp +++ b/src/post_process/m_derived_variables.fpp @@ -212,7 +212,7 @@ contains end if if (mixture_err .and. q_sf(i, j, k) < 0._wp) then - q_sf(i, j, k) = 1d-16 + q_sf(i, j, k) = 1e-16 else q_sf(i, j, k) = sqrt(q_sf(i, j, k)) end if @@ -285,8 +285,8 @@ contains end if end if - if (abs(top) < 1d-8) top = 0._wp - if (abs(bottom) < 1d-8) bottom = 0._wp + if (abs(top) < 1e-8) top = 0._wp + if (abs(bottom) < 1e-8) bottom = 0._wp if (top == bottom) then slope = 1._wp @@ -295,20 +295,20 @@ contains ! (bottom == 0._wp .AND. top /= 0._wp)) THEN ! slope = 0._wp else - slope = (top*bottom)/(bottom**2._wp + 1d-16) + slope = (top*bottom)/(bottom**2._wp + 1e-16) end if ! Flux limiter function if (flux_lim == 1) then ! MINMOD (MM) q_sf(j, k, l) = max(0._wp, min(1._wp, slope)) elseif (flux_lim == 2) then ! MUSCL (MC) - q_sf(j, k, l) = max(0._wp, min(2._wp*slope, 5d-1*(1._wp + slope), 2._wp)) + q_sf(j, k, l) = max(0._wp, min(2._wp*slope, 5e-1*(1._wp + slope), 2._wp)) elseif (flux_lim == 3) then ! OSPRE (OP) - q_sf(j, k, l) = (15d-1*(slope**2._wp + slope))/(slope**2._wp + slope + 1._wp) + q_sf(j, k, l) = (15e-1*(slope**2._wp + slope))/(slope**2._wp + slope + 1._wp) elseif (flux_lim == 4) then ! SUPERBEE (SB) q_sf(j, k, l) = max(0._wp, min(1._wp, 2._wp*slope), min(slope, 2._wp)) elseif (flux_lim == 5) then ! SWEBY (SW) (beta = 1.5) - q_sf(j, k, l) = max(0._wp, min(15d-1*slope, 1._wp), min(slope, 15d-1)) + q_sf(j, k, l) = max(0._wp, min(15e-1*slope, 1._wp), min(slope, 15e-1)) elseif (flux_lim == 6) then ! VAN ALBADA (VA) q_sf(j, k, l) = (slope**2._wp + slope)/(slope**2._wp + 1._wp) elseif (flux_lim == 7) then ! VAN LEER (VL) @@ -321,7 +321,7 @@ contains !> Computes the solution to the linear system Ax=b w/ sol = x !! @param A Input matrix - !! @param b right-hand-side + !! @param b right-hane-side !! @param sol Solution !! @param ndim Problem size subroutine s_solve_linear_system(A, b, sol, ndim) diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp index 23f11a465e..fa8b1c0a28 100644 --- a/src/pre_process/include/2dHardcodedIC.fpp +++ b/src/pre_process/include/2dHardcodedIC.fpp @@ -80,7 +80,7 @@ intH = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h - alph = 5d-1*(1 + tanh((y_cc(j) - intH)/2.5e-3)) + alph = 5e-1*(1 + tanh((y_cc(j) - intH)/2.5e-3)) if (alph < eps) alph = eps if (alph > 1 - eps) alph = 1 - eps diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp index 4448297ec5..75b2fbd55e 100644 --- a/src/pre_process/include/3dHardcodedIC.fpp +++ b/src/pre_process/include/3dHardcodedIC.fpp @@ -23,7 +23,7 @@ intH = amp*(sin(2*pi*x_cc(i)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h - alph = 5d-1*(1 + tanh((y_cc(j) - intH)/2.5e-3)) + alph = 5e-1*(1 + tanh((y_cc(j) - intH)/2.5e-3)) if (alph < eps) alph = eps if (alph > 1 - eps) alph = 1 - eps diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp index c43cfd890a..4d4c93ab53 100644 --- a/src/pre_process/m_assign_variables.fpp +++ b/src/pre_process/m_assign_variables.fpp @@ -197,7 +197,7 @@ contains #:endif ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(j, k, l) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(j, k, l) = patch_id end subroutine s_assign_patch_mixture_primitive_variables @@ -216,7 +216,7 @@ contains real(wp) :: R3bar, n0, ratio, nH, vfH, velH, rhoH, deno p0 = 101325 - pres_mag = 1d-1 + pres_mag = 1e-1 loc = x_cc(177) n_tait = fluid_pp(1)%gamma B_tait = fluid_pp(1)%pi_inf @@ -264,7 +264,7 @@ contains velH = 0._wp else velH = (q_prim_vf(E_idx)%sf(j, k, l) - 1._wp)/(1._wp - q_prim_vf(alf_idx)%sf(j, k, l))/deno - velH = dsqrt(velH) + velH = sqrt(velH) velH = velH*deno end if @@ -439,10 +439,10 @@ contains q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2 else if (dist_type == 2) then q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp - q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = dexp((sigR**2)/2._wp)*muR + q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR q_prim_vf(bub_idx%fullmom(i, 0, 1))%sf(j, k, l) = muV - q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = dexp((sigR**2)*2._wp)*(muR**2) - q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = dexp((sigR**2)/2._wp)*muR*muV + q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigR**2)*2._wp)*(muR**2) + q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR*muV q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2 end if else @@ -604,10 +604,10 @@ contains q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2 else if (dist_type == 2) then q_prim_vf(bub_idx%fullmom(i, 0, 0))%sf(j, k, l) = 1._wp - q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = dexp((sigR**2)/2._wp)*muR + q_prim_vf(bub_idx%fullmom(i, 1, 0))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR q_prim_vf(bub_idx%fullmom(i, 0, 1))%sf(j, k, l) = muV - q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = dexp((sigR**2)*2._wp)*(muR**2) - q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = dexp((sigR**2)/2._wp)*muR*muV + q_prim_vf(bub_idx%fullmom(i, 2, 0))%sf(j, k, l) = exp((sigR**2)*2._wp)*(muR**2) + q_prim_vf(bub_idx%fullmom(i, 1, 1))%sf(j, k, l) = exp((sigR**2)/2._wp)*muR*muV q_prim_vf(bub_idx%fullmom(i, 0, 2))%sf(j, k, l) = muV**2 + sigV**2 end if else @@ -669,7 +669,7 @@ contains end if ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(j, k, l) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(j, k, l) = patch_id end subroutine s_assign_patch_species_primitive_variables diff --git a/src/pre_process/m_grid.f90 b/src/pre_process/m_grid.f90 index 9f8e02918e..17e84be2b4 100644 --- a/src/pre_process/m_grid.f90 +++ b/src/pre_process/m_grid.f90 @@ -64,7 +64,7 @@ subroutine s_generate_serial_grid dx = (x_domain%end - x_domain%beg)/real(m + 1, wp) do i = 0, m - x_cc(i) = x_domain%beg + 5d-1*dx*real(2*i + 1, wp) + x_cc(i) = x_domain%beg + 5e-1*dx*real(2*i + 1, wp) x_cb(i - 1) = x_domain%beg + dx*real(i, wp) end do @@ -104,7 +104,7 @@ subroutine s_generate_serial_grid dy = (y_domain%end - y_domain%beg)/real(2*n + 1, wp) - y_cc(0) = y_domain%beg + 5d-1*dy + y_cc(0) = y_domain%beg + 5e-1*dy y_cb(-1) = y_domain%beg do i = 1, n @@ -117,7 +117,7 @@ subroutine s_generate_serial_grid dy = (y_domain%end - y_domain%beg)/real(n + 1, wp) do i = 0, n - y_cc(i) = y_domain%beg + 5d-1*dy*real(2*i + 1, wp) + y_cc(i) = y_domain%beg + 5e-1*dy*real(2*i + 1, wp) y_cb(i - 1) = y_domain%beg + dy*real(i, wp) end do @@ -157,7 +157,7 @@ subroutine s_generate_serial_grid dz = (z_domain%end - z_domain%beg)/real(p + 1, wp) do i = 0, p - z_cc(i) = z_domain%beg + 5d-1*dz*real(2*i + 1, wp) + z_cc(i) = z_domain%beg + 5e-1*dz*real(2*i + 1, wp) z_cb(i - 1) = z_domain%beg + dz*real(i, wp) end do diff --git a/src/pre_process/m_model.fpp b/src/pre_process/m_model.fpp index f4a7fa5dd8..6c11cc21f9 100644 --- a/src/pre_process/m_model.fpp +++ b/src/pre_process/m_model.fpp @@ -489,7 +489,7 @@ contains end function f_model_is_inside - ! From https://www.scratchapixel.com/lessons/3d-basic-rendering/ray-tracing-rendering-a-triangle/ray-triangle-intersection-geometric-solution.html + ! From https://www.scratchapixel.com/lessons/3e-basic-rendering/ray-tracing-rendering-a-triangle/ray-triangle-intersection-geometric-solution.html !> This procedure checks if a ray intersects a triangle. !! @param ray Ray. !! @param triangle Triangle. diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index 815ca4551a..662d2da0d2 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -137,7 +137,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(i, 0, 0) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(i, 0, 0) = patch_id end if end do @@ -201,7 +201,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id end if end do end do @@ -662,7 +662,7 @@ contains ! the current patch are assigned to this cell. do j = 0, n do i = 0, m - myr = dsqrt((x_cc(i) - x_centroid)**2 & + myr = sqrt((x_cc(i) - x_centroid)**2 & + (y_cc(j) - y_centroid)**2) if (myr <= radius + thickness/2._wp .and. & @@ -675,10 +675,10 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id q_prim_vf(alf_idx)%sf(i, j, 0) = patch_icpp(patch_id)%alpha(1)* & - dexp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp) + exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp) end if end do @@ -725,7 +725,7 @@ contains do k = 0, p do j = 0, n do i = 0, m - myr = dsqrt((x_cc(i) - x_centroid)**2 & + myr = sqrt((x_cc(i) - x_centroid)**2 & + (y_cc(j) - y_centroid)**2) if (myr <= radius + thickness/2._wp .and. & @@ -738,10 +738,10 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id q_prim_vf(alf_idx)%sf(i, j, k) = patch_icpp(patch_id)%alpha(1)* & - dexp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp) + exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp) end if end do @@ -809,7 +809,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id end if end do end do @@ -889,7 +889,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id end if end do end do @@ -977,7 +977,7 @@ contains end if ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id end if end if @@ -1001,7 +1001,7 @@ contains end if ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id end if @@ -1053,7 +1053,7 @@ contains do i = 0, m if (patch_icpp(patch_id)%smoothen) then - eta = 5d-1 + 5d-1*tanh(smooth_coeff/min(dx, dy) & + eta = 5e-1 + 5e-1*tanh(smooth_coeff/min(dx, dy) & *(a*x_cc(i) + b*y_cc(j) + c) & /sqrt(a**2 + b**2)) end if @@ -1070,7 +1070,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id end if end do @@ -1140,7 +1140,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id ! Assign Parameters ========================================================= q_prim_vf(mom_idx%beg)%sf(i, j, 0) = U0*sin(x_cc(i)/L0)*cos(y_cc(j)/L0) @@ -1209,7 +1209,7 @@ contains @:Hardcoded1D() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(i, 0, 0) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(i, 0, 0) = patch_id end if end do @@ -1332,7 +1332,7 @@ contains @:Hardcoded2D() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id end if end do @@ -1414,7 +1414,7 @@ contains @:Hardcoded3D() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id end if @@ -1480,29 +1480,29 @@ contains if (epsilon == 1._wp) then if (beta == 0._wp) then - H = 5d-1*sqrt(3._wp/pi)*cos(sph_phi) + H = 5e-1*sqrt(3._wp/pi)*cos(sph_phi) elseif (beta == 1._wp) then - H = -5d-1*sqrt(3._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi) + H = -5e-1*sqrt(3._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi) end if elseif (epsilon == 2._wp) then if (beta == 0._wp) then - H = 25d-2*sqrt(5._wp/pi)*(3._wp*cos(sph_phi)**2 - 1._wp) + H = 25e-2*sqrt(5._wp/pi)*(3._wp*cos(sph_phi)**2 - 1._wp) elseif (beta == 1._wp) then - H = -5d-1*sqrt(15._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)*cos(sph_phi) + H = -5e-1*sqrt(15._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)*cos(sph_phi) elseif (beta == 2._wp) then - H = 25d-2*sqrt(15._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))*sin(sph_phi)**2 + H = 25e-2*sqrt(15._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))*sin(sph_phi)**2 end if elseif (epsilon == 3._wp) then if (beta == 0._wp) then - H = 25d-2*sqrt(7._wp/pi)*(5._wp*cos(sph_phi)**3._wp - 3._wp*cos(sph_phi)) + H = 25e-2*sqrt(7._wp/pi)*(5._wp*cos(sph_phi)**3._wp - 3._wp*cos(sph_phi)) elseif (beta == 1._wp) then - H = -125d-3*sqrt(21._wp/pi)*exp(cmplx_i*z_cc(k))*sin(sph_phi)* & + H = -125e-3*sqrt(21._wp/pi)*exp(cmplx_i*z_cc(k))*sin(sph_phi)* & (5._wp*cos(sph_phi)**2 - 1._wp) elseif (beta == 2._wp) then - H = 25d-2*sqrt(105._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* & + H = 25e-2*sqrt(105._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* & sin(sph_phi)**2*cos(sph_phi) elseif (beta == 3._wp) then - H = -125d-3*sqrt(35._wp/pi)*exp(3._wp*cmplx_i*z_cc(k))*sin(sph_phi)**3._wp + H = -125e-3*sqrt(35._wp/pi)*exp(3._wp*cmplx_i*z_cc(k))*sin(sph_phi)**3._wp end if elseif (epsilon == 4._wp) then if (beta == 0._wp) then @@ -1529,7 +1529,7 @@ contains H = -1._wp/16._wp*sqrt(165._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))* & sin(sph_phi)*(21._wp*cos(sph_phi)**4._wp - 14._wp*cos(sph_phi)**2 + 1._wp) elseif (beta == 2._wp) then - H = 125d-3*sqrt(1155._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* & + H = 125e-3*sqrt(1155._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* & sin(sph_phi)**2*(3._wp*cos(sph_phi)**3._wp - cos(sph_phi)) elseif (beta == 3._wp) then H = -1._wp/32._wp*sqrt(385._wp/pi)*exp(3._wp*cmplx_i*z_cc(k))* & @@ -1728,7 +1728,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id end if end do @@ -1862,7 +1862,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id end if end if @@ -1948,7 +1948,7 @@ contains end if if (patch_icpp(patch_id)%smoothen) then - eta = 5d-1 + 5d-1*tanh(smooth_coeff/min(dx, dy, dz) & + eta = 5e-1 + 5e-1*tanh(smooth_coeff/min(dx, dy, dz) & *(a*x_cc(i) + & b*cart_y + & c*cart_z + d) & @@ -1968,7 +1968,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1d-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id end if end do diff --git a/src/pre_process/m_perturbation.fpp b/src/pre_process/m_perturbation.fpp index 0ef4e2a0cb..bcfe1f6239 100644 --- a/src/pre_process/m_perturbation.fpp +++ b/src/pre_process/m_perturbation.fpp @@ -67,7 +67,7 @@ contains perturb_alpha = q_prim_vf(E_idx + perturb_sph_fluid)%sf(i, j, k) ! Perturb partial density fields to match perturbed volume fraction fields - ! IF ((perturb_alpha >= 25d-2) .AND. (perturb_alpha <= 75d-2)) THEN + ! IF ((perturb_alpha >= 25e-2) .AND. (perturb_alpha <= 75e-2)) THEN if ((perturb_alpha /= 0._wp) .and. (perturb_alpha /= 1._wp)) then ! Derive new partial densities @@ -518,9 +518,9 @@ contains ! Normalize the eigenvector by its component with the largest modulus. norm = 0._wp do i = 0, mixlayer_nvar*n - n_bc_skip - 1 - if (dsqrt(vr(i)**2 + vi(i)**2) > norm) then + if (sqrt(vr(i)**2 + vi(i)**2) > norm) then idx = i - norm = dsqrt(vr(i)**2 + vi(i)**2) + norm = sqrt(vr(i)**2 + vi(i)**2) end if end do @@ -583,8 +583,8 @@ contains xci = 0._wp do i = 1, mixlayer_nvar do k = 0, n - xcr((i - 1)*(nbp - 1) + k) = 5d-1*(xbr((i - 1)*nbp + k) + xbr((i - 1)*nbp + k + 1)) - xci((i - 1)*(nbp - 1) + k) = 5d-1*(xbi((i - 1)*nbp + k) + xbi((i - 1)*nbp + k + 1)) + xcr((i - 1)*(nbp - 1) + k) = 5e-1*(xbr((i - 1)*nbp + k) + xbr((i - 1)*nbp + k + 1)) + xci((i - 1)*(nbp - 1) + k) = 5e-1*(xbi((i - 1)*nbp + k) + xbi((i - 1)*nbp + k + 1)) end do end do diff --git a/src/simulation/include/inline_riemann.fpp b/src/simulation/include/inline_riemann.fpp index cbceb1f21b..6eac3f1a45 100644 --- a/src/simulation/include/inline_riemann.fpp +++ b/src/simulation/include/inline_riemann.fpp @@ -1,13 +1,13 @@ #:def arithmetic_avg() - rho_avg = 5d-1*(rho_L + rho_R) + rho_avg = 5e-1*(rho_L + rho_R) vel_avg_rms = 0._wp !$acc loop seq do i = 1, num_dims - vel_avg_rms = vel_avg_rms + (5d-1*(vel_L(i) + vel_R(i)))**2._wp + vel_avg_rms = vel_avg_rms + (5e-1*(vel_L(i) + vel_R(i)))**2._wp end do - H_avg = 5d-1*(H_L + H_R) - gamma_avg = 5d-1*(gamma_L + gamma_R) + H_avg = 5e-1*(H_L + H_R) + gamma_avg = 5e-1*(gamma_L + gamma_R) #:enddef arithmetic_avg @@ -46,7 +46,7 @@ #:def compute_low_Mach_correction() - zcoef = min(1._wp, max(vel_L_rms**5d-1/c_L, vel_R_rms**5d-1/c_R)) + zcoef = min(1._wp, max(vel_L_rms**5e-1/c_L, vel_R_rms**5e-1/c_R)) pcorr = 0._wp if (low_Mach == 1) then @@ -55,8 +55,8 @@ (rho_R*(s_R - vel_R(dir_idx(1))) - rho_L*(s_L - vel_L(dir_idx(1))))* & (zcoef - 1._wp) else if (low_Mach == 2) then - vel_L_tmp = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_L(dir_idx(1)) - vel_R(dir_idx(1)))) - vel_R_tmp = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_R(dir_idx(1)) - vel_L(dir_idx(1)))) + vel_L_tmp = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_L(dir_idx(1)) - vel_R(dir_idx(1)))) + vel_R_tmp = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_R(dir_idx(1)) - vel_L(dir_idx(1)))) vel_L(dir_idx(1)) = vel_L_tmp vel_R(dir_idx(1)) = vel_R_tmp end if diff --git a/src/simulation/m_acoustic_src.fpp b/src/simulation/m_acoustic_src.fpp index dfe2f8a163..7f947b6016 100644 --- a/src/simulation/m_acoustic_src.fpp +++ b/src/simulation/m_acoustic_src.fpp @@ -250,7 +250,7 @@ contains end if small_gamma = 1._wp/small_gamma + 1._wp - c = dsqrt(small_gamma*(q_prim_vf(E_idx)%sf(j, k, l) + ((small_gamma - 1._wp)/small_gamma)*B_tait)/myRho) + c = sqrt(small_gamma*(q_prim_vf(E_idx)%sf(j, k, l) + ((small_gamma - 1._wp)/small_gamma)*B_tait)/myRho) ! Wavelength to frequency conversion if (pulse(ai) == 1 .or. pulse(ai) == 3) frequency_local = f_frequency_local(freq_conv_flag, ai, c) @@ -368,12 +368,12 @@ contains end if elseif (pulse(ai) == 2) then ! Gaussian pulse - source = mag(ai)*dexp(-0.5_wp*((sim_time - delay(ai))**2._wp)/(gauss_sigma_time_local**2._wp)) + source = mag(ai)*exp(-0.5_wp*((sim_time - delay(ai))**2._wp)/(gauss_sigma_time_local**2._wp)) if (term_index == mass_label) then source = source/c - & - foc_length_factor*mag(ai)*dsqrt(pi/2)*gauss_sigma_time_local* & - (erf((sim_time - delay(ai))/(dsqrt(2._wp)*gauss_sigma_time_local)) + 1) + foc_length_factor*mag(ai)*sqrt(pi/2)*gauss_sigma_time_local* & + (erf((sim_time - delay(ai))/(sqrt(2._wp)*gauss_sigma_time_local)) + 1) end if elseif (pulse(ai) == 3) then ! Square wave @@ -384,7 +384,7 @@ contains source = mag(ai)*sign(1._wp, sine_wave) ! Prevent max-norm differences due to compilers to pass CI - if (abs(sine_wave) < 1d-2) then + if (abs(sine_wave) < 1e-2) then source = mag(ai)*sine_wave*1d2 end if @@ -397,7 +397,7 @@ contains integer :: count integer :: dim real(wp) :: source_spatial, angle, xyz_to_r_ratios(3) - real(wp), parameter :: threshold = 1d-10 + real(wp), parameter :: threshold = 1e-10 if (n == 0) then dim = 1 @@ -537,14 +537,14 @@ contains source = 0._wp if (support(ai) == 1) then ! 1D - source = 1._wp/(dsqrt(2._wp*pi)*sig/2._wp)*dexp(-0.5_wp*(r(1)/(sig/2._wp))**2._wp) + source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(r(1)/(sig/2._wp))**2._wp) elseif (support(ai) == 2 .or. support(ai) == 3) then ! 2D or 3D ! If we let unit vector e = (cos(dir), sin(dir)), dist = r(1)*cos(dir(ai)) + r(2)*sin(dir(ai)) ! dot(r,e) if ((r(1) - dist*cos(dir(ai)))**2._wp + (r(2) - dist*sin(dir(ai)))**2._wp < 0.25_wp*length(ai)**2._wp) then ! |r - dist*e| < length/2 if (support(ai) /= 3 .or. abs(r(3)) < 0.25_wp*height(ai)) then ! additional height constraint for 3D - source = 1._wp/(dsqrt(2._wp*pi)*sig/2._wp)*dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp) + source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(dist/(sig/2._wp))**2._wp) end if end if end if @@ -573,20 +573,20 @@ contains angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai))) if (abs(current_angle) < angle_half_aperture .and. r(1) < foc_length(ai)) then - dist = foc_length(ai) - dsqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp) - source = 1._wp/(dsqrt(2._wp*pi)*sig/2._wp)*dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp) + dist = foc_length(ai) - sqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp) + source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(dist/(sig/2._wp))**2._wp) angle = -atan(r(2)/(foc_length(ai) - r(1))) end if elseif (support(ai) == 7) then ! 3D - current_angle = -atan(dsqrt(r(2)**2 + r(3)**2)/(foc_length(ai) - r(1))) + current_angle = -atan(sqrt(r(2)**2 + r(3)**2)/(foc_length(ai) - r(1))) angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai))) if (abs(current_angle) < angle_half_aperture .and. r(1) < foc_length(ai)) then - dist = foc_length(ai) - dsqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp) - source = 1._wp/(dsqrt(2._wp*pi)*sig/2._wp)*dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp) + dist = foc_length(ai) - sqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp) + source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(dist/(sig/2._wp))**2._wp) - norm = dsqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp) + norm = sqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp) xyz_to_r_ratios(1) = -(r(1) - foc_length(ai))/norm xyz_to_r_ratios(2) = -r(2)/norm xyz_to_r_ratios(3) = -r(3)/norm @@ -629,14 +629,14 @@ contains current_angle = -atan(r(2)/(foc_length(ai) - r(1))) angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai))) angle_per_elem = (2._wp*angle_half_aperture - (num_elements(ai) - 1._wp)*element_spacing_angle(ai))/num_elements(ai) - dist = foc_length(ai) - dsqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp) + dist = foc_length(ai) - sqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp) do elem = elem_min, elem_max angle_max = angle_half_aperture - (element_spacing_angle(ai) + angle_per_elem)*(elem - 1._wp) angle_min = angle_max - angle_per_elem if (current_angle > angle_min .and. current_angle < angle_max .and. r(1) < foc_length(ai)) then - source = dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(dsqrt(2._wp*pi)*sig/2._wp) + source = exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(sqrt(2._wp*pi)*sig/2._wp) angle = current_angle exit ! Assume elements don't overlap end if @@ -652,7 +652,7 @@ contains angle_elem = 2._wp*pi*real(elem, wp)/real(num_elements(ai), wp) + rotate_angle(ai) ! Point 2 is the elem center - x2 = f - dsqrt(f**2 - half_apert**2) + x2 = f - sqrt(f**2 - half_apert**2) y2 = half_apert*cos(angle_elem) z2 = half_apert*sin(angle_elem) @@ -663,12 +663,12 @@ contains y3 = C*r(2) z3 = C*r(3) - dist_interp_to_elem_center = dsqrt((x2 - x3)**2._wp + (y2 - y3)**2._wp + (z2 - z3)**2._wp) + dist_interp_to_elem_center = sqrt((x2 - x3)**2._wp + (y2 - y3)**2._wp + (z2 - z3)**2._wp) if ((dist_interp_to_elem_center < aperture_element_3D/2._wp) .and. (r(1) < f)) then - dist = dsqrt((x3 - r(1))**2._wp + (y3 - r(2))**2._wp + (z3 - r(3))**2._wp) - source = dexp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(dsqrt(2._wp*pi)*sig/2._wp) + dist = sqrt((x3 - r(1))**2._wp + (y3 - r(2))**2._wp + (z3 - r(3))**2._wp) + source = exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(sqrt(2._wp*pi)*sig/2._wp) - norm = dsqrt(r(2)**2._wp + r(3)**2._wp + (f - r(1))**2._wp) + norm = sqrt(r(2)**2._wp + r(3)**2._wp + (f - r(1))**2._wp) xyz_to_r_ratios(1) = -(r(1) - f)/norm xyz_to_r_ratios(2) = -r(2)/norm xyz_to_r_ratios(3) = -r(3)/norm diff --git a/src/simulation/m_bubbles.fpp b/src/simulation/m_bubbles.fpp index 3e2400641f..c511d12bdd 100644 --- a/src/simulation/m_bubbles.fpp +++ b/src/simulation/m_bubbles.fpp @@ -139,7 +139,7 @@ contains do j = 0, m divu%sf(j, k, l) = 0._wp divu%sf(j, k, l) = & - 5d-1/dx(j)*(q_prim_vf(contxe + idir)%sf(j + 1, k, l) - & + 5e-1/dx(j)*(q_prim_vf(contxe + idir)%sf(j + 1, k, l) - & q_prim_vf(contxe + idir)%sf(j - 1, k, l)) end do @@ -154,7 +154,7 @@ contains do k = 0, n do j = 0, m divu%sf(j, k, l) = divu%sf(j, k, l) + & - 5d-1/dy(k)*(q_prim_vf(contxe + idir)%sf(j, k + 1, l) - & + 5e-1/dy(k)*(q_prim_vf(contxe + idir)%sf(j, k + 1, l) - & q_prim_vf(contxe + idir)%sf(j, k - 1, l)) end do @@ -168,7 +168,7 @@ contains do k = 0, n do j = 0, m divu%sf(j, k, l) = divu%sf(j, k, l) + & - 5d-1/dz(l)*(q_prim_vf(contxe + idir)%sf(j, k, l + 1) - & + 5e-1/dz(l)*(q_prim_vf(contxe + idir)%sf(j, k, l + 1) - & q_prim_vf(contxe + idir)%sf(j, k, l - 1)) end do @@ -359,8 +359,8 @@ contains ! Rule 2: myR_tmp1(4) > 0._wp ! Rule 3: abs((myR_tmp1(4) - myR_tmp2(4))/myR) < tol ! Rule 4: abs((myV_tmp1(4) - myV_tmp2(4))/myV) < tol - if ((err1 <= 1d-4) .and. (err2 <= 1d-4) .and. (err3 <= 1d-4) & - .and. (err4 < 1d-4) .and. (err5 < 1d-4) & + if ((err1 <= 1e-4) .and. (err2 <= 1e-4) .and. (err3 <= 1e-4) & + .and. (err4 < 1e-4) .and. (err5 < 1e-4) & .and. myR_tmp1(4) > 0._wp) then ! Accepted. Finalize the sub-step @@ -371,12 +371,12 @@ contains myV = myV_tmp1(4) ! Update step size for the next sub-step - h = h*min(2._wp, max(0.5_wp, (1d-4/err1)**(1._wp/3._wp))) + h = h*min(2._wp, max(0.5_wp, (1e-4/err1)**(1._wp/3._wp))) exit else ! Rejected. Update step size for the next try on sub-step - if (err2 <= 1d-4) then + if (err2 <= 1e-4) then h = 0.5_wp*h else h = 0.25_wp*h @@ -401,7 +401,7 @@ contains bub_r_src(j, k, l, q) = q_cons_vf(vs(q))%sf(j, k, l) end if - if (alf < 1.d-11) then + if (alf < 1.e-11) then bub_adv_src(j, k, l) = 0._wp bub_r_src(j, k, l, q) = 0._wp bub_v_src(j, k, l, q) = 0._wp @@ -474,12 +474,12 @@ contains f_bub_adv_src, f_divu) ! Compute d0 = ||y0|| and d1 = ||f(x0,y0)|| - d0 = DSQRT((myR_tmp(1)**2._wp + myV_tmp(1)**2._wp)/2._wp) - d1 = DSQRT((myV_tmp(1)**2._wp + myA_tmp(1)**2._wp)/2._wp) - if (d0 < 1d-5 .or. d1 < 1d-5) then - h0 = 1d-6 + d0 = sqrt((myR_tmp(1)**2._wp + myV_tmp(1)**2._wp)/2._wp) + d1 = sqrt((myV_tmp(1)**2._wp + myA_tmp(1)**2._wp)/2._wp) + if (d0 < 1e-5 .or. d1 < 1e-5) then + h0 = 1e-6 else - h0 = 1d-2*(d0/d1) + h0 = 1e-2*(d0/d1) end if ! Evaluate f(x0+h0,y0+h0*f(x0,y0)) @@ -490,14 +490,14 @@ contains f_bub_adv_src, f_divu) ! Compute d2 = ||f(x0+h0,y0+h0*f(x0,y0))-f(x0,y0)||/h0 - d2 = DSQRT(((myV_tmp(2) - myV_tmp(1))**2._wp + (myA_tmp(2) - myA_tmp(1))**2._wp)/2._wp)/h0 + d2 = sqrt(((myV_tmp(2) - myV_tmp(1))**2._wp + (myA_tmp(2) - myA_tmp(1))**2._wp)/2._wp)/h0 ! Set h1 = (0.01/max(d1,d2))^{1/(p+1)} ! if max(d1,d2) < 1e-15, h1 = max(1e-6, h0*1e-3) - if (max(d1, d2) < 1d-15) then - h1 = max(1d-6, h0*1d-3) + if (max(d1, d2) < 1e-15) then + h1 = max(1e-6, h0*1e-3) else - h1 = (1d-2/max(d1, d2))**(1._wp/3._wp) + h1 = (1e-2/max(d1, d2))**(1._wp/3._wp) end if ! Set h = min(100*h0,h1) @@ -566,7 +566,7 @@ contains /max(abs(myR_tmp(1)), abs(myR_tmp(4))) err_V = (-5._wp*h/24._wp)*(myA_tmp(2) + myA_tmp(3) - 2._wp*myA_tmp(4)) & /max(abs(myV_tmp(1)), abs(myV_tmp(4))) - err = DSQRT((err_R**2._wp + err_V**2._wp)/2._wp) + err = sqrt((err_R**2._wp + err_V**2._wp)/2._wp) end subroutine s_advance_substep @@ -625,7 +625,7 @@ contains tmp = (fCpinf/(1._wp + fBtait) + 1._wp)**((fntait - 1._wp)/fntait) tmp = fntait*(1._wp + fBtait)*tmp - f_cgas = dsqrt(tmp + (fntait - 1._wp)*fH) + f_cgas = sqrt(tmp + (fntait - 1._wp)*fH) end function f_cgas @@ -730,7 +730,7 @@ contains ! Keller-Miksis bubbles fCpinf = fP fCpbw = f_cpbw_KM(fR0, fR, fV, fpb) - c_liquid = dsqrt(fntait*(fP + fBtait)/(fRho*(1._wp - alf))) + c_liquid = sqrt(fntait*(fP + fBtait)/(fRho*(1._wp - alf))) f_rddot = f_rddot_KM(fpbdot, fCpinf, fCpbw, fRho, fR, fV, fR0, c_liquid) else if (bubble_model == 3) then ! Rayleigh-Plesset bubbles diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index 03c6a89d00..fdf898aec3 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -603,7 +603,7 @@ contains !> The following is the implementation of the CBC based on !! the work of Thompson (1987, 1990) on hyperbolic systems. !! The CBC is indirectly applied in the computation of the - !! right-hand-side (RHS) near the relevant domain boundary + !! right-hane-side (RHS) near the relevant domain boundary !! through the modification of the fluxes. !! @param q_prim_vf Cell-average primitive variables !! @param flux_vf Cell-boundary-average fluxes @@ -802,7 +802,7 @@ contains mf(i) = alpha_rho(i)/rho end do - E = gamma*pres + pi_inf + 5d-1*rho*vel_K_sum + E = gamma*pres + pi_inf + 5e-1*rho*vel_K_sum H = (E + pres)/rho @@ -881,10 +881,10 @@ contains ! Be careful about the cylindrical coordinate! if (cyl_coord .and. cbc_dir == 2 .and. cbc_loc == 1) then - dpres_dt = -5d-1*(L(advxe) + L(1)) + rho*c*c*vel(dir_idx(1)) & + dpres_dt = -5e-1*(L(advxe) + L(1)) + rho*c*c*vel(dir_idx(1)) & /y_cc(n) else - dpres_dt = -5d-1*(L(advxe) + L(1)) + dpres_dt = -5e-1*(L(advxe) + L(1)) end if !$acc loop seq @@ -957,7 +957,7 @@ contains + dpi_inf_dt & + dqv_dt & + rho*vel_dv_dt_sum & - + 5d-1*drho_dt*vel_K_sum) + + 5e-1*drho_dt*vel_K_sum) if (riemann_solver == 1) then !$acc loop seq diff --git a/src/simulation/m_compute_cbc.fpp b/src/simulation/m_compute_cbc.fpp index e061e4e07f..fab73bc2f1 100644 --- a/src/simulation/m_compute_cbc.fpp +++ b/src/simulation/m_compute_cbc.fpp @@ -73,25 +73,25 @@ contains integer :: i !< Generic loop iterator - L(1) = (5d-1 - 5d-1*sign(1._wp, lambda(1)))*lambda(1) & + L(1) = (5e-1 - 5e-1*sign(1._wp, lambda(1)))*lambda(1) & *(dpres_ds - rho*c*dvel_ds(dir_idx(1))) do i = 2, momxb - L(i) = (5d-1 - 5d-1*sign(1._wp, lambda(2)))*lambda(2) & + L(i) = (5e-1 - 5e-1*sign(1._wp, lambda(2)))*lambda(2) & *(c*c*dalpha_rho_ds(i - 1) - mf(i - 1)*dpres_ds) end do do i = momxb + 1, momxe - L(i) = (5d-1 - 5d-1*sign(1._wp, lambda(2)))*lambda(2) & + L(i) = (5e-1 - 5e-1*sign(1._wp, lambda(2)))*lambda(2) & *(dvel_ds(dir_idx(i - contxe))) end do do i = E_idx, advxe - 1 - L(i) = (5d-1 - 5d-1*sign(1._wp, lambda(2)))*lambda(2) & + L(i) = (5e-1 - 5e-1*sign(1._wp, lambda(2)))*lambda(2) & *(dadv_ds(i - momxe)) end do - L(advxe) = (5d-1 - 5d-1*sign(1._wp, lambda(3)))*lambda(3) & + L(advxe) = (5e-1 - 5e-1*sign(1._wp, lambda(3)))*lambda(3) & *(dpres_ds + rho*c*dvel_ds(dir_idx(1))) end subroutine s_compute_nonreflecting_subsonic_buffer_L diff --git a/src/simulation/m_compute_levelset.fpp b/src/simulation/m_compute_levelset.fpp index 38208e3de0..1aa7504887 100644 --- a/src/simulation/m_compute_levelset.fpp +++ b/src/simulation/m_compute_levelset.fpp @@ -61,7 +61,7 @@ contains dist_vec(1) = x_cc(i) - x_centroid dist_vec(2) = y_cc(j) - y_centroid dist_vec(3) = 0 - dist = dsqrt(sum(dist_vec**2)) + dist = sqrt(sum(dist_vec**2)) levelset(i, j, 0, ib_patch_id) = dist - radius if (dist == 0) then levelset_norm(i, j, 0, ib_patch_id, :) = 0 @@ -108,7 +108,7 @@ contains dist_vec(1) = x_cc(i) - airfoil_grid_u(k)%x dist_vec(2) = y_cc(j) - airfoil_grid_u(k)%y dist_vec(3) = 0 - dist = dsqrt(sum(dist_vec**2)) + dist = sqrt(sum(dist_vec**2)) if (k == 1) then global_dist = dist global_id = k @@ -128,7 +128,7 @@ contains dist_vec(1) = x_cc(i) - airfoil_grid_l(k)%x dist_vec(2) = y_cc(j) - airfoil_grid_l(k)%y dist_vec(3) = 0 - dist = dsqrt(sum(dist_vec**2)) + dist = sqrt(sum(dist_vec**2)) if (k == 1) then global_dist = dist global_id = k @@ -197,7 +197,7 @@ contains dist_vec(1) = x_cc(i) - airfoil_grid_u(k)%x dist_vec(2) = y_cc(j) - airfoil_grid_u(k)%y dist_vec(3) = 0 - dist_surf = dsqrt(sum(dist_vec**2)) + dist_surf = sqrt(sum(dist_vec**2)) if (k == 1) then global_dist = dist_surf global_id = k @@ -217,7 +217,7 @@ contains dist_vec(1) = x_cc(i) - airfoil_grid_l(k)%x dist_vec(2) = y_cc(j) - airfoil_grid_l(k)%y dist_vec(3) = 0 - dist_surf = dsqrt(sum(dist_vec**2)) + dist_surf = sqrt(sum(dist_vec**2)) if (k == 1) then global_dist = dist_surf global_id = k @@ -368,7 +368,7 @@ contains dist_vec(1) = x_cc(i) - x_centroid dist_vec(2) = y_cc(j) - y_centroid dist_vec(3) = z_cc(k) - z_centroid - dist = dsqrt(sum(dist_vec**2)) + dist = sqrt(sum(dist_vec**2)) levelset(i, j, k, ib_patch_id) = dist - radius if (dist == 0) then levelset_norm(i, j, k, ib_patch_id, :) = (/1, 0, 0/) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index f5231c85e4..6cd7bf07dc 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -985,7 +985,7 @@ contains if (t_step_old /= dflt_int) then nondim_time = real(t_step + t_step_old, wp)*dt else - nondim_time = real(t_step, wp)*dt !*1.d-5/10.0761131451_wp + nondim_time = real(t_step, wp)*dt !*1.e-5/10.0761131451_wp end if end if @@ -1088,7 +1088,7 @@ contains nR3 = nR3 + weight(s)*(nR(s)**3._wp) end do - nbub = dsqrt((4._wp*pi/3._wp)*nR3/alf) + nbub = sqrt((4._wp*pi/3._wp)*nR3/alf) end if #ifdef DEBUG print *, 'In probe, nbub: ', nbub @@ -1195,7 +1195,7 @@ contains nR3 = nR3 + weight(s)*(nR(s)**3._wp) end do - nbub = dsqrt((4._wp*pi/3._wp)*nR3/alf) + nbub = sqrt((4._wp*pi/3._wp)*nR3/alf) end if R(:) = nR(:)/nbub @@ -1464,7 +1464,7 @@ contains int_pres = int_pres + (pres - 1._wp)**2._wp end if end do - int_pres = dsqrt(int_pres/(1._wp*npts)) + int_pres = sqrt(int_pres/(1._wp*npts)) if (num_procs > 1) then tmp = int_pres @@ -1496,16 +1496,16 @@ contains trigger = .false. if (i == 1) then !inner portion - if (dsqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) < (rad - 0.5_wp*thickness)) & + if (sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) < (rad - 0.5_wp*thickness)) & trigger = .true. elseif (i == 2) then !net region - if (dsqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad - 0.5_wp*thickness) .and. & - dsqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) < (rad + 0.5_wp*thickness)) & + if (sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad - 0.5_wp*thickness) .and. & + sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) < (rad + 0.5_wp*thickness)) & trigger = .true. elseif (i == 3) then !everything else - if (dsqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad + 0.5_wp*thickness)) & + if (sqrt(x_cb(j)**2._wp + y_cb(k)**2._wp) > (rad + 0.5_wp*thickness)) & trigger = .true. end if diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 1e688088e0..39f567291c 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -680,13 +680,13 @@ contains interp_coeffs = 0._wp - if (dist(1, 1, 1) <= 1d-16) then + if (dist(1, 1, 1) <= 1e-16) then interp_coeffs(1, 1, 1) = 1._wp - else if (dist(2, 1, 1) <= 1d-16) then + else if (dist(2, 1, 1) <= 1e-16) then interp_coeffs(2, 1, 1) = 1._wp - else if (dist(1, 2, 1) <= 1d-16) then + else if (dist(1, 2, 1) <= 1e-16) then interp_coeffs(1, 2, 1) = 1._wp - else if (dist(2, 2, 1) <= 1d-16) then + else if (dist(2, 2, 1) <= 1e-16) then interp_coeffs(2, 2, 1) = 1._wp else eta(:, :, 1) = 1._wp/dist(:, :, 1)**2 @@ -751,21 +751,21 @@ contains (z_cc(k2) - gp%ip_loc(3))**2) interp_coeffs = 0._wp buf = 1._wp - if (dist(1, 1, 1) <= 1d-16) then + if (dist(1, 1, 1) <= 1e-16) then interp_coeffs(1, 1, 1) = 1._wp - else if (dist(2, 1, 1) <= 1d-16) then + else if (dist(2, 1, 1) <= 1e-16) then interp_coeffs(2, 1, 1) = 1._wp - else if (dist(1, 2, 1) <= 1d-16) then + else if (dist(1, 2, 1) <= 1e-16) then interp_coeffs(1, 2, 1) = 1._wp - else if (dist(2, 2, 1) <= 1d-16) then + else if (dist(2, 2, 1) <= 1e-16) then interp_coeffs(2, 2, 1) = 1._wp - else if (dist(1, 1, 2) <= 1d-16) then + else if (dist(1, 1, 2) <= 1e-16) then interp_coeffs(1, 1, 2) = 1._wp - else if (dist(2, 1, 2) <= 1d-16) then + else if (dist(2, 1, 2) <= 1e-16) then interp_coeffs(2, 1, 2) = 1._wp - else if (dist(1, 2, 2) <= 1d-16) then + else if (dist(1, 2, 2) <= 1e-16) then interp_coeffs(1, 2, 2) = 1._wp - else if (dist(2, 2, 2) <= 1d-16) then + else if (dist(2, 2, 2) <= 1e-16) then interp_coeffs(2, 2, 2) = 1._wp else eta = 1._wp/dist**2 diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp index bfbc590dd9..b3b112f3a6 100644 --- a/src/simulation/m_qbmm.fpp +++ b/src/simulation/m_qbmm.fpp @@ -462,9 +462,9 @@ contains end if if (q <= 2) then - AX = R - dsqrt(var) + AX = R - sqrt(var) else - AX = R + dsqrt(var) + AX = R + sqrt(var) end if nb_dot = flux_n_vf(bubxb + (i - 1)*nmom)%sf(j - 1, k, l) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l) @@ -475,15 +475,15 @@ contains (nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i)) if (q <= 2) then - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2._wp)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dx(j)*AX*nb_q**2*sqrt(var)*2._wp)* & (nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2._wp)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dx(j)*AX*nb_q**2*sqrt(var)*2._wp)* & (-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) else - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2._wp)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dx(j)*AX*nb_q**2*sqrt(var)*2._wp)* & (nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2._wp)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dx(j)*AX*nb_q**2*sqrt(var)*2._wp)* & (-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) end if @@ -546,9 +546,9 @@ contains end if if (q <= 2) then - AX = R - dsqrt(var) + AX = R - sqrt(var) else - AX = R + dsqrt(var) + AX = R + sqrt(var) end if nb_dot = flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k - 1, l) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l) @@ -559,15 +559,15 @@ contains (nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i)) if (q <= 2) then - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2._wp)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dy(k)*AX*nb_q**2*sqrt(var)*2._wp)* & (nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2._wp)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dy(k)*AX*nb_q**2*sqrt(var)*2._wp)* & (-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) else - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2._wp)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dy(k)*AX*nb_q**2*sqrt(var)*2._wp)* & (nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2._wp)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dy(k)*AX*nb_q**2*sqrt(var)*2._wp)* & (-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) end if @@ -603,9 +603,9 @@ contains end if if (q <= 2) then - AX = R - dsqrt(var) + AX = R - sqrt(var) else - AX = R + dsqrt(var) + AX = R + sqrt(var) end if nb_dot = q_prim_vf(contxe + idir)%sf(j, k, l)*(flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l)) @@ -616,15 +616,15 @@ contains (nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i)) if (q <= 2) then - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2._wp)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*sqrt(var)*2._wp)* & (nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2._wp)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*sqrt(var)*2._wp)* & (-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) else - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2._wp)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*sqrt(var)*2._wp)* & (nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2._wp)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*y_cc(k)*AX*nb_q**2*sqrt(var)*2._wp)* & (-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) end if end do @@ -654,9 +654,9 @@ contains end if if (q <= 2) then - AX = R - dsqrt(var) + AX = R - sqrt(var) else - AX = R + dsqrt(var) + AX = R + sqrt(var) end if nb_dot = flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l) @@ -667,15 +667,15 @@ contains (nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i)) if (q <= 2) then - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2._wp)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*AX*nb_q**2*sqrt(var)*2._wp)* & (nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2._wp)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3._wp*gam/(dz(l)*AX*nb_q**2*sqrt(var)*2._wp)* & (-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) else - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2._wp)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*AX*nb_q**2*sqrt(var)*2._wp)* & (nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i)) - rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2._wp)* & + rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3._wp*gam/(dz(l)*AX*nb_q**2*sqrt(var)*2._wp)* & (-2._wp*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i)) end if @@ -869,7 +869,7 @@ contains c = n_tait*(pres + B_tait)*(1._wp - alf)/(rho) if (c > 0._wp) then - c = DSQRT(c) + c = sqrt(c) else c = sgm_eps end if @@ -977,16 +977,16 @@ contains drdt = msum(2) if (moms(4) - moms(2)**2._wp > 0._wp) then if (j == 1 .or. j == 2) then - drdt2 = -1._wp/(2._wp*dsqrt(moms(4) - moms(2)**2._wp)) + drdt2 = -1._wp/(2._wp*sqrt(moms(4) - moms(2)**2._wp)) else - drdt2 = 1._wp/(2._wp*dsqrt(moms(4) - moms(2)**2._wp)) + drdt2 = 1._wp/(2._wp*sqrt(moms(4) - moms(2)**2._wp)) end if else ! Edge case where variance < 0 if (j == 1 .or. j == 2) then - drdt2 = -1._wp/(2._wp*dsqrt(verysmall)) + drdt2 = -1._wp/(2._wp*sqrt(verysmall)) else - drdt2 = 1._wp/(2._wp*dsqrt(verysmall)) + drdt2 = 1._wp/(2._wp*sqrt(verysmall)) end if end if @@ -1006,7 +1006,7 @@ contains momsp(1)%sf(id1, id2, id3) = f_quad(abscX, abscY, wght, 3._wp, 0._wp, 0._wp) momsp(2)%sf(id1, id2, id3) = 4._wp*pi*nbub*f_quad(abscX, abscY, wght, 2._wp, 1._wp, 0._wp) momsp(3)%sf(id1, id2, id3) = f_quad(abscX, abscY, wght, 3._wp, 2._wp, 0._wp) - if (abs(gam - 1._wp) <= 1.d-4) then + if (abs(gam - 1._wp) <= 1.e-4) then ! Gam \approx 1, don't risk imaginary quadrature momsp(4)%sf(id1, id2, id3) = 1._wp else @@ -1129,8 +1129,8 @@ contains frho(1) = fmom(1)/2._wp; frho(2) = fmom(1)/2._wp; c2 = maxval((/c2, verysmall/)) - fup(1) = bu - DSQRT(c2) - fup(2) = bu + DSQRT(c2) + fup(1) = bu - sqrt(c2) + fup(2) = bu + sqrt(c2) end subroutine s_hyqmom diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index d70df65b0c..982f1d3eb3 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -6,7 +6,7 @@ #:include 'macros.fpp' !> @brief The module contains the subroutines used to calculate the right- -!! hand-side (RHS) in the quasi-conservative, shock- and interface- +!! hane-side (RHS) in the quasi-conservative, shock- and interface- !! capturing finite-volume framework for the multicomponent Navier- !! Stokes equations supplemented by appropriate advection equations !! used to capture the material interfaces. The system of equations @@ -1285,7 +1285,7 @@ contains do j = 0, m do i = 1, num_fluids rhs_vf(i + intxb - 1)%sf(j, k, l) = & - rhs_vf(i + intxb - 1)%sf(j, k, l) - 5d-1/y_cc(k)* & + rhs_vf(i + intxb - 1)%sf(j, k, l) - 5e-1/y_cc(k)* & q_cons_vf%vf(i + advxb - 1)%sf(j, k, l)* & q_prim_vf%vf(E_idx)%sf(j, k, l)* & (flux_src_n(2)%vf(advxb)%sf(j, k, l) + & @@ -1304,7 +1304,7 @@ contains do k = 0, n do q = 0, m rhs_vf(j)%sf(q, k, l) = & - rhs_vf(j)%sf(q, k, l) - 5d-1/y_cc(k)* & + rhs_vf(j)%sf(q, k, l) - 5e-1/y_cc(k)* & (flux_gsrc_n(2)%vf(j)%sf(q, k - 1, l) & + flux_gsrc_n(2)%vf(j)%sf(q, k, l)) end do @@ -1443,7 +1443,7 @@ contains do q = 0, n do l = 0, m rhs_vf(j)%sf(l, q, k) = & - rhs_vf(j)%sf(l, q, k) - 5d-1/y_cc(q)* & + rhs_vf(j)%sf(l, q, k) - 5e-1/y_cc(q)* & (flux_gsrc_n(3)%vf(j)%sf(l, q, k - 1) & - flux_gsrc_n(3)%vf(j)%sf(l, q, k)) end do @@ -1785,7 +1785,7 @@ contains !$acc loop seq do i = momxb, E_idx rhs_vf(i)%sf(j, k, l) = & - rhs_vf(i)%sf(j, k, l) - 5d-1/y_cc(k)* & + rhs_vf(i)%sf(j, k, l) - 5e-1/y_cc(k)* & (flux_src_n(i)%sf(j, k - 1, l) & + flux_src_n(i)%sf(j, k, l)) end do @@ -1815,7 +1815,7 @@ contains !$acc loop seq do i = momxb, E_idx rhs_vf(i)%sf(j, k, l) = & - rhs_vf(i)%sf(j, k, l) - 5d-1/y_cc(k)* & + rhs_vf(i)%sf(j, k, l) - 5e-1/y_cc(k)* & (flux_src_n(i)%sf(j, k - 1, l) & + flux_src_n(i)%sf(j, k, l)) end do @@ -1864,12 +1864,12 @@ contains do k = 0, n do j = 0, m rhs_vf(momxb + 1)%sf(j, k, l) = & - rhs_vf(momxb + 1)%sf(j, k, l) + 5d-1* & + rhs_vf(momxb + 1)%sf(j, k, l) + 5e-1* & (flux_src_n(momxe)%sf(j, k, l - 1) & + flux_src_n(momxe)%sf(j, k, l)) rhs_vf(momxe)%sf(j, k, l) = & - rhs_vf(momxe)%sf(j, k, l) - 5d-1* & + rhs_vf(momxe)%sf(j, k, l) - 5e-1* & (flux_src_n(momxb + 1)%sf(j, k, l - 1) & + flux_src_n(momxb + 1)%sf(j, k, l)) end do @@ -1965,8 +1965,8 @@ contains q_cons_vf(i + advxb - 1)%sf(j, k, l) & - pi_infs(i))/gammas(i) - if (pres_K_init(i) <= -(1._wp - 1d-8)*pres_inf(i) + 1d-8) & - pres_K_init(i) = -(1._wp - 1d-8)*pres_inf(i) + 1d-8 + if (pres_K_init(i) <= -(1._wp - 1e-8)*pres_inf(i) + 1e-8) & + pres_K_init(i) = -(1._wp - 1e-8)*pres_inf(i) + 1e-8 else pres_K_init(i) = 0._wp end if @@ -1974,7 +1974,7 @@ contains end do ! Iterative process for relaxed pressure determination - f_pres = 1d-9 + f_pres = 1e-9 df_pres = 1d9 !$acc loop seq @@ -1985,13 +1985,13 @@ contains !$acc loop seq do iter = 0, 49 - if (DABS(f_pres) > 1d-10) then + if (abs(f_pres) > 1e-10) then pres_relax = pres_relax - f_pres/df_pres ! Physical pressure do i = 1, num_fluids - if (pres_relax <= -(1._wp - 1d-8)*pres_inf(i) + 1d-8) & - pres_relax = -(1._wp - 1d-8)*pres_inf(i) + 1._wp + if (pres_relax <= -(1._wp - 1e-8)*pres_inf(i) + 1e-8) & + pres_relax = -(1._wp - 1e-8)*pres_inf(i) + 1._wp end do ! Newton-Raphson method @@ -2114,7 +2114,7 @@ contains !$acc loop seq do i = momxb, momxe - dyn_pres = dyn_pres + 5d-1*q_cons_vf(i)%sf(j, k, l)* & + dyn_pres = dyn_pres + 5e-1*q_cons_vf(i)%sf(j, k, l)* & q_cons_vf(i)%sf(j, k, l)/max(rho, sgm_eps) end do diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 2d14710e2b..d3166e4b6b 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -469,8 +469,8 @@ contains end do end if - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R + E_L = gamma_L*pres_L + pi_inf_L + 5e-1*rho_L*vel_L_rms + qv_L + E_R = gamma_R*pres_R + pi_inf_R + 5e-1*rho_R*vel_R_rms + qv_R H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -553,35 +553,35 @@ contains /(rho_L*(s_L - vel_L(dir_idx(1))) - & rho_R*(s_R - vel_R(dir_idx(1)))) elseif (wave_speeds == 2) then - pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & + pres_SL = 5e-1*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(dir_idx(1)) - & vel_R(dir_idx(1)))) pres_SR = pres_SL - Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* & + Ms_L = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_L)/(1._wp + gamma_L))* & (pres_SL/pres_L - 1._wp)*pres_L/ & ((pres_L + pi_inf_L/(1._wp + gamma_L))))) - Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* & + Ms_R = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_R)/(1._wp + gamma_R))* & (pres_SR/pres_R - 1._wp)*pres_R/ & ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R - s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & + s_S = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & (pres_L - pres_R)/ & (rho_avg*c_avg)) end if s_M = min(0._wp, s_L); s_P = max(0._wp, s_R) - xi_M = (5d-1 + sign(5d-1, s_L)) & - + (5d-1 - sign(5d-1, s_L)) & - *(5d-1 + sign(5d-1, s_R)) - xi_P = (5d-1 - sign(5d-1, s_R)) & - + (5d-1 - sign(5d-1, s_L)) & - *(5d-1 + sign(5d-1, s_R)) + xi_M = (5e-1 + sign(5e-1, s_L)) & + + (5e-1 - sign(5e-1, s_L)) & + *(5e-1 + sign(5e-1, s_R)) + xi_P = (5e-1 - sign(5e-1, s_R)) & + + (5e-1 - sign(5e-1, s_L)) & + *(5e-1 + sign(5e-1, s_R)) ! Mass !$acc loop seq @@ -1037,9 +1037,9 @@ contains end do end if - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L + E_L = gamma_L*pres_L + pi_inf_L + 5e-1*rho_L*vel_L_rms + qv_L - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R + E_R = gamma_R*pres_R + pi_inf_R + 5e-1*rho_R*vel_R_rms + qv_R H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -1076,23 +1076,23 @@ contains /(rho_L*(s_L - vel_L(dir_idx(1))) - & rho_R*(s_R - vel_R(dir_idx(1)))) elseif (wave_speeds == 2) then - pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & + pres_SL = 5e-1*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(dir_idx(1)) - & vel_R(dir_idx(1)))) pres_SR = pres_SL - Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* & + Ms_L = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_L)/(1._wp + gamma_L))* & (pres_SL/pres_L - 1._wp)*pres_L/ & ((pres_L + pi_inf_L/(1._wp + gamma_L))))) - Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* & + Ms_R = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_R)/(1._wp + gamma_R))* & (pres_SR/pres_R - 1._wp)*pres_R/ & ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R - s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & + s_S = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & (pres_L - pres_R)/ & (rho_avg*c_avg)) end if @@ -1336,9 +1336,9 @@ contains qv_R = qv_R + alpha_rho_R(i)*qvs(i) end do - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L + E_L = gamma_L*pres_L + pi_inf_L + 5e-1*rho_L*vel_L_rms + qv_L - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R + E_R = gamma_R*pres_R + pi_inf_R + 5e-1*rho_R*vel_R_rms + qv_R H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -1368,23 +1368,23 @@ contains /(rho_L*(s_L - vel_L(dir_idx(1))) - & rho_R*(s_R - vel_R(dir_idx(1)))) elseif (wave_speeds == 2) then - pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & + pres_SL = 5e-1*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(dir_idx(1)) - & vel_R(dir_idx(1)))) pres_SR = pres_SL - Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* & + Ms_L = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_L)/(1._wp + gamma_L))* & (pres_SL/pres_L - 1._wp)*pres_L/ & ((pres_L + pi_inf_L/(1._wp + gamma_L))))) - Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* & + Ms_R = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_R)/(1._wp + gamma_R))* & (pres_SR/pres_R - 1._wp)*pres_R/ & ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R - s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & + s_S = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & (pres_L - pres_R)/ & (rho_avg*c_avg)) end if @@ -1400,8 +1400,8 @@ contains ! goes with numerical velocity in x/y/z directions ! xi_P/M = 0.5 +/m sgn(0.5,s_star) - xi_M = (5d-1 + sign(5d-1, s_S)) - xi_P = (5d-1 - sign(5d-1, s_S)) + xi_M = (5e-1 + sign(5e-1, s_S)) + xi_P = (5e-1 - sign(5e-1, s_S)) !$acc loop seq do i = 1, contxe @@ -1645,9 +1645,9 @@ contains end if end if - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + E_L = gamma_L*pres_L + pi_inf_L + 5e-1*rho_L*vel_L_rms - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + E_R = gamma_R*pres_R + pi_inf_R + 5e-1*rho_R*vel_R_rms H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -1749,14 +1749,14 @@ contains if ((ptilde_L /= ptilde_L) .or. (ptilde_R /= ptilde_R)) then end if - rho_avg = 5d-1*(rho_L + rho_R) - H_avg = 5d-1*(H_L + H_R) - gamma_avg = 5d-1*(gamma_L + gamma_R) + rho_avg = 5e-1*(rho_L + rho_R) + H_avg = 5e-1*(H_L + H_R) + gamma_avg = 5e-1*(gamma_L + gamma_R) vel_avg_rms = 0._wp !$acc loop seq do i = 1, num_dims - vel_avg_rms = vel_avg_rms + (5d-1*(vel_L(i) + vel_R(i)))**2._wp + vel_avg_rms = vel_avg_rms + (5e-1*(vel_L(i) + vel_R(i)))**2._wp end do end if @@ -1795,23 +1795,23 @@ contains /(rho_L*(s_L - vel_L(dir_idx(1))) - & rho_R*(s_R - vel_R(dir_idx(1)))) elseif (wave_speeds == 2) then - pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & + pres_SL = 5e-1*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(dir_idx(1)) - & vel_R(dir_idx(1)))) pres_SR = pres_SL - Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* & + Ms_L = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_L)/(1._wp + gamma_L))* & (pres_SL/pres_L - 1._wp)*pres_L/ & ((pres_L + pi_inf_L/(1._wp + gamma_L))))) - Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* & + Ms_R = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_R)/(1._wp + gamma_R))* & (pres_SR/pres_R - 1._wp)*pres_R/ & ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R - s_S = 5d-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & + s_S = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & (pres_L - pres_R)/ & (rho_avg*c_avg)) end if @@ -1827,8 +1827,8 @@ contains ! goes with numerical velocity in x/y/z directions ! xi_P/M = 0.5 +/m sgn(0.5,s_star) - xi_M = (5d-1 + sign(5d-1, s_S)) - xi_P = (5d-1 - sign(5d-1, s_S)) + xi_M = (5e-1 + sign(5e-1, s_S)) + xi_P = (5e-1 - sign(5e-1, s_S)) if (low_Mach == 1) then @:compute_low_Mach_correction() @@ -2107,9 +2107,9 @@ contains end do end if - E_L = gamma_L*pres_L + pi_inf_L + 5d-1*rho_L*vel_L_rms + qv_L + E_L = gamma_L*pres_L + pi_inf_L + 5e-1*rho_L*vel_L_rms + qv_L - E_R = gamma_R*pres_R + pi_inf_R + 5d-1*rho_R*vel_R_rms + qv_R + E_R = gamma_R*pres_R + pi_inf_R + 5e-1*rho_R*vel_R_rms + qv_R H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -2151,23 +2151,23 @@ contains rho_R*(s_R - vel_R(idx1))) elseif (wave_speeds == 2) then - pres_SL = 5d-1*(pres_L + pres_R + rho_avg*c_avg* & + pres_SL = 5e-1*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(idx1) - & vel_R(idx1))) pres_SR = pres_SL - Ms_L = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_L)/(1._wp + gamma_L))* & + Ms_L = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_L)/(1._wp + gamma_L))* & (pres_SL/pres_L - 1._wp)*pres_L/ & ((pres_L + pi_inf_L/(1._wp + gamma_L))))) - Ms_R = max(1._wp, sqrt(1._wp + ((5d-1 + gamma_R)/(1._wp + gamma_R))* & + Ms_R = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_R)/(1._wp + gamma_R))* & (pres_SR/pres_R - 1._wp)*pres_R/ & ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(idx1) - c_L*Ms_L s_R = vel_R(idx1) + c_R*Ms_R - s_S = 5d-1*((vel_L(idx1) + vel_R(idx1)) + & + s_S = 5e-1*((vel_L(idx1) + vel_R(idx1)) + & (pres_L - pres_R)/ & (rho_avg*c_avg)) end if @@ -2183,8 +2183,8 @@ contains ! goes with numerical velocity in x/y/z directions ! xi_P/M = 0.5 +/m sgn(0.5,s_star) - xi_M = (5d-1 + sign(5d-1, s_S)) - xi_P = (5d-1 - sign(5d-1, s_S)) + xi_M = (5e-1 + sign(5e-1, s_S)) + xi_P = (5e-1 - sign(5e-1, s_S)) if (low_Mach == 1) then @:compute_low_Mach_correction() @@ -3083,7 +3083,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j + 1, k, l)) tau_Re(1, 1) = (4._wp/3._wp)*dvel_avg_dx(1)/ & @@ -3109,7 +3109,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j + 1, k, l)) tau_Re(1, 1) = dvel_avg_dx(1)/ & @@ -3137,17 +3137,17 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - avg_vel(2) = 5d-1*(velL_vf(2)%sf(j, k, l) & + avg_vel(2) = 5e-1*(velL_vf(2)%sf(j, k, l) & + velR_vf(2)%sf(j + 1, k, l)) !$acc loop seq do i = 1, 2 dvel_avg_dy(i) = & - 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) & + 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) & + dvelR_dy_vf(i)%sf(j + 1, k, l)) end do - dvel_avg_dx(2) = 5d-1*(dvelL_dx_vf(2)%sf(j, k, l) & + dvel_avg_dx(2) = 5e-1*(dvelL_dx_vf(2)%sf(j, k, l) & + dvelR_dx_vf(2)%sf(j + 1, k, l)) tau_Re(1, 1) = -(2._wp/3._wp)*(dvel_avg_dy(2) + & @@ -3179,10 +3179,10 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - avg_vel(2) = 5d-1*(velL_vf(2)%sf(j, k, l) & + avg_vel(2) = 5e-1*(velL_vf(2)%sf(j, k, l) & + velR_vf(2)%sf(j + 1, k, l)) - dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvelR_dy_vf(2)%sf(j + 1, k, l)) tau_Re(1, 1) = (dvel_avg_dy(2) + & @@ -3214,11 +3214,11 @@ contains !$acc loop seq do i = 1, 3, 2 dvel_avg_dz(i) = & - 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) & + 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) & + dvelR_dz_vf(i)%sf(j + 1, k, l)) end do - dvel_avg_dx(3) = 5d-1*(dvelL_dx_vf(3)%sf(j, k, l) & + dvel_avg_dx(3) = 5e-1*(dvelL_dx_vf(3)%sf(j, k, l) & + dvelR_dx_vf(3)%sf(j + 1, k, l)) tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dz(3)/y_cc(k)/ & @@ -3252,7 +3252,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvelR_dz_vf(3)%sf(j + 1, k, l)) tau_Re(1, 1) = dvel_avg_dz(3)/y_cc(k)/ & @@ -3283,18 +3283,18 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - avg_vel(2) = 5d-1*(velL_vf(2)%sf(j, k, l) & + avg_vel(2) = 5e-1*(velL_vf(2)%sf(j, k, l) & + velR_vf(2)%sf(j, k + 1, l)) !$acc loop seq do i = 1, 2 dvel_avg_dx(i) = & - 5d-1*(dvelL_dx_vf(i)%sf(j, k, l) & + 5e-1*(dvelL_dx_vf(i)%sf(j, k, l) & + dvelR_dx_vf(i)%sf(j, k + 1, l)) dvel_avg_dy(i) = & - 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) & + 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) & + dvelR_dy_vf(i)%sf(j, k + 1, l)) end do @@ -3332,13 +3332,13 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - avg_vel(2) = 5d-1*(velL_vf(2)%sf(j, k, l) & + avg_vel(2) = 5e-1*(velL_vf(2)%sf(j, k, l) & + velR_vf(2)%sf(j, k + 1, l)) - dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j, k + 1, l)) - dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvelR_dy_vf(2)%sf(j, k + 1, l)) tau_Re(2, 2) = (dvel_avg_dx(1) + dvel_avg_dy(2) + & @@ -3367,17 +3367,17 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - avg_vel(3) = 5d-1*(velL_vf(3)%sf(j, k, l) & + avg_vel(3) = 5e-1*(velL_vf(3)%sf(j, k, l) & + velR_vf(3)%sf(j, k + 1, l)) !$acc loop seq do i = 2, 3 dvel_avg_dz(i) = & - 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) & + 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) & + dvelR_dz_vf(i)%sf(j, k + 1, l)) end do - dvel_avg_dy(3) = 5d-1*(dvelL_dy_vf(3)%sf(j, k, l) & + dvel_avg_dy(3) = 5e-1*(dvelL_dy_vf(3)%sf(j, k, l) & + dvelR_dy_vf(3)%sf(j, k + 1, l)) tau_Re(2, 2) = -(2._wp/3._wp)*dvel_avg_dz(3)/y_cb(k)/ & @@ -3412,7 +3412,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvelR_dz_vf(3)%sf(j, k + 1, l)) tau_Re(2, 2) = dvel_avg_dz(3)/y_cb(k)/ & @@ -3444,27 +3444,27 @@ contains !$acc loop seq do i = 2, 3 - avg_vel(i) = 5d-1*(velL_vf(i)%sf(j, k, l) & + avg_vel(i) = 5e-1*(velL_vf(i)%sf(j, k, l) & + velR_vf(i)%sf(j, k, l + 1)) end do !$acc loop seq do i = 1, 3, 2 dvel_avg_dx(i) = & - 5d-1*(dvelL_dx_vf(i)%sf(j, k, l) & + 5e-1*(dvelL_dx_vf(i)%sf(j, k, l) & + dvelR_dx_vf(i)%sf(j, k, l + 1)) end do do i = 2, 3 dvel_avg_dy(i) = & - 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) & + 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) & + dvelR_dy_vf(i)%sf(j, k, l + 1)) end do !$acc loop seq do i = 1, 3 dvel_avg_dz(i) = & - 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) & + 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) & + dvelR_dz_vf(i)%sf(j, k, l + 1)) end do @@ -3507,16 +3507,16 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - avg_vel(2) = 5d-1*(velL_vf(2)%sf(j, k, l) & + avg_vel(2) = 5e-1*(velL_vf(2)%sf(j, k, l) & + velR_vf(2)%sf(j, k, l + 1)) - dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j, k, l + 1)) - dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvelR_dy_vf(2)%sf(j, k, l + 1)) - dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvelR_dz_vf(3)%sf(j, k, l + 1)) tau_Re(3, 3) = (dvel_avg_dx(1) & @@ -3607,7 +3607,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j + 1, k, l)) tau_Re(1, 1) = (4._wp/3._wp)*dvel_avg_dx(1)/ & @@ -3633,7 +3633,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j + 1, k, l)) tau_Re(1, 1) = dvel_avg_dx(1)/ & @@ -3664,11 +3664,11 @@ contains !$acc loop seq do i = 1, 2 dvel_avg_dy(i) = & - 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) & + 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) & + dvelR_dy_vf(i)%sf(j + 1, k, l)) end do - dvel_avg_dx(2) = 5d-1*(dvelL_dx_vf(2)%sf(j, k, l) & + dvel_avg_dx(2) = 5e-1*(dvelL_dx_vf(2)%sf(j, k, l) & + dvelR_dx_vf(2)%sf(j + 1, k, l)) tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dy(2)/ & @@ -3702,7 +3702,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvelR_dy_vf(2)%sf(j + 1, k, l)) tau_Re(1, 1) = dvel_avg_dy(2)/ & @@ -3733,11 +3733,11 @@ contains !$acc loop seq do i = 1, 3, 2 dvel_avg_dz(i) = & - 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) & + 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) & + dvelR_dz_vf(i)%sf(j + 1, k, l)) end do - dvel_avg_dx(3) = 5d-1*(dvelL_dx_vf(3)%sf(j, k, l) & + dvel_avg_dx(3) = 5e-1*(dvelL_dx_vf(3)%sf(j, k, l) & + dvelR_dx_vf(3)%sf(j + 1, k, l)) tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dz(3)/ & @@ -3770,7 +3770,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvelR_dz_vf(3)%sf(j + 1, k, l)) tau_Re(1, 1) = dvel_avg_dz(3)/ & @@ -3804,11 +3804,11 @@ contains do i = 1, 2 dvel_avg_dx(i) = & - 5d-1*(dvelL_dx_vf(i)%sf(j, k, l) & + 5e-1*(dvelL_dx_vf(i)%sf(j, k, l) & + dvelR_dx_vf(i)%sf(j, k + 1, l)) dvel_avg_dy(i) = & - 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) & + 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) & + dvelR_dy_vf(i)%sf(j, k + 1, l)) end do @@ -3845,10 +3845,10 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j, k + 1, l)) - dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvelR_dy_vf(2)%sf(j, k + 1, l)) tau_Re(2, 2) = (dvel_avg_dx(1) + dvel_avg_dy(2))/ & @@ -3879,11 +3879,11 @@ contains !$acc loop seq do i = 2, 3 dvel_avg_dz(i) = & - 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) & + 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) & + dvelR_dz_vf(i)%sf(j, k + 1, l)) end do - dvel_avg_dy(3) = 5d-1*(dvelL_dy_vf(3)%sf(j, k, l) & + dvel_avg_dy(3) = 5e-1*(dvelL_dy_vf(3)%sf(j, k, l) & + dvelR_dy_vf(3)%sf(j, k + 1, l)) tau_Re(2, 2) = -(2._wp/3._wp)*dvel_avg_dz(3)/ & @@ -3917,7 +3917,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvelR_dz_vf(3)%sf(j, k + 1, l)) tau_Re(2, 2) = dvel_avg_dz(3)/ & @@ -3950,21 +3950,21 @@ contains !$acc loop seq do i = 1, 3, 2 dvel_avg_dx(i) = & - 5d-1*(dvelL_dx_vf(i)%sf(j, k, l) & + 5e-1*(dvelL_dx_vf(i)%sf(j, k, l) & + dvelR_dx_vf(i)%sf(j, k, l + 1)) end do !$acc loop seq do i = 2, 3 dvel_avg_dy(i) = & - 5d-1*(dvelL_dy_vf(i)%sf(j, k, l) & + 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) & + dvelR_dy_vf(i)%sf(j, k, l + 1)) end do !$acc loop seq do i = 1, 3 dvel_avg_dz(i) = & - 5d-1*(dvelL_dz_vf(i)%sf(j, k, l) & + 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) & + dvelR_dz_vf(i)%sf(j, k, l + 1)) end do @@ -4004,13 +4004,13 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dx(1) = 5d-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j, k, l + 1)) - dvel_avg_dy(2) = 5d-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvelR_dy_vf(2)%sf(j, k, l + 1)) - dvel_avg_dz(3) = 5d-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvelR_dz_vf(3)%sf(j, k, l + 1)) tau_Re(3, 3) = (dvel_avg_dx(1) & diff --git a/src/simulation/m_sim_helpers.f90 b/src/simulation/m_sim_helpers.f90 index 30f05fded3..497e2812cd 100644 --- a/src/simulation/m_sim_helpers.f90 +++ b/src/simulation/m_sim_helpers.f90 @@ -62,7 +62,7 @@ subroutine s_compute_enthalpy(q_prim_vf, pres, rho, gamma, pi_inf, Re, H, alpha, pres = q_prim_vf(E_idx)%sf(j, k, l) - E = gamma*pres + pi_inf + 5d-1*rho*vel_sum + qv + E = gamma*pres + pi_inf + 5e-1*rho*vel_sum + qv H = (E + pres)/rho diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index a05c10e021..bde8627070 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -36,7 +36,7 @@ module m_start_up use m_acoustic_src !< Acoustic source calculations - use m_rhs !< Right-hand-side (RHS) evaluation procedures + use m_rhs !< Right-hane-side (RHS) evaluation procedures use m_chemistry !< Chemistry module @@ -1062,7 +1062,7 @@ contains dyn_pres = 0._wp do i = mom_idx%beg, mom_idx%end - dyn_pres = dyn_pres + 5d-1*v_vf(i)%sf(j, k, l)*v_vf(i)%sf(j, k, l) & + dyn_pres = dyn_pres + 5e-1*v_vf(i)%sf(j, k, l)*v_vf(i)%sf(j, k, l) & /max(rho, sgm_eps) end do @@ -1108,7 +1108,7 @@ contains if (t_step == 0) dt_init = dt - if (dt < 1d-3*dt_init) call s_mpi_abort("Delta t has become too small") + if (dt < 1e-3*dt_init) call s_mpi_abort("Delta t has become too small") end if if (cfl_dt) then diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index f5b65be4a0..2a4fb9e195 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -17,7 +17,7 @@ module m_time_steppers use m_global_parameters !< Definitions of the global parameters - use m_rhs !< Right-hand-side (RHS) evaluation procedures + use m_rhs !< Right-hane-side (RHS) evaluation procedures use m_data_output !< Run-time info & solution data output procedures diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp index 6056ee157f..389d024d4b 100644 --- a/src/simulation/m_viscous.fpp +++ b/src/simulation/m_viscous.fpp @@ -679,7 +679,7 @@ contains dqL_prim_dx_n(1)%vf(i)%sf(k, j - 1, l) + & dqR_prim_dx_n(1)%vf(i)%sf(k, j - 1, l)) - dqL_prim_dx_n(2)%vf(i)%sf(k, j, l) = 25d-2* & + dqL_prim_dx_n(2)%vf(i)%sf(k, j, l) = 25e-2* & dqL_prim_dx_n(2)%vf(i)%sf(k, j, l) end do end do @@ -698,7 +698,7 @@ contains dqL_prim_dx_n(1)%vf(i)%sf(k, j, l) + & dqR_prim_dx_n(1)%vf(i)%sf(k, j, l)) - dqR_prim_dx_n(2)%vf(i)%sf(k, j, l) = 25d-2* & + dqR_prim_dx_n(2)%vf(i)%sf(k, j, l) = 25e-2* & dqR_prim_dx_n(2)%vf(i)%sf(k, j, l) end do @@ -718,7 +718,7 @@ contains dqL_prim_dy_n(2)%vf(i)%sf(j - 1, k, l) + & dqR_prim_dy_n(2)%vf(i)%sf(j - 1, k, l)) - dqL_prim_dy_n(1)%vf(i)%sf(j, k, l) = 25d-2* & + dqL_prim_dy_n(1)%vf(i)%sf(j, k, l) = 25e-2* & dqL_prim_dy_n(1)%vf(i)%sf(j, k, l) end do @@ -738,7 +738,7 @@ contains dqL_prim_dy_n(2)%vf(i)%sf(j, k, l) + & dqR_prim_dy_n(2)%vf(i)%sf(j, k, l)) - dqR_prim_dy_n(1)%vf(i)%sf(j, k, l) = 25d-2* & + dqR_prim_dy_n(1)%vf(i)%sf(j, k, l) = 25e-2* & dqR_prim_dy_n(1)%vf(i)%sf(j, k, l) end do @@ -793,7 +793,7 @@ contains dqL_prim_dz_n(3)%vf(i)%sf(j - 1, k, l) + & dqR_prim_dz_n(3)%vf(i)%sf(j - 1, k, l)) - dqL_prim_dz_n(1)%vf(i)%sf(j, k, l) = 25d-2* & + dqL_prim_dz_n(1)%vf(i)%sf(j, k, l) = 25e-2* & dqL_prim_dz_n(1)%vf(i)%sf(j, k, l) end do @@ -814,7 +814,7 @@ contains dqL_prim_dz_n(3)%vf(i)%sf(j, k, l) + & dqR_prim_dz_n(3)%vf(i)%sf(j, k, l)) - dqR_prim_dz_n(1)%vf(i)%sf(j, k, l) = 25d-2* & + dqR_prim_dz_n(1)%vf(i)%sf(j, k, l) = 25e-2* & dqR_prim_dz_n(1)%vf(i)%sf(j, k, l) end do @@ -835,7 +835,7 @@ contains dqL_prim_dz_n(3)%vf(i)%sf(k, j - 1, l) + & dqR_prim_dz_n(3)%vf(i)%sf(k, j - 1, l)) - dqL_prim_dz_n(2)%vf(i)%sf(k, j, l) = 25d-2* & + dqL_prim_dz_n(2)%vf(i)%sf(k, j, l) = 25e-2* & dqL_prim_dz_n(2)%vf(i)%sf(k, j, l) end do @@ -856,7 +856,7 @@ contains dqL_prim_dz_n(3)%vf(i)%sf(k, j, l) + & dqR_prim_dz_n(3)%vf(i)%sf(k, j, l)) - dqR_prim_dz_n(2)%vf(i)%sf(k, j, l) = 25d-2* & + dqR_prim_dz_n(2)%vf(i)%sf(k, j, l) = 25e-2* & dqR_prim_dz_n(2)%vf(i)%sf(k, j, l) end do @@ -877,7 +877,7 @@ contains dqL_prim_dy_n(2)%vf(i)%sf(k, l, j - 1) + & dqR_prim_dy_n(2)%vf(i)%sf(k, l, j - 1)) - dqL_prim_dy_n(3)%vf(i)%sf(k, l, j) = 25d-2* & + dqL_prim_dy_n(3)%vf(i)%sf(k, l, j) = 25e-2* & dqL_prim_dy_n(3)%vf(i)%sf(k, l, j) end do @@ -898,7 +898,7 @@ contains dqL_prim_dy_n(2)%vf(i)%sf(k, l, j) + & dqR_prim_dy_n(2)%vf(i)%sf(k, l, j)) - dqR_prim_dy_n(3)%vf(i)%sf(k, l, j) = 25d-2* & + dqR_prim_dy_n(3)%vf(i)%sf(k, l, j) = 25e-2* & dqR_prim_dy_n(3)%vf(i)%sf(k, l, j) end do @@ -918,7 +918,7 @@ contains dqL_prim_dx_n(1)%vf(i)%sf(k, l, j - 1) + & dqR_prim_dx_n(1)%vf(i)%sf(k, l, j - 1)) - dqL_prim_dx_n(3)%vf(i)%sf(k, l, j) = 25d-2* & + dqL_prim_dx_n(3)%vf(i)%sf(k, l, j) = 25e-2* & dqL_prim_dx_n(3)%vf(i)%sf(k, l, j) end do @@ -937,7 +937,7 @@ contains dqL_prim_dx_n(1)%vf(i)%sf(k, l, j) + & dqR_prim_dx_n(1)%vf(i)%sf(k, l, j)) - dqR_prim_dx_n(3)%vf(i)%sf(k, l, j) = 25d-2* & + dqR_prim_dx_n(3)%vf(i)%sf(k, l, j) = 25e-2* & dqR_prim_dx_n(3)%vf(i)%sf(k, l, j) end do diff --git a/src/simulation/m_weno.fpp b/src/simulation/m_weno.fpp index 02997fddc2..cdc601cc61 100644 --- a/src/simulation/m_weno.fpp +++ b/src/simulation/m_weno.fpp @@ -909,8 +909,8 @@ contains !! stencil. !! @param i Equation number !! @param j First-coordinate cell index - !! @param k Second-coordinate cell index - !! @param l Third-coordinate cell index + !! @param k Secone-coordinate cell index + !! @param l Thire-coordinate cell index subroutine s_preserve_monotonicity(v_rs_ws, vL_rs_vf, vR_rs_vf) real(wp), dimension(startx:, starty:, startz:, 1:), intent(IN) :: v_rs_ws @@ -981,11 +981,11 @@ contains vL_MD = (v_rs_ws(j, k, l, i) & + v_rs_ws(j - 1, k, l, i) & - - d_MD)*5d-1 + - d_MD)*5e-1 vL_LC = v_rs_ws(j, k, l, i) & - (v_rs_ws(j + 1, k, l, i) & - - v_rs_ws(j, k, l, i))*5d-1 + beta_mp*d_LC + - v_rs_ws(j, k, l, i))*5e-1 + beta_mp*d_LC vL_min = max(min(v_rs_ws(j, k, l, i), & v_rs_ws(j - 1, k, l, i), & @@ -1002,8 +1002,8 @@ contains vL_LC)) vL_rs_vf(j, k, l, i) = vL_rs_vf(j, k, l, i) & - + (sign(5d-1, vL_min - vL_rs_vf(j, k, l, i)) & - + sign(5d-1, vL_max - vL_rs_vf(j, k, l, i))) & + + (sign(5e-1, vL_min - vL_rs_vf(j, k, l, i)) & + + sign(5e-1, vL_max - vL_rs_vf(j, k, l, i))) & *min(abs(vL_min - vL_rs_vf(j, k, l, i)), & abs(vL_max - vL_rs_vf(j, k, l, i))) ! END: Left Monotonicity Preserving Bound ========================== @@ -1040,11 +1040,11 @@ contains vR_MD = (v_rs_ws(j, k, l, i) & + v_rs_ws(j + 1, k, l, i) & - - d_MD)*5d-1 + - d_MD)*5e-1 vR_LC = v_rs_ws(j, k, l, i) & + (v_rs_ws(j, k, l, i) & - - v_rs_ws(j - 1, k, l, i))*5d-1 + beta_mp*d_LC + - v_rs_ws(j - 1, k, l, i))*5e-1 + beta_mp*d_LC vR_min = max(min(v_rs_ws(j, k, l, i), & v_rs_ws(j + 1, k, l, i), & @@ -1061,8 +1061,8 @@ contains vR_LC)) vR_rs_vf(j, k, l, i) = vR_rs_vf(j, k, l, i) & - + (sign(5d-1, vR_min - vR_rs_vf(j, k, l, i)) & - + sign(5d-1, vR_max - vR_rs_vf(j, k, l, i))) & + + (sign(5e-1, vR_min - vR_rs_vf(j, k, l, i)) & + + sign(5e-1, vR_max - vR_rs_vf(j, k, l, i))) & *min(abs(vR_min - vR_rs_vf(j, k, l, i)), & abs(vR_max - vR_rs_vf(j, k, l, i))) ! END: Right Monotonicity Preserving Bound ========================= From a25acd2306b0f56c54bb86a9673ea3bad3635652 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Sun, 22 Sep 2024 21:00:52 -0700 Subject: [PATCH 05/68] implement fixes and expand to cover more cases of double precision --- src/common/m_constants.fpp | 10 +- src/common/m_helper.fpp | 20 +-- src/common/m_helper_basic.f90 | 4 +- src/common/m_phase_change.fpp | 24 +-- src/common/m_precision_select.f90 | 2 +- src/common/m_variables_conversion.fpp | 12 +- src/post_process/m_derived_variables.fpp | 14 +- src/pre_process/include/2dHardcodedIC.fpp | 6 +- src/pre_process/include/3dHardcodedIC.fpp | 6 +- src/pre_process/m_assign_variables.fpp | 6 +- src/pre_process/m_grid.f90 | 8 +- src/pre_process/m_patches.fpp | 70 ++++---- src/pre_process/m_perturbation.fpp | 8 +- src/simulation/include/inline_riemann.fpp | 14 +- src/simulation/m_acoustic_src.fpp | 6 +- src/simulation/m_bubbles.fpp | 32 ++-- src/simulation/m_cbc.fpp | 10 +- src/simulation/m_checker.fpp | 8 +- src/simulation/m_compute_cbc.fpp | 10 +- src/simulation/m_data_output.fpp | 4 +- src/simulation/m_ibm.fpp | 24 +-- src/simulation/m_qbmm.fpp | 2 +- src/simulation/m_rhs.fpp | 30 ++-- src/simulation/m_riemann_solvers.fpp | 190 +++++++++++----------- src/simulation/m_sim_helpers.f90 | 2 +- src/simulation/m_start_up.fpp | 6 +- src/simulation/m_viscous.fpp | 24 +-- src/simulation/m_weno.fpp | 16 +- src/syscheck/syscheck.fpp | 2 +- 29 files changed, 285 insertions(+), 285 deletions(-) diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp index fa6fba5152..b93565deaf 100644 --- a/src/common/m_constants.fpp +++ b/src/common/m_constants.fpp @@ -8,11 +8,11 @@ module m_constants character, parameter :: dflt_char = ' ' !< Default string value - real(wp), parameter :: dflt_real = -1d6 !< Default real value - real(wp), parameter :: sgm_eps = 1e-16 !< Segmentation tolerance - real(wp), parameter :: small_alf = 1e-11 !< Small alf tolerance + real(wp), parameter :: dflt_real = -1e6_wp !< Default real value + real(wp), parameter :: sgm_eps = 1e-16_wp !< Segmentation tolerance + real(wp), parameter :: small_alf = 1e-11_wp !< Small alf tolerance real(wp), parameter :: pi = 3.141592653589793_wp !< Pi - real(wp), parameter :: verysmall = 1.e-12 !< Very small number + real(wp), parameter :: verysmall = 1.e-12_wp !< Very small number integer, parameter :: num_stcls_min = 5 !< Minimum # of stencils integer, parameter :: path_len = 400 !< Maximum path length @@ -24,7 +24,7 @@ module m_constants integer, parameter :: num_patches_max = 10 integer, parameter :: pathlen_max = 400 integer, parameter :: nnode = 4 !< Number of QBMM nodes - real(wp), parameter :: capillary_cutoff = 1e-6 !< color function gradient magnitude at which to apply the surface tension fluxes + real(wp), parameter :: capillary_cutoff = 1e-6_wp !< color function gradient magnitude at which to apply the surface tension fluxes real(wp), parameter :: acoustic_spatial_support_width = 2.5_wp !< Spatial support width of acoustic source, used in s_source_spatial real(wp), parameter :: dflt_vcfl_dt = 100._wp !< value of vcfl_dt when viscosity is off for computing adaptive timestep size diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp index ab9bbcaaa7..b7ee1fae1e 100644 --- a/src/common/m_helper.fpp +++ b/src/common/m_helper.fpp @@ -153,7 +153,7 @@ contains if (thermal == 2) gamma_m = 1._wp temp = 293.15_wp - D_m = 0.242e-4 + D_m = 0.242e-4_wp uu = sqrt(pl0/rhol0) omega_ref = 3._wp*k_poly*Ca + 2._wp*(3._wp*k_poly - 1._wp)/Web @@ -260,17 +260,17 @@ contains real(wp), dimension(nb) :: phi ! nondiml. min. & max. initial radii for numerical quadrature - !sd = 0.05D0 - !R0mn = 0.75D0 - !R0mx = 1.3D0 + !sd = 0.05e0_wp + !R0mn = 0.75e0_wp + !R0mx = 1.3e0_wp - !sd = 0.3D0 - !R0mn = 0.3D0 - !R0mx = 6.D0 + !sd = 0.3e0_wp + !R0mn = 0.3e0_wp + !R0mx = 6.e0_wp - !sd = 0.7D0 - !R0mn = 0.12D0 - !R0mx = 150.D0 + !sd = 0.7e0_wp + !R0mn = 0.12e0_wp + !R0mx = 150.e0_wp sd = poly_sigma R0mn = 0.8_wp*exp(-2.8_wp*sd) diff --git a/src/common/m_helper_basic.f90 b/src/common/m_helper_basic.f90 index 9d358e29f1..f65d528c1d 100644 --- a/src/common/m_helper_basic.f90 +++ b/src/common/m_helper_basic.f90 @@ -22,7 +22,7 @@ module m_helper_basic !> This procedure checks if two floating point numbers of wp are within tolerance. !! @param a First number. !! @param b Second number. - !! @param tol_input Relative error (default = 1e-6). + !! @param tol_input Relative error (default = 1e-6_wp). !! @return Result of the comparison. logical function f_approx_equal(a, b, tol_input) result(res) !$acc routine seq @@ -35,7 +35,7 @@ logical function f_approx_equal(a, b, tol_input) result(res) if (present(tol_input)) then tol = tol_input else - tol = 1e-6 + tol = 1e-6_wp end if if (a == b) then diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index b6b4701995..6468bfbda8 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -51,10 +51,10 @@ module m_phase_change !> @name Parameters for the first order transition phase change !> @{ - integer, parameter :: max_iter = 1e8 !< max # of iterations - real(wp), parameter :: pCr = 4.94d7 !< Critical water pressure + integer, parameter :: max_iter = 1e8_wp !< max # of iterations + real(wp), parameter :: pCr = 4.94e7_wp !< Critical water pressure real(wp), parameter :: TCr = 385.05 + 273.15 !< Critical water temperature - real(wp), parameter :: mixM = 1.0e-8 !< threshold for 'mixture cell'. If Y < mixM, phase change does not happen + real(wp), parameter :: mixM = 1.0e-8_wp !< threshold for 'mixture cell'. If Y < mixM, phase change does not happen integer, parameter :: lp = 1 !< index for the liquid phase of the reacting fluid integer, parameter :: vp = 2 !< index for the vapor phase of the reacting fluid !> @} @@ -148,7 +148,7 @@ contains !$acc loop seq do i = momxb, momxe - dynE = dynE + 5.0e-1*q_cons_vf(i)%sf(j, k, l)**2/rho + dynE = dynE + 5.0e-1_wp*q_cons_vf(i)%sf(j, k, l)**2/rho end do @@ -352,12 +352,12 @@ contains ! Maybe improve this condition afterwards. As long as the initial guess is in between -min(ps_inf) ! and infinity, a solution should be able to be found. - pS = 1.0d4 + pS = 1.0e4_wp ! Newton Solver for the pT-equilibrium ns = 0 - ! change this relative error metric. 1E4 is just arbitrary - do while ((abs(pS - pO) > palpha_eps) .and. (abs((pS - pO)/pO) > palpha_eps/1e4) .or. (ns == 0)) + ! change this relative error metric. 1e4_wp is just arbitrary + do while ((abs(pS - pO) > palpha_eps) .and. (abs((pS - pO)/pO) > palpha_eps/1e4_wp) .or. (ns == 0)) ! increasing counter ns = ns + 1 @@ -425,17 +425,17 @@ contains ns = 0 ! Relaxation factor - Om = 1.0e-3 + Om = 1.0e-3_wp p_infpTg = p_infpT if (((pS < 0.0_wp) .and. ((q_cons_vf(lp + contxb - 1)%sf(j, k, l) & + q_cons_vf(vp + contxb - 1)%sf(j, k, l)) > ((rhoe & - gs_min(lp)*ps_inf(lp)/(gs_min(lp) - 1))/qvs(lp)))) .or. & - ((pS >= 0.0_wp) .and. (pS < 1.0e-1))) then + ((pS >= 0.0_wp) .and. (pS < 1.0e-1_wp))) then ! improve this initial condition - pS = 1.0d4 + pS = 1.0e4_wp end if @@ -447,7 +447,7 @@ contains R2D(1) = 0.0_wp; R2D(2) = 0.0_wp DeltamP(1) = 0.0_wp; DeltamP(2) = 0.0_wp do while (((sqrt(R2D(1)**2 + R2D(2)**2) > ptgalpha_eps) & - .and. ((sqrt(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1d6))) & + .and. ((sqrt(R2D(1)**2 + R2D(2)**2)/rhoe) > (ptgalpha_eps/1e6_wp))) & .or. (ns == 0)) ! Updating counter for the iterative procedure @@ -754,7 +754,7 @@ contains ns = 0 ! underrelaxation factor - Om = 1.0e-3 + Om = 1.0e-3_wp do while ((abs(FT) > ptgalpha_eps) .or. (ns == 0)) ! increasing counter ns = ns + 1 diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90 index 8d50ac185c..9299047f74 100644 --- a/src/common/m_precision_select.f90 +++ b/src/common/m_precision_select.f90 @@ -14,7 +14,7 @@ module m_precision_select integer, parameter :: double_precision = selected_real_kind(15, 307) ! Set the working precision (wp) to single or double precision - integer, parameter :: wp = single_precision ! Change this to single_precision if needed + integer, parameter :: wp = double_precision ! Change this to single_precision if needed #ifdef MFC_MPI ! Declare mpi_p as a module variable diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 054255c797..654c9d2c8b 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -189,7 +189,7 @@ contains Y_rs(i) = rhoYks(i)/rho end do - if (sum(Y_rs) > 1e-16) then + if (sum(Y_rs) > 1e-16_wp) then call get_temperature(.true., energy - dyn_p, 1200._wp, Y_rs, T) call get_pressure(rho, T, Y_rs, pres) else @@ -295,7 +295,7 @@ contains alpha_K(i) = min(max(0._wp, alpha_K(i)), 1._wp) end do - alpha_K = alpha_K/max(sum(alpha_K), 1e-16) + alpha_K = alpha_K/max(sum(alpha_K), 1e-16_wp) end if @@ -420,7 +420,7 @@ contains alpha_K(i) = min(max(0._wp, alpha_K(i)), 1._wp) end do - alpha_K = alpha_K/max(sum(alpha_K), 1e-16) + alpha_K = alpha_K/max(sum(alpha_K), 1e-16_wp) end if @@ -987,7 +987,7 @@ contains if (model_eqns /= 4) then qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & /rho_K - dyn_pres_K = dyn_pres_K + 5e-1*qK_cons_vf(i)%sf(j, k, l) & + dyn_pres_K = dyn_pres_K + 5e-1_wp*qK_cons_vf(i)%sf(j, k, l) & *qK_prim_vf(i)%sf(j, k, l) else qK_prim_vf(i)%sf(j, k, l) = qK_cons_vf(i)%sf(j, k, l) & @@ -1349,7 +1349,7 @@ contains ! Computing the energy from the pressure E_K = gamma_K*pres_K + pi_inf_K & - + 5e-1*rho_K*vel_K_sum + qv_K + + 5e-1_wp*rho_K*vel_K_sum + qv_K ! mass flux, this should be \alpha_i \rho_i u_i !$acc loop seq @@ -1468,7 +1468,7 @@ contains (rho*(1._wp - adv(num_fluids))) end if else - c = ((H - 5e-1*vel_sum)/gamma) + c = ((H - 5e-1_wp*vel_sum)/gamma) end if if (mixture_err .and. c < 0._wp) then diff --git a/src/post_process/m_derived_variables.fpp b/src/post_process/m_derived_variables.fpp index 530c654dd6..7fad1f3b21 100644 --- a/src/post_process/m_derived_variables.fpp +++ b/src/post_process/m_derived_variables.fpp @@ -212,7 +212,7 @@ contains end if if (mixture_err .and. q_sf(i, j, k) < 0._wp) then - q_sf(i, j, k) = 1e-16 + q_sf(i, j, k) = 1e-16_wp else q_sf(i, j, k) = sqrt(q_sf(i, j, k)) end if @@ -285,8 +285,8 @@ contains end if end if - if (abs(top) < 1e-8) top = 0._wp - if (abs(bottom) < 1e-8) bottom = 0._wp + if (abs(top) < 1e-8_wp) top = 0._wp + if (abs(bottom) < 1e-8_wp) bottom = 0._wp if (top == bottom) then slope = 1._wp @@ -295,20 +295,20 @@ contains ! (bottom == 0._wp .AND. top /= 0._wp)) THEN ! slope = 0._wp else - slope = (top*bottom)/(bottom**2._wp + 1e-16) + slope = (top*bottom)/(bottom**2._wp + 1e-16_wp) end if ! Flux limiter function if (flux_lim == 1) then ! MINMOD (MM) q_sf(j, k, l) = max(0._wp, min(1._wp, slope)) elseif (flux_lim == 2) then ! MUSCL (MC) - q_sf(j, k, l) = max(0._wp, min(2._wp*slope, 5e-1*(1._wp + slope), 2._wp)) + q_sf(j, k, l) = max(0._wp, min(2._wp*slope, 5e-1_wp*(1._wp + slope), 2._wp)) elseif (flux_lim == 3) then ! OSPRE (OP) - q_sf(j, k, l) = (15e-1*(slope**2._wp + slope))/(slope**2._wp + slope + 1._wp) + q_sf(j, k, l) = (15e-1_wp*(slope**2._wp + slope))/(slope**2._wp + slope + 1._wp) elseif (flux_lim == 4) then ! SUPERBEE (SB) q_sf(j, k, l) = max(0._wp, min(1._wp, 2._wp*slope), min(slope, 2._wp)) elseif (flux_lim == 5) then ! SWEBY (SW) (beta = 1.5) - q_sf(j, k, l) = max(0._wp, min(15e-1*slope, 1._wp), min(slope, 15e-1)) + q_sf(j, k, l) = max(0._wp, min(15e-1_wp*slope, 1._wp), min(slope, 15e-1_wp)) elseif (flux_lim == 6) then ! VAN ALBADA (VA) q_sf(j, k, l) = (slope**2._wp + slope)/(slope**2._wp + 1._wp) elseif (flux_lim == 7) then ! VAN LEER (VL) diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp index fa8b1c0a28..5afa899717 100644 --- a/src/pre_process/include/2dHardcodedIC.fpp +++ b/src/pre_process/include/2dHardcodedIC.fpp @@ -5,7 +5,7 @@ real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph - eps = 1e-9 + eps = 1e-9_wp #:enddef @@ -71,7 +71,7 @@ case (204) ! Rayleigh-Taylor instability rhoH = 3 rhoL = 1 - pRef = 1e5 + pRef = 1e5_wp pInt = pRef h = 0.7 lam = 0.2 @@ -80,7 +80,7 @@ intH = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h - alph = 5e-1*(1 + tanh((y_cc(j) - intH)/2.5e-3)) + alph = 5e-1_wp*(1 + tanh((y_cc(j) - intH)/2.5e-3_wp)) if (alph < eps) alph = eps if (alph > 1 - eps) alph = 1 - eps diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp index 75b2fbd55e..a6fa0b91a9 100644 --- a/src/pre_process/include/3dHardcodedIC.fpp +++ b/src/pre_process/include/3dHardcodedIC.fpp @@ -5,7 +5,7 @@ real(wp) :: eps - eps = 1e-9 + eps = 1e-9_wp #:enddef #:def Hardcoded3D() @@ -14,7 +14,7 @@ case (300) ! Rayleigh-Taylor instability rhoH = 3 rhoL = 1 - pRef = 1e5 + pRef = 1e5_wp pInt = pRef h = 0.7 lam = 0.2 @@ -23,7 +23,7 @@ intH = amp*(sin(2*pi*x_cc(i)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h - alph = 5e-1*(1 + tanh((y_cc(j) - intH)/2.5e-3)) + alph = 5e-1_wp*(1 + tanh((y_cc(j) - intH)/2.5e-3_wp)) if (alph < eps) alph = eps if (alph > 1 - eps) alph = 1 - eps diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp index 4d4c93ab53..c43a79a142 100644 --- a/src/pre_process/m_assign_variables.fpp +++ b/src/pre_process/m_assign_variables.fpp @@ -197,7 +197,7 @@ contains #:endif ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(j, k, l) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(j, k, l) = patch_id end subroutine s_assign_patch_mixture_primitive_variables @@ -216,7 +216,7 @@ contains real(wp) :: R3bar, n0, ratio, nH, vfH, velH, rhoH, deno p0 = 101325 - pres_mag = 1e-1 + pres_mag = 1e-1_wp loc = x_cc(177) n_tait = fluid_pp(1)%gamma B_tait = fluid_pp(1)%pi_inf @@ -669,7 +669,7 @@ contains end if ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(j, k, l) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(j, k, l) = patch_id end subroutine s_assign_patch_species_primitive_variables diff --git a/src/pre_process/m_grid.f90 b/src/pre_process/m_grid.f90 index 17e84be2b4..48491eaff1 100644 --- a/src/pre_process/m_grid.f90 +++ b/src/pre_process/m_grid.f90 @@ -64,7 +64,7 @@ subroutine s_generate_serial_grid dx = (x_domain%end - x_domain%beg)/real(m + 1, wp) do i = 0, m - x_cc(i) = x_domain%beg + 5e-1*dx*real(2*i + 1, wp) + x_cc(i) = x_domain%beg + 5e-1_wp*dx*real(2*i + 1, wp) x_cb(i - 1) = x_domain%beg + dx*real(i, wp) end do @@ -104,7 +104,7 @@ subroutine s_generate_serial_grid dy = (y_domain%end - y_domain%beg)/real(2*n + 1, wp) - y_cc(0) = y_domain%beg + 5e-1*dy + y_cc(0) = y_domain%beg + 5e-1_wp*dy y_cb(-1) = y_domain%beg do i = 1, n @@ -117,7 +117,7 @@ subroutine s_generate_serial_grid dy = (y_domain%end - y_domain%beg)/real(n + 1, wp) do i = 0, n - y_cc(i) = y_domain%beg + 5e-1*dy*real(2*i + 1, wp) + y_cc(i) = y_domain%beg + 5e-1_wp*dy*real(2*i + 1, wp) y_cb(i - 1) = y_domain%beg + dy*real(i, wp) end do @@ -157,7 +157,7 @@ subroutine s_generate_serial_grid dz = (z_domain%end - z_domain%beg)/real(p + 1, wp) do i = 0, p - z_cc(i) = z_domain%beg + 5e-1*dz*real(2*i + 1, wp) + z_cc(i) = z_domain%beg + 5e-1_wp*dz*real(2*i + 1, wp) z_cb(i - 1) = z_domain%beg + dz*real(i, wp) end do diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index 662d2da0d2..00fe8c415f 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -137,7 +137,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(i, 0, 0) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(i, 0, 0) = patch_id end if end do @@ -201,7 +201,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, 0) = patch_id end if end do end do @@ -675,7 +675,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, 0) = patch_id q_prim_vf(alf_idx)%sf(i, j, 0) = patch_icpp(patch_id)%alpha(1)* & exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp) @@ -738,7 +738,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, k) = patch_id q_prim_vf(alf_idx)%sf(i, j, k) = patch_icpp(patch_id)%alpha(1)* & exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp) @@ -809,7 +809,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, 0) = patch_id end if end do end do @@ -889,7 +889,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, k) = patch_id end if end do end do @@ -969,7 +969,7 @@ contains @:analytical() - if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == 4)) then + if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10_wp) .and. (model_eqns == 4)) then !zero density, reassign according to Tait EOS q_prim_vf(1)%sf(i, j, 0) = & (((q_prim_vf(E_idx)%sf(i, j, 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))* & @@ -977,7 +977,7 @@ contains end if ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, 0) = patch_id end if end if @@ -993,7 +993,7 @@ contains @:analytical() - if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == 4)) then + if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10_wp) .and. (model_eqns == 4)) then !zero density, reassign according to Tait EOS q_prim_vf(1)%sf(i, j, 0) = & (((q_prim_vf(E_idx)%sf(i, j, 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))* & @@ -1001,7 +1001,7 @@ contains end if ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, 0) = patch_id end if @@ -1053,7 +1053,7 @@ contains do i = 0, m if (patch_icpp(patch_id)%smoothen) then - eta = 5e-1 + 5e-1*tanh(smooth_coeff/min(dx, dy) & + eta = 5e-1_wp + 5e-1_wp*tanh(smooth_coeff/min(dx, dy) & *(a*x_cc(i) + b*y_cc(j) + c) & /sqrt(a**2 + b**2)) end if @@ -1070,7 +1070,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, 0) = patch_id end if end do @@ -1140,7 +1140,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, 0) = patch_id ! Assign Parameters ========================================================= q_prim_vf(mom_idx%beg)%sf(i, j, 0) = U0*sin(x_cc(i)/L0)*cos(y_cc(j)/L0) @@ -1209,7 +1209,7 @@ contains @:Hardcoded1D() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(i, 0, 0) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(i, 0, 0) = patch_id end if end do @@ -1332,7 +1332,7 @@ contains @:Hardcoded2D() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(i, j, 0) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, 0) = patch_id end if end do @@ -1414,7 +1414,7 @@ contains @:Hardcoded3D() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, k) = patch_id end if @@ -1480,34 +1480,34 @@ contains if (epsilon == 1._wp) then if (beta == 0._wp) then - H = 5e-1*sqrt(3._wp/pi)*cos(sph_phi) + H = 5e-1_wp*sqrt(3._wp/pi)*cos(sph_phi) elseif (beta == 1._wp) then - H = -5e-1*sqrt(3._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi) + H = -5e-1_wp*sqrt(3._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi) end if elseif (epsilon == 2._wp) then if (beta == 0._wp) then - H = 25e-2*sqrt(5._wp/pi)*(3._wp*cos(sph_phi)**2 - 1._wp) + H = 25e-2_wp*sqrt(5._wp/pi)*(3._wp*cos(sph_phi)**2 - 1._wp) elseif (beta == 1._wp) then - H = -5e-1*sqrt(15._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)*cos(sph_phi) + H = -5e-1_wp*sqrt(15._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))*sin(sph_phi)*cos(sph_phi) elseif (beta == 2._wp) then - H = 25e-2*sqrt(15._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))*sin(sph_phi)**2 + H = 25e-2_wp*sqrt(15._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))*sin(sph_phi)**2 end if elseif (epsilon == 3._wp) then if (beta == 0._wp) then - H = 25e-2*sqrt(7._wp/pi)*(5._wp*cos(sph_phi)**3._wp - 3._wp*cos(sph_phi)) + H = 25e-2_wp*sqrt(7._wp/pi)*(5._wp*cos(sph_phi)**3._wp - 3._wp*cos(sph_phi)) elseif (beta == 1._wp) then - H = -125e-3*sqrt(21._wp/pi)*exp(cmplx_i*z_cc(k))*sin(sph_phi)* & + H = -125e-3_wp*sqrt(21._wp/pi)*exp(cmplx_i*z_cc(k))*sin(sph_phi)* & (5._wp*cos(sph_phi)**2 - 1._wp) elseif (beta == 2._wp) then - H = 25e-2*sqrt(105._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* & + H = 25e-2_wp*sqrt(105._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* & sin(sph_phi)**2*cos(sph_phi) elseif (beta == 3._wp) then - H = -125e-3*sqrt(35._wp/pi)*exp(3._wp*cmplx_i*z_cc(k))*sin(sph_phi)**3._wp + H = -125e-3_wp*sqrt(35._wp/pi)*exp(3._wp*cmplx_i*z_cc(k))*sin(sph_phi)**3._wp end if elseif (epsilon == 4._wp) then if (beta == 0._wp) then H = 3._wp/16._wp*sqrt(1._wp/pi)*(35._wp*cos(sph_phi)**4._wp - & - 3d1*cos(sph_phi)**2 + 3._wp) + 3e1_wp*cos(sph_phi)**2 + 3._wp) elseif (beta == 1._wp) then H = -3._wp/8._wp*sqrt(5._wp/pi)*exp(cmplx_i*z_cc(k))* & sin(sph_phi)*(7._wp*cos(sph_phi)**3._wp - 3._wp*cos(sph_phi)) @@ -1524,12 +1524,12 @@ contains elseif (epsilon == 5._wp) then if (beta == 0._wp) then H = 1._wp/16._wp*sqrt(11._wp/pi)*(63._wp*cos(sph_phi)**5._wp - & - 7d1*cos(sph_phi)**3._wp + 15._wp*cos(sph_phi)) + 7e1_wp*cos(sph_phi)**3._wp + 15._wp*cos(sph_phi)) elseif (beta == 1._wp) then H = -1._wp/16._wp*sqrt(165._wp/(2._wp*pi))*exp(cmplx_i*z_cc(k))* & sin(sph_phi)*(21._wp*cos(sph_phi)**4._wp - 14._wp*cos(sph_phi)**2 + 1._wp) elseif (beta == 2._wp) then - H = 125e-3*sqrt(1155._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* & + H = 125e-3_wp*sqrt(1155._wp/(2._wp*pi))*exp(2._wp*cmplx_i*z_cc(k))* & sin(sph_phi)**2*(3._wp*cos(sph_phi)**3._wp - cos(sph_phi)) elseif (beta == 3._wp) then H = -1._wp/32._wp*sqrt(385._wp/pi)*exp(3._wp*cmplx_i*z_cc(k))* & @@ -1728,7 +1728,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, k) = patch_id end if end do @@ -1862,7 +1862,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, k) = patch_id end if end if @@ -1948,7 +1948,7 @@ contains end if if (patch_icpp(patch_id)%smoothen) then - eta = 5e-1 + 5e-1*tanh(smooth_coeff/min(dx, dy, dz) & + eta = 5e-1_wp + 5e-1_wp*tanh(smooth_coeff/min(dx, dy, dz) & *(a*x_cc(i) + & b*cart_y + & c*cart_z + d) & @@ -1968,7 +1968,7 @@ contains @:analytical() ! Updating the patch identities bookkeeping variable - if (1._wp - eta < 1e-16) patch_id_fp(i, j, k) = patch_id + if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, k) = patch_id end if end do @@ -2023,11 +2023,11 @@ contains !call s_model_write("__out__.stl", model) !call s_model_write("__out__.obj", model) - grid_mm(1, :) = (/minval(x_cc) - 0d5*dx, maxval(x_cc) + 0d5*dx/) - grid_mm(2, :) = (/minval(y_cc) - 0d5*dy, maxval(y_cc) + 0d5*dy/) + grid_mm(1, :) = (/minval(x_cc) - 0e5_wp*dx, maxval(x_cc) + 0e5_wp*dx/) + grid_mm(2, :) = (/minval(y_cc) - 0e5_wp*dy, maxval(y_cc) + 0e5_wp*dy/) if (p > 0) then - grid_mm(3, :) = (/minval(z_cc) - 0d5*dz, maxval(z_cc) + 0d5*dz/) + grid_mm(3, :) = (/minval(z_cc) - 0e5_wp*dz, maxval(z_cc) + 0e5_wp*dz/) else grid_mm(3, :) = (/0._wp, 0._wp/) end if diff --git a/src/pre_process/m_perturbation.fpp b/src/pre_process/m_perturbation.fpp index bcfe1f6239..cda101ee46 100644 --- a/src/pre_process/m_perturbation.fpp +++ b/src/pre_process/m_perturbation.fpp @@ -67,7 +67,7 @@ contains perturb_alpha = q_prim_vf(E_idx + perturb_sph_fluid)%sf(i, j, k) ! Perturb partial density fields to match perturbed volume fraction fields - ! IF ((perturb_alpha >= 25e-2) .AND. (perturb_alpha <= 75e-2)) THEN + ! IF ((perturb_alpha >= 25e-2_wp) .AND. (perturb_alpha <= 75e-2_wp)) THEN if ((perturb_alpha /= 0._wp) .and. (perturb_alpha /= 1._wp)) then ! Derive new partial densities @@ -193,7 +193,7 @@ contains f0 = (Ca + 2._wp/Web)*(fR0/fR)**(3._wp*gam_b) - 2._wp/(Web*fR) + 1._wp - Ca - fP f1 = -3._wp*gam_b*(Ca + 2._wp/Web)*(fR0/fR)**(3._wp*gam_b + 1._wp) + 2._wp/(Web*fR**2._wp) - if (abs(f0) <= 1e-10) then + if (abs(f0) <= 1e-10_wp) then ! Converged exit else @@ -583,8 +583,8 @@ contains xci = 0._wp do i = 1, mixlayer_nvar do k = 0, n - xcr((i - 1)*(nbp - 1) + k) = 5e-1*(xbr((i - 1)*nbp + k) + xbr((i - 1)*nbp + k + 1)) - xci((i - 1)*(nbp - 1) + k) = 5e-1*(xbi((i - 1)*nbp + k) + xbi((i - 1)*nbp + k + 1)) + xcr((i - 1)*(nbp - 1) + k) = 5e-1_wp*(xbr((i - 1)*nbp + k) + xbr((i - 1)*nbp + k + 1)) + xci((i - 1)*(nbp - 1) + k) = 5e-1_wp*(xbi((i - 1)*nbp + k) + xbi((i - 1)*nbp + k + 1)) end do end do diff --git a/src/simulation/include/inline_riemann.fpp b/src/simulation/include/inline_riemann.fpp index 6eac3f1a45..6371a3f180 100644 --- a/src/simulation/include/inline_riemann.fpp +++ b/src/simulation/include/inline_riemann.fpp @@ -1,13 +1,13 @@ #:def arithmetic_avg() - rho_avg = 5e-1*(rho_L + rho_R) + rho_avg = 5e-1_wp*(rho_L + rho_R) vel_avg_rms = 0._wp !$acc loop seq do i = 1, num_dims - vel_avg_rms = vel_avg_rms + (5e-1*(vel_L(i) + vel_R(i)))**2._wp + vel_avg_rms = vel_avg_rms + (5e-1_wp*(vel_L(i) + vel_R(i)))**2._wp end do - H_avg = 5e-1*(H_L + H_R) - gamma_avg = 5e-1*(gamma_L + gamma_R) + H_avg = 5e-1_wp*(H_L + H_R) + gamma_avg = 5e-1_wp*(gamma_L + gamma_R) #:enddef arithmetic_avg @@ -46,7 +46,7 @@ #:def compute_low_Mach_correction() - zcoef = min(1._wp, max(vel_L_rms**5e-1/c_L, vel_R_rms**5e-1/c_R)) + zcoef = min(1._wp, max(vel_L_rms**5e-1_wp/c_L, vel_R_rms**5e-1_wp/c_R)) pcorr = 0._wp if (low_Mach == 1) then @@ -55,8 +55,8 @@ (rho_R*(s_R - vel_R(dir_idx(1))) - rho_L*(s_L - vel_L(dir_idx(1))))* & (zcoef - 1._wp) else if (low_Mach == 2) then - vel_L_tmp = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_L(dir_idx(1)) - vel_R(dir_idx(1)))) - vel_R_tmp = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_R(dir_idx(1)) - vel_L(dir_idx(1)))) + vel_L_tmp = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_L(dir_idx(1)) - vel_R(dir_idx(1)))) + vel_R_tmp = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + zcoef*(vel_R(dir_idx(1)) - vel_L(dir_idx(1)))) vel_L(dir_idx(1)) = vel_L_tmp vel_R(dir_idx(1)) = vel_R_tmp end if diff --git a/src/simulation/m_acoustic_src.fpp b/src/simulation/m_acoustic_src.fpp index 7f947b6016..098ed12a01 100644 --- a/src/simulation/m_acoustic_src.fpp +++ b/src/simulation/m_acoustic_src.fpp @@ -384,8 +384,8 @@ contains source = mag(ai)*sign(1._wp, sine_wave) ! Prevent max-norm differences due to compilers to pass CI - if (abs(sine_wave) < 1e-2) then - source = mag(ai)*sine_wave*1d2 + if (abs(sine_wave) < 1e-2_wp) then + source = mag(ai)*sine_wave*1e2_wp end if end if @@ -397,7 +397,7 @@ contains integer :: count integer :: dim real(wp) :: source_spatial, angle, xyz_to_r_ratios(3) - real(wp), parameter :: threshold = 1e-10 + real(wp), parameter :: threshold = 1e-10_wp if (n == 0) then dim = 1 diff --git a/src/simulation/m_bubbles.fpp b/src/simulation/m_bubbles.fpp index c511d12bdd..8dbbf253c1 100644 --- a/src/simulation/m_bubbles.fpp +++ b/src/simulation/m_bubbles.fpp @@ -139,7 +139,7 @@ contains do j = 0, m divu%sf(j, k, l) = 0._wp divu%sf(j, k, l) = & - 5e-1/dx(j)*(q_prim_vf(contxe + idir)%sf(j + 1, k, l) - & + 5e-1_wp/dx(j)*(q_prim_vf(contxe + idir)%sf(j + 1, k, l) - & q_prim_vf(contxe + idir)%sf(j - 1, k, l)) end do @@ -154,7 +154,7 @@ contains do k = 0, n do j = 0, m divu%sf(j, k, l) = divu%sf(j, k, l) + & - 5e-1/dy(k)*(q_prim_vf(contxe + idir)%sf(j, k + 1, l) - & + 5e-1_wp/dy(k)*(q_prim_vf(contxe + idir)%sf(j, k + 1, l) - & q_prim_vf(contxe + idir)%sf(j, k - 1, l)) end do @@ -168,7 +168,7 @@ contains do k = 0, n do j = 0, m divu%sf(j, k, l) = divu%sf(j, k, l) + & - 5e-1/dz(l)*(q_prim_vf(contxe + idir)%sf(j, k, l + 1) - & + 5e-1_wp/dz(l)*(q_prim_vf(contxe + idir)%sf(j, k, l + 1) - & q_prim_vf(contxe + idir)%sf(j, k, l - 1)) end do @@ -352,15 +352,15 @@ contains err4 = abs((myR_tmp1(4) - myR_tmp2(4))/myR_tmp1(4)) err5 = abs((myV_tmp1(4) - myV_tmp2(4))/myV_tmp1(4)) - if (abs(myV_tmp1(4)) < 1e-12) err5 = 0._wp + if (abs(myV_tmp1(4)) < 1e-12_wp) err5 = 0._wp ! Determine acceptance/rejection and update step size ! Rule 1: err1, err2, err3 < tol ! Rule 2: myR_tmp1(4) > 0._wp ! Rule 3: abs((myR_tmp1(4) - myR_tmp2(4))/myR) < tol ! Rule 4: abs((myV_tmp1(4) - myV_tmp2(4))/myV) < tol - if ((err1 <= 1e-4) .and. (err2 <= 1e-4) .and. (err3 <= 1e-4) & - .and. (err4 < 1e-4) .and. (err5 < 1e-4) & + if ((err1 <= 1e-4_wp) .and. (err2 <= 1e-4_wp) .and. (err3 <= 1e-4_wp) & + .and. (err4 < 1e-4_wp) .and. (err5 < 1e-4_wp) & .and. myR_tmp1(4) > 0._wp) then ! Accepted. Finalize the sub-step @@ -371,12 +371,12 @@ contains myV = myV_tmp1(4) ! Update step size for the next sub-step - h = h*min(2._wp, max(0.5_wp, (1e-4/err1)**(1._wp/3._wp))) + h = h*min(2._wp, max(0.5_wp, (1e-4_wp/err1)**(1._wp/3._wp))) exit else ! Rejected. Update step size for the next try on sub-step - if (err2 <= 1e-4) then + if (err2 <= 1e-4_wp) then h = 0.5_wp*h else h = 0.25_wp*h @@ -401,7 +401,7 @@ contains bub_r_src(j, k, l, q) = q_cons_vf(vs(q))%sf(j, k, l) end if - if (alf < 1.e-11) then + if (alf < 1.e-11_wp) then bub_adv_src(j, k, l) = 0._wp bub_r_src(j, k, l, q) = 0._wp bub_v_src(j, k, l, q) = 0._wp @@ -476,10 +476,10 @@ contains ! Compute d0 = ||y0|| and d1 = ||f(x0,y0)|| d0 = sqrt((myR_tmp(1)**2._wp + myV_tmp(1)**2._wp)/2._wp) d1 = sqrt((myV_tmp(1)**2._wp + myA_tmp(1)**2._wp)/2._wp) - if (d0 < 1e-5 .or. d1 < 1e-5) then - h0 = 1e-6 + if (d0 < 1e-5_wp .or. d1 < 1e-5_wp) then + h0 = 1e-6_wp else - h0 = 1e-2*(d0/d1) + h0 = 1e-2_wp*(d0/d1) end if ! Evaluate f(x0+h0,y0+h0*f(x0,y0)) @@ -493,11 +493,11 @@ contains d2 = sqrt(((myV_tmp(2) - myV_tmp(1))**2._wp + (myA_tmp(2) - myA_tmp(1))**2._wp)/2._wp)/h0 ! Set h1 = (0.01/max(d1,d2))^{1/(p+1)} - ! if max(d1,d2) < 1e-15, h1 = max(1e-6, h0*1e-3) - if (max(d1, d2) < 1e-15) then - h1 = max(1e-6, h0*1e-3) + ! if max(d1,d2) < 1e-15_wp, h1 = max(1e-6_wp, h0*1e-3_wp) + if (max(d1, d2) < 1e-15_wp) then + h1 = max(1e-6_wp, h0*1e-3_wp) else - h1 = (1e-2/max(d1, d2))**(1._wp/3._wp) + h1 = (1e-2_wp/max(d1, d2))**(1._wp/3._wp) end if ! Set h = min(100*h0,h1) diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index fdf898aec3..5453297e18 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -483,7 +483,7 @@ contains fd_coef_${XYZ}$ (:, cbc_loc_in) = 0._wp fd_coef_${XYZ}$ (0, cbc_loc_in) = -50._wp/(25._wp*ds(0) + 2._wp*ds(1) & - - 1d1*ds(2) + 1d1*ds(3) & + - 1e1_wp*ds(2) + 1e1_wp*ds(3) & - 3._wp*ds(4)) fd_coef_${XYZ}$ (1, cbc_loc_in) = -48._wp*fd_coef_${XYZ}$ (0, cbc_loc_in)/25._wp fd_coef_${XYZ}$ (2, cbc_loc_in) = 36._wp*fd_coef_${XYZ}$ (0, cbc_loc_in)/25._wp @@ -802,7 +802,7 @@ contains mf(i) = alpha_rho(i)/rho end do - E = gamma*pres + pi_inf + 5e-1*rho*vel_K_sum + E = gamma*pres + pi_inf + 5e-1_wp*rho*vel_K_sum H = (E + pres)/rho @@ -881,10 +881,10 @@ contains ! Be careful about the cylindrical coordinate! if (cyl_coord .and. cbc_dir == 2 .and. cbc_loc == 1) then - dpres_dt = -5e-1*(L(advxe) + L(1)) + rho*c*c*vel(dir_idx(1)) & + dpres_dt = -5e-1_wp*(L(advxe) + L(1)) + rho*c*c*vel(dir_idx(1)) & /y_cc(n) else - dpres_dt = -5e-1*(L(advxe) + L(1)) + dpres_dt = -5e-1_wp*(L(advxe) + L(1)) end if !$acc loop seq @@ -957,7 +957,7 @@ contains + dpi_inf_dt & + dqv_dt & + rho*vel_dv_dt_sum & - + 5e-1*drho_dt*vel_K_sum) + + 5e-1_wp*drho_dt*vel_K_sum) if (riemann_solver == 1) then !$acc loop seq diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index 115f477b7d..4f8bb96f29 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -64,10 +64,10 @@ contains @:PROHIBIT(p + 1 < min(1, p)*num_stcls_min*weno_order, & "For 3D simulation, p must be greater than or equal to (num_stcls_min*weno_order - 1), whose value is "//trim(numStr)) @:PROHIBIT(weno_order /= 1 .and. f_is_default(weno_eps), & - "weno_order != 1, but weno_eps is not set. A typical value of weno_eps is 1e-6") - @:PROHIBIT(weno_eps <= 0._wp, "weno_eps must be positive. A typical value of weno_eps is 1e-6") - @:PROHIBIT(teno .and. f_is_default(teno_CT), "teno is used, but teno_CT is not set. A typical value of teno_CT is 1e-6") - @:PROHIBIT(teno .and. teno_CT <= 0._wp, "teno_CT must be positive. A typical value of teno_CT is 1e-6") + "weno_order != 1, but weno_eps is not set. A typical value of weno_eps is 1e-6_wp") + @:PROHIBIT(weno_eps <= 0._wp, "weno_eps must be positive. A typical value of weno_eps is 1e-6_wp") + @:PROHIBIT(teno .and. f_is_default(teno_CT), "teno is used, but teno_CT is not set. A typical value of teno_CT is 1e-6_wp") + @:PROHIBIT(teno .and. teno_CT <= 0._wp, "teno_CT must be positive. A typical value of teno_CT is 1e-6_wp") @:PROHIBIT(count([mapped_weno, wenoz, teno]) >= 2, "Only one of mapped_weno, wenoz, or teno can be set to true") @:PROHIBIT(weno_order == 1 .and. mapped_weno) @:PROHIBIT(weno_order == 1 .and. wenoz) diff --git a/src/simulation/m_compute_cbc.fpp b/src/simulation/m_compute_cbc.fpp index fab73bc2f1..577536a844 100644 --- a/src/simulation/m_compute_cbc.fpp +++ b/src/simulation/m_compute_cbc.fpp @@ -73,25 +73,25 @@ contains integer :: i !< Generic loop iterator - L(1) = (5e-1 - 5e-1*sign(1._wp, lambda(1)))*lambda(1) & + L(1) = (5e-1_wp - 5e-1_wp*sign(1._wp, lambda(1)))*lambda(1) & *(dpres_ds - rho*c*dvel_ds(dir_idx(1))) do i = 2, momxb - L(i) = (5e-1 - 5e-1*sign(1._wp, lambda(2)))*lambda(2) & + L(i) = (5e-1_wp - 5e-1_wp*sign(1._wp, lambda(2)))*lambda(2) & *(c*c*dalpha_rho_ds(i - 1) - mf(i - 1)*dpres_ds) end do do i = momxb + 1, momxe - L(i) = (5e-1 - 5e-1*sign(1._wp, lambda(2)))*lambda(2) & + L(i) = (5e-1_wp - 5e-1_wp*sign(1._wp, lambda(2)))*lambda(2) & *(dvel_ds(dir_idx(i - contxe))) end do do i = E_idx, advxe - 1 - L(i) = (5e-1 - 5e-1*sign(1._wp, lambda(2)))*lambda(2) & + L(i) = (5e-1_wp - 5e-1_wp*sign(1._wp, lambda(2)))*lambda(2) & *(dadv_ds(i - momxe)) end do - L(advxe) = (5e-1 - 5e-1*sign(1._wp, lambda(3)))*lambda(3) & + L(advxe) = (5e-1_wp - 5e-1_wp*sign(1._wp, lambda(3)))*lambda(3) & *(dpres_ds + rho*c*dvel_ds(dir_idx(1))) end subroutine s_compute_nonreflecting_subsonic_buffer_L diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 6cd7bf07dc..a251292e50 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -985,7 +985,7 @@ contains if (t_step_old /= dflt_int) then nondim_time = real(t_step + t_step_old, wp)*dt else - nondim_time = real(t_step, wp)*dt !*1.e-5/10.0761131451_wp + nondim_time = real(t_step, wp)*dt !*1.e-5_wp/10.0761131451_wp end if end if @@ -1622,7 +1622,7 @@ contains @:ALLOCATE_GLOBAL(Rc_sf (0:m, 0:n, 0:p)) vcfl_max = 0._wp - Rc_min = 1d3 + Rc_min = 1e3_wp end if ! Associating the procedural pointer to the appropriate subroutine diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 39f567291c..18d3b0e025 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -680,13 +680,13 @@ contains interp_coeffs = 0._wp - if (dist(1, 1, 1) <= 1e-16) then + if (dist(1, 1, 1) <= 1e-16_wp) then interp_coeffs(1, 1, 1) = 1._wp - else if (dist(2, 1, 1) <= 1e-16) then + else if (dist(2, 1, 1) <= 1e-16_wp) then interp_coeffs(2, 1, 1) = 1._wp - else if (dist(1, 2, 1) <= 1e-16) then + else if (dist(1, 2, 1) <= 1e-16_wp) then interp_coeffs(1, 2, 1) = 1._wp - else if (dist(2, 2, 1) <= 1e-16) then + else if (dist(2, 2, 1) <= 1e-16_wp) then interp_coeffs(2, 2, 1) = 1._wp else eta(:, :, 1) = 1._wp/dist(:, :, 1)**2 @@ -751,21 +751,21 @@ contains (z_cc(k2) - gp%ip_loc(3))**2) interp_coeffs = 0._wp buf = 1._wp - if (dist(1, 1, 1) <= 1e-16) then + if (dist(1, 1, 1) <= 1e-16_wp) then interp_coeffs(1, 1, 1) = 1._wp - else if (dist(2, 1, 1) <= 1e-16) then + else if (dist(2, 1, 1) <= 1e-16_wp) then interp_coeffs(2, 1, 1) = 1._wp - else if (dist(1, 2, 1) <= 1e-16) then + else if (dist(1, 2, 1) <= 1e-16_wp) then interp_coeffs(1, 2, 1) = 1._wp - else if (dist(2, 2, 1) <= 1e-16) then + else if (dist(2, 2, 1) <= 1e-16_wp) then interp_coeffs(2, 2, 1) = 1._wp - else if (dist(1, 1, 2) <= 1e-16) then + else if (dist(1, 1, 2) <= 1e-16_wp) then interp_coeffs(1, 1, 2) = 1._wp - else if (dist(2, 1, 2) <= 1e-16) then + else if (dist(2, 1, 2) <= 1e-16_wp) then interp_coeffs(2, 1, 2) = 1._wp - else if (dist(1, 2, 2) <= 1e-16) then + else if (dist(1, 2, 2) <= 1e-16_wp) then interp_coeffs(1, 2, 2) = 1._wp - else if (dist(2, 2, 2) <= 1e-16) then + else if (dist(2, 2, 2) <= 1e-16_wp) then interp_coeffs(2, 2, 2) = 1._wp else eta = 1._wp/dist**2 diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp index b3b112f3a6..230a259def 100644 --- a/src/simulation/m_qbmm.fpp +++ b/src/simulation/m_qbmm.fpp @@ -1006,7 +1006,7 @@ contains momsp(1)%sf(id1, id2, id3) = f_quad(abscX, abscY, wght, 3._wp, 0._wp, 0._wp) momsp(2)%sf(id1, id2, id3) = 4._wp*pi*nbub*f_quad(abscX, abscY, wght, 2._wp, 1._wp, 0._wp) momsp(3)%sf(id1, id2, id3) = f_quad(abscX, abscY, wght, 3._wp, 2._wp, 0._wp) - if (abs(gam - 1._wp) <= 1.e-4) then + if (abs(gam - 1._wp) <= 1.e-4_wp) then ! Gam \approx 1, don't risk imaginary quadrature momsp(4)%sf(id1, id2, id3) = 1._wp else diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 982f1d3eb3..e88c901fa4 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -1285,7 +1285,7 @@ contains do j = 0, m do i = 1, num_fluids rhs_vf(i + intxb - 1)%sf(j, k, l) = & - rhs_vf(i + intxb - 1)%sf(j, k, l) - 5e-1/y_cc(k)* & + rhs_vf(i + intxb - 1)%sf(j, k, l) - 5e-1_wp/y_cc(k)* & q_cons_vf%vf(i + advxb - 1)%sf(j, k, l)* & q_prim_vf%vf(E_idx)%sf(j, k, l)* & (flux_src_n(2)%vf(advxb)%sf(j, k, l) + & @@ -1304,7 +1304,7 @@ contains do k = 0, n do q = 0, m rhs_vf(j)%sf(q, k, l) = & - rhs_vf(j)%sf(q, k, l) - 5e-1/y_cc(k)* & + rhs_vf(j)%sf(q, k, l) - 5e-1_wp/y_cc(k)* & (flux_gsrc_n(2)%vf(j)%sf(q, k - 1, l) & + flux_gsrc_n(2)%vf(j)%sf(q, k, l)) end do @@ -1443,7 +1443,7 @@ contains do q = 0, n do l = 0, m rhs_vf(j)%sf(l, q, k) = & - rhs_vf(j)%sf(l, q, k) - 5e-1/y_cc(q)* & + rhs_vf(j)%sf(l, q, k) - 5e-1_wp/y_cc(q)* & (flux_gsrc_n(3)%vf(j)%sf(l, q, k - 1) & - flux_gsrc_n(3)%vf(j)%sf(l, q, k)) end do @@ -1785,7 +1785,7 @@ contains !$acc loop seq do i = momxb, E_idx rhs_vf(i)%sf(j, k, l) = & - rhs_vf(i)%sf(j, k, l) - 5e-1/y_cc(k)* & + rhs_vf(i)%sf(j, k, l) - 5e-1_wp/y_cc(k)* & (flux_src_n(i)%sf(j, k - 1, l) & + flux_src_n(i)%sf(j, k, l)) end do @@ -1815,7 +1815,7 @@ contains !$acc loop seq do i = momxb, E_idx rhs_vf(i)%sf(j, k, l) = & - rhs_vf(i)%sf(j, k, l) - 5e-1/y_cc(k)* & + rhs_vf(i)%sf(j, k, l) - 5e-1_wp/y_cc(k)* & (flux_src_n(i)%sf(j, k - 1, l) & + flux_src_n(i)%sf(j, k, l)) end do @@ -1864,12 +1864,12 @@ contains do k = 0, n do j = 0, m rhs_vf(momxb + 1)%sf(j, k, l) = & - rhs_vf(momxb + 1)%sf(j, k, l) + 5e-1* & + rhs_vf(momxb + 1)%sf(j, k, l) + 5e-1_wp* & (flux_src_n(momxe)%sf(j, k, l - 1) & + flux_src_n(momxe)%sf(j, k, l)) rhs_vf(momxe)%sf(j, k, l) = & - rhs_vf(momxe)%sf(j, k, l) - 5e-1* & + rhs_vf(momxe)%sf(j, k, l) - 5e-1_wp* & (flux_src_n(momxb + 1)%sf(j, k, l - 1) & + flux_src_n(momxb + 1)%sf(j, k, l)) end do @@ -1965,8 +1965,8 @@ contains q_cons_vf(i + advxb - 1)%sf(j, k, l) & - pi_infs(i))/gammas(i) - if (pres_K_init(i) <= -(1._wp - 1e-8)*pres_inf(i) + 1e-8) & - pres_K_init(i) = -(1._wp - 1e-8)*pres_inf(i) + 1e-8 + if (pres_K_init(i) <= -(1._wp - 1e-8_wp)*pres_inf(i) + 1e-8_wp) & + pres_K_init(i) = -(1._wp - 1e-8_wp)*pres_inf(i) + 1e-8_wp else pres_K_init(i) = 0._wp end if @@ -1974,8 +1974,8 @@ contains end do ! Iterative process for relaxed pressure determination - f_pres = 1e-9 - df_pres = 1d9 + f_pres = 1e-9_wp + df_pres = 1e9_wp !$acc loop seq do i = 1, num_fluids @@ -1985,13 +1985,13 @@ contains !$acc loop seq do iter = 0, 49 - if (abs(f_pres) > 1e-10) then + if (abs(f_pres) > 1e-10_wp) then pres_relax = pres_relax - f_pres/df_pres ! Physical pressure do i = 1, num_fluids - if (pres_relax <= -(1._wp - 1e-8)*pres_inf(i) + 1e-8) & - pres_relax = -(1._wp - 1e-8)*pres_inf(i) + 1._wp + if (pres_relax <= -(1._wp - 1e-8_wp)*pres_inf(i) + 1e-8_wp) & + pres_relax = -(1._wp - 1e-8_wp)*pres_inf(i) + 1._wp end do ! Newton-Raphson method @@ -2114,7 +2114,7 @@ contains !$acc loop seq do i = momxb, momxe - dyn_pres = dyn_pres + 5e-1*q_cons_vf(i)%sf(j, k, l)* & + dyn_pres = dyn_pres + 5e-1_wp*q_cons_vf(i)%sf(j, k, l)* & q_cons_vf(i)%sf(j, k, l)/max(rho, sgm_eps) end do diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index d3166e4b6b..0edbd97d5b 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -469,8 +469,8 @@ contains end do end if - E_L = gamma_L*pres_L + pi_inf_L + 5e-1*rho_L*vel_L_rms + qv_L - E_R = gamma_R*pres_R + pi_inf_R + 5e-1*rho_R*vel_R_rms + qv_R + E_L = gamma_L*pres_L + pi_inf_L + 5e-1_wp*rho_L*vel_L_rms + qv_L + E_R = gamma_R*pres_R + pi_inf_R + 5e-1_wp*rho_R*vel_R_rms + qv_R H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -553,35 +553,35 @@ contains /(rho_L*(s_L - vel_L(dir_idx(1))) - & rho_R*(s_R - vel_R(dir_idx(1)))) elseif (wave_speeds == 2) then - pres_SL = 5e-1*(pres_L + pres_R + rho_avg*c_avg* & + pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(dir_idx(1)) - & vel_R(dir_idx(1)))) pres_SR = pres_SL - Ms_L = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_L)/(1._wp + gamma_L))* & + Ms_L = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_L)/(1._wp + gamma_L))* & (pres_SL/pres_L - 1._wp)*pres_L/ & ((pres_L + pi_inf_L/(1._wp + gamma_L))))) - Ms_R = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_R)/(1._wp + gamma_R))* & + Ms_R = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_R)/(1._wp + gamma_R))* & (pres_SR/pres_R - 1._wp)*pres_R/ & ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R - s_S = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & + s_S = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & (pres_L - pres_R)/ & (rho_avg*c_avg)) end if s_M = min(0._wp, s_L); s_P = max(0._wp, s_R) - xi_M = (5e-1 + sign(5e-1, s_L)) & - + (5e-1 - sign(5e-1, s_L)) & - *(5e-1 + sign(5e-1, s_R)) - xi_P = (5e-1 - sign(5e-1, s_R)) & - + (5e-1 - sign(5e-1, s_L)) & - *(5e-1 + sign(5e-1, s_R)) + xi_M = (5e-1_wp + sign(5e-1_wp, s_L)) & + + (5e-1_wp - sign(5e-1_wp, s_L)) & + *(5e-1_wp + sign(5e-1_wp, s_R)) + xi_P = (5e-1_wp - sign(5e-1_wp, s_R)) & + + (5e-1_wp - sign(5e-1_wp, s_L)) & + *(5e-1_wp + sign(5e-1_wp, s_R)) ! Mass !$acc loop seq @@ -1037,9 +1037,9 @@ contains end do end if - E_L = gamma_L*pres_L + pi_inf_L + 5e-1*rho_L*vel_L_rms + qv_L + E_L = gamma_L*pres_L + pi_inf_L + 5e-1_wp*rho_L*vel_L_rms + qv_L - E_R = gamma_R*pres_R + pi_inf_R + 5e-1*rho_R*vel_R_rms + qv_R + E_R = gamma_R*pres_R + pi_inf_R + 5e-1_wp*rho_R*vel_R_rms + qv_R H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -1076,23 +1076,23 @@ contains /(rho_L*(s_L - vel_L(dir_idx(1))) - & rho_R*(s_R - vel_R(dir_idx(1)))) elseif (wave_speeds == 2) then - pres_SL = 5e-1*(pres_L + pres_R + rho_avg*c_avg* & + pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(dir_idx(1)) - & vel_R(dir_idx(1)))) pres_SR = pres_SL - Ms_L = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_L)/(1._wp + gamma_L))* & + Ms_L = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_L)/(1._wp + gamma_L))* & (pres_SL/pres_L - 1._wp)*pres_L/ & ((pres_L + pi_inf_L/(1._wp + gamma_L))))) - Ms_R = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_R)/(1._wp + gamma_R))* & + Ms_R = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_R)/(1._wp + gamma_R))* & (pres_SR/pres_R - 1._wp)*pres_R/ & ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R - s_S = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & + s_S = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & (pres_L - pres_R)/ & (rho_avg*c_avg)) end if @@ -1336,9 +1336,9 @@ contains qv_R = qv_R + alpha_rho_R(i)*qvs(i) end do - E_L = gamma_L*pres_L + pi_inf_L + 5e-1*rho_L*vel_L_rms + qv_L + E_L = gamma_L*pres_L + pi_inf_L + 5e-1_wp*rho_L*vel_L_rms + qv_L - E_R = gamma_R*pres_R + pi_inf_R + 5e-1*rho_R*vel_R_rms + qv_R + E_R = gamma_R*pres_R + pi_inf_R + 5e-1_wp*rho_R*vel_R_rms + qv_R H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -1368,23 +1368,23 @@ contains /(rho_L*(s_L - vel_L(dir_idx(1))) - & rho_R*(s_R - vel_R(dir_idx(1)))) elseif (wave_speeds == 2) then - pres_SL = 5e-1*(pres_L + pres_R + rho_avg*c_avg* & + pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(dir_idx(1)) - & vel_R(dir_idx(1)))) pres_SR = pres_SL - Ms_L = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_L)/(1._wp + gamma_L))* & + Ms_L = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_L)/(1._wp + gamma_L))* & (pres_SL/pres_L - 1._wp)*pres_L/ & ((pres_L + pi_inf_L/(1._wp + gamma_L))))) - Ms_R = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_R)/(1._wp + gamma_R))* & + Ms_R = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_R)/(1._wp + gamma_R))* & (pres_SR/pres_R - 1._wp)*pres_R/ & ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R - s_S = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & + s_S = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & (pres_L - pres_R)/ & (rho_avg*c_avg)) end if @@ -1400,8 +1400,8 @@ contains ! goes with numerical velocity in x/y/z directions ! xi_P/M = 0.5 +/m sgn(0.5,s_star) - xi_M = (5e-1 + sign(5e-1, s_S)) - xi_P = (5e-1 - sign(5e-1, s_S)) + xi_M = (5e-1_wp + sign(5e-1_wp, s_S)) + xi_P = (5e-1_wp - sign(5e-1_wp, s_S)) !$acc loop seq do i = 1, contxe @@ -1645,9 +1645,9 @@ contains end if end if - E_L = gamma_L*pres_L + pi_inf_L + 5e-1*rho_L*vel_L_rms + E_L = gamma_L*pres_L + pi_inf_L + 5e-1_wp*rho_L*vel_L_rms - E_R = gamma_R*pres_R + pi_inf_R + 5e-1*rho_R*vel_R_rms + E_R = gamma_R*pres_R + pi_inf_R + 5e-1_wp*rho_R*vel_R_rms H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -1749,14 +1749,14 @@ contains if ((ptilde_L /= ptilde_L) .or. (ptilde_R /= ptilde_R)) then end if - rho_avg = 5e-1*(rho_L + rho_R) - H_avg = 5e-1*(H_L + H_R) - gamma_avg = 5e-1*(gamma_L + gamma_R) + rho_avg = 5e-1_wp*(rho_L + rho_R) + H_avg = 5e-1_wp*(H_L + H_R) + gamma_avg = 5e-1_wp*(gamma_L + gamma_R) vel_avg_rms = 0._wp !$acc loop seq do i = 1, num_dims - vel_avg_rms = vel_avg_rms + (5e-1*(vel_L(i) + vel_R(i)))**2._wp + vel_avg_rms = vel_avg_rms + (5e-1_wp*(vel_L(i) + vel_R(i)))**2._wp end do end if @@ -1795,23 +1795,23 @@ contains /(rho_L*(s_L - vel_L(dir_idx(1))) - & rho_R*(s_R - vel_R(dir_idx(1)))) elseif (wave_speeds == 2) then - pres_SL = 5e-1*(pres_L + pres_R + rho_avg*c_avg* & + pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(dir_idx(1)) - & vel_R(dir_idx(1)))) pres_SR = pres_SL - Ms_L = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_L)/(1._wp + gamma_L))* & + Ms_L = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_L)/(1._wp + gamma_L))* & (pres_SL/pres_L - 1._wp)*pres_L/ & ((pres_L + pi_inf_L/(1._wp + gamma_L))))) - Ms_R = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_R)/(1._wp + gamma_R))* & + Ms_R = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_R)/(1._wp + gamma_R))* & (pres_SR/pres_R - 1._wp)*pres_R/ & ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(dir_idx(1)) - c_L*Ms_L s_R = vel_R(dir_idx(1)) + c_R*Ms_R - s_S = 5e-1*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & + s_S = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & (pres_L - pres_R)/ & (rho_avg*c_avg)) end if @@ -1827,8 +1827,8 @@ contains ! goes with numerical velocity in x/y/z directions ! xi_P/M = 0.5 +/m sgn(0.5,s_star) - xi_M = (5e-1 + sign(5e-1, s_S)) - xi_P = (5e-1 - sign(5e-1, s_S)) + xi_M = (5e-1_wp + sign(5e-1_wp, s_S)) + xi_P = (5e-1_wp - sign(5e-1_wp, s_S)) if (low_Mach == 1) then @:compute_low_Mach_correction() @@ -2107,9 +2107,9 @@ contains end do end if - E_L = gamma_L*pres_L + pi_inf_L + 5e-1*rho_L*vel_L_rms + qv_L + E_L = gamma_L*pres_L + pi_inf_L + 5e-1_wp*rho_L*vel_L_rms + qv_L - E_R = gamma_R*pres_R + pi_inf_R + 5e-1*rho_R*vel_R_rms + qv_R + E_R = gamma_R*pres_R + pi_inf_R + 5e-1_wp*rho_R*vel_R_rms + qv_R H_L = (E_L + pres_L)/rho_L H_R = (E_R + pres_R)/rho_R @@ -2151,23 +2151,23 @@ contains rho_R*(s_R - vel_R(idx1))) elseif (wave_speeds == 2) then - pres_SL = 5e-1*(pres_L + pres_R + rho_avg*c_avg* & + pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* & (vel_L(idx1) - & vel_R(idx1))) pres_SR = pres_SL - Ms_L = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_L)/(1._wp + gamma_L))* & + Ms_L = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_L)/(1._wp + gamma_L))* & (pres_SL/pres_L - 1._wp)*pres_L/ & ((pres_L + pi_inf_L/(1._wp + gamma_L))))) - Ms_R = max(1._wp, sqrt(1._wp + ((5e-1 + gamma_R)/(1._wp + gamma_R))* & + Ms_R = max(1._wp, sqrt(1._wp + ((5e-1_wp + gamma_R)/(1._wp + gamma_R))* & (pres_SR/pres_R - 1._wp)*pres_R/ & ((pres_R + pi_inf_R/(1._wp + gamma_R))))) s_L = vel_L(idx1) - c_L*Ms_L s_R = vel_R(idx1) + c_R*Ms_R - s_S = 5e-1*((vel_L(idx1) + vel_R(idx1)) + & + s_S = 5e-1_wp*((vel_L(idx1) + vel_R(idx1)) + & (pres_L - pres_R)/ & (rho_avg*c_avg)) end if @@ -2183,8 +2183,8 @@ contains ! goes with numerical velocity in x/y/z directions ! xi_P/M = 0.5 +/m sgn(0.5,s_star) - xi_M = (5e-1 + sign(5e-1, s_S)) - xi_P = (5e-1 - sign(5e-1, s_S)) + xi_M = (5e-1_wp + sign(5e-1_wp, s_S)) + xi_P = (5e-1_wp - sign(5e-1_wp, s_S)) if (low_Mach == 1) then @:compute_low_Mach_correction() @@ -3083,7 +3083,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j + 1, k, l)) tau_Re(1, 1) = (4._wp/3._wp)*dvel_avg_dx(1)/ & @@ -3109,7 +3109,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j + 1, k, l)) tau_Re(1, 1) = dvel_avg_dx(1)/ & @@ -3137,17 +3137,17 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - avg_vel(2) = 5e-1*(velL_vf(2)%sf(j, k, l) & + avg_vel(2) = 5e-1_wp*(velL_vf(2)%sf(j, k, l) & + velR_vf(2)%sf(j + 1, k, l)) !$acc loop seq do i = 1, 2 dvel_avg_dy(i) = & - 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) & + 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) & + dvelR_dy_vf(i)%sf(j + 1, k, l)) end do - dvel_avg_dx(2) = 5e-1*(dvelL_dx_vf(2)%sf(j, k, l) & + dvel_avg_dx(2) = 5e-1_wp*(dvelL_dx_vf(2)%sf(j, k, l) & + dvelR_dx_vf(2)%sf(j + 1, k, l)) tau_Re(1, 1) = -(2._wp/3._wp)*(dvel_avg_dy(2) + & @@ -3179,10 +3179,10 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - avg_vel(2) = 5e-1*(velL_vf(2)%sf(j, k, l) & + avg_vel(2) = 5e-1_wp*(velL_vf(2)%sf(j, k, l) & + velR_vf(2)%sf(j + 1, k, l)) - dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) & + dvelR_dy_vf(2)%sf(j + 1, k, l)) tau_Re(1, 1) = (dvel_avg_dy(2) + & @@ -3214,11 +3214,11 @@ contains !$acc loop seq do i = 1, 3, 2 dvel_avg_dz(i) = & - 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) & + 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) & + dvelR_dz_vf(i)%sf(j + 1, k, l)) end do - dvel_avg_dx(3) = 5e-1*(dvelL_dx_vf(3)%sf(j, k, l) & + dvel_avg_dx(3) = 5e-1_wp*(dvelL_dx_vf(3)%sf(j, k, l) & + dvelR_dx_vf(3)%sf(j + 1, k, l)) tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dz(3)/y_cc(k)/ & @@ -3252,7 +3252,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) & + dvelR_dz_vf(3)%sf(j + 1, k, l)) tau_Re(1, 1) = dvel_avg_dz(3)/y_cc(k)/ & @@ -3283,18 +3283,18 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - avg_vel(2) = 5e-1*(velL_vf(2)%sf(j, k, l) & + avg_vel(2) = 5e-1_wp*(velL_vf(2)%sf(j, k, l) & + velR_vf(2)%sf(j, k + 1, l)) !$acc loop seq do i = 1, 2 dvel_avg_dx(i) = & - 5e-1*(dvelL_dx_vf(i)%sf(j, k, l) & + 5e-1_wp*(dvelL_dx_vf(i)%sf(j, k, l) & + dvelR_dx_vf(i)%sf(j, k + 1, l)) dvel_avg_dy(i) = & - 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) & + 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) & + dvelR_dy_vf(i)%sf(j, k + 1, l)) end do @@ -3332,13 +3332,13 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - avg_vel(2) = 5e-1*(velL_vf(2)%sf(j, k, l) & + avg_vel(2) = 5e-1_wp*(velL_vf(2)%sf(j, k, l) & + velR_vf(2)%sf(j, k + 1, l)) - dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j, k + 1, l)) - dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) & + dvelR_dy_vf(2)%sf(j, k + 1, l)) tau_Re(2, 2) = (dvel_avg_dx(1) + dvel_avg_dy(2) + & @@ -3367,17 +3367,17 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - avg_vel(3) = 5e-1*(velL_vf(3)%sf(j, k, l) & + avg_vel(3) = 5e-1_wp*(velL_vf(3)%sf(j, k, l) & + velR_vf(3)%sf(j, k + 1, l)) !$acc loop seq do i = 2, 3 dvel_avg_dz(i) = & - 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) & + 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) & + dvelR_dz_vf(i)%sf(j, k + 1, l)) end do - dvel_avg_dy(3) = 5e-1*(dvelL_dy_vf(3)%sf(j, k, l) & + dvel_avg_dy(3) = 5e-1_wp*(dvelL_dy_vf(3)%sf(j, k, l) & + dvelR_dy_vf(3)%sf(j, k + 1, l)) tau_Re(2, 2) = -(2._wp/3._wp)*dvel_avg_dz(3)/y_cb(k)/ & @@ -3412,7 +3412,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) & + dvelR_dz_vf(3)%sf(j, k + 1, l)) tau_Re(2, 2) = dvel_avg_dz(3)/y_cb(k)/ & @@ -3444,27 +3444,27 @@ contains !$acc loop seq do i = 2, 3 - avg_vel(i) = 5e-1*(velL_vf(i)%sf(j, k, l) & + avg_vel(i) = 5e-1_wp*(velL_vf(i)%sf(j, k, l) & + velR_vf(i)%sf(j, k, l + 1)) end do !$acc loop seq do i = 1, 3, 2 dvel_avg_dx(i) = & - 5e-1*(dvelL_dx_vf(i)%sf(j, k, l) & + 5e-1_wp*(dvelL_dx_vf(i)%sf(j, k, l) & + dvelR_dx_vf(i)%sf(j, k, l + 1)) end do do i = 2, 3 dvel_avg_dy(i) = & - 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) & + 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) & + dvelR_dy_vf(i)%sf(j, k, l + 1)) end do !$acc loop seq do i = 1, 3 dvel_avg_dz(i) = & - 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) & + 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) & + dvelR_dz_vf(i)%sf(j, k, l + 1)) end do @@ -3507,16 +3507,16 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - avg_vel(2) = 5e-1*(velL_vf(2)%sf(j, k, l) & + avg_vel(2) = 5e-1_wp*(velL_vf(2)%sf(j, k, l) & + velR_vf(2)%sf(j, k, l + 1)) - dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j, k, l + 1)) - dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) & + dvelR_dy_vf(2)%sf(j, k, l + 1)) - dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) & + dvelR_dz_vf(3)%sf(j, k, l + 1)) tau_Re(3, 3) = (dvel_avg_dx(1) & @@ -3607,7 +3607,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j + 1, k, l)) tau_Re(1, 1) = (4._wp/3._wp)*dvel_avg_dx(1)/ & @@ -3633,7 +3633,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j + 1, k, l)) tau_Re(1, 1) = dvel_avg_dx(1)/ & @@ -3664,11 +3664,11 @@ contains !$acc loop seq do i = 1, 2 dvel_avg_dy(i) = & - 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) & + 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) & + dvelR_dy_vf(i)%sf(j + 1, k, l)) end do - dvel_avg_dx(2) = 5e-1*(dvelL_dx_vf(2)%sf(j, k, l) & + dvel_avg_dx(2) = 5e-1_wp*(dvelL_dx_vf(2)%sf(j, k, l) & + dvelR_dx_vf(2)%sf(j + 1, k, l)) tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dy(2)/ & @@ -3702,7 +3702,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) & + dvelR_dy_vf(2)%sf(j + 1, k, l)) tau_Re(1, 1) = dvel_avg_dy(2)/ & @@ -3733,11 +3733,11 @@ contains !$acc loop seq do i = 1, 3, 2 dvel_avg_dz(i) = & - 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) & + 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) & + dvelR_dz_vf(i)%sf(j + 1, k, l)) end do - dvel_avg_dx(3) = 5e-1*(dvelL_dx_vf(3)%sf(j, k, l) & + dvel_avg_dx(3) = 5e-1_wp*(dvelL_dx_vf(3)%sf(j, k, l) & + dvelR_dx_vf(3)%sf(j + 1, k, l)) tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dz(3)/ & @@ -3770,7 +3770,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) & + dvelR_dz_vf(3)%sf(j + 1, k, l)) tau_Re(1, 1) = dvel_avg_dz(3)/ & @@ -3804,11 +3804,11 @@ contains do i = 1, 2 dvel_avg_dx(i) = & - 5e-1*(dvelL_dx_vf(i)%sf(j, k, l) & + 5e-1_wp*(dvelL_dx_vf(i)%sf(j, k, l) & + dvelR_dx_vf(i)%sf(j, k + 1, l)) dvel_avg_dy(i) = & - 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) & + 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) & + dvelR_dy_vf(i)%sf(j, k + 1, l)) end do @@ -3845,10 +3845,10 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j, k + 1, l)) - dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) & + dvelR_dy_vf(2)%sf(j, k + 1, l)) tau_Re(2, 2) = (dvel_avg_dx(1) + dvel_avg_dy(2))/ & @@ -3879,11 +3879,11 @@ contains !$acc loop seq do i = 2, 3 dvel_avg_dz(i) = & - 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) & + 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) & + dvelR_dz_vf(i)%sf(j, k + 1, l)) end do - dvel_avg_dy(3) = 5e-1*(dvelL_dy_vf(3)%sf(j, k, l) & + dvel_avg_dy(3) = 5e-1_wp*(dvelL_dy_vf(3)%sf(j, k, l) & + dvelR_dy_vf(3)%sf(j, k + 1, l)) tau_Re(2, 2) = -(2._wp/3._wp)*dvel_avg_dz(3)/ & @@ -3917,7 +3917,7 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) & + dvelR_dz_vf(3)%sf(j, k + 1, l)) tau_Re(2, 2) = dvel_avg_dz(3)/ & @@ -3950,21 +3950,21 @@ contains !$acc loop seq do i = 1, 3, 2 dvel_avg_dx(i) = & - 5e-1*(dvelL_dx_vf(i)%sf(j, k, l) & + 5e-1_wp*(dvelL_dx_vf(i)%sf(j, k, l) & + dvelR_dx_vf(i)%sf(j, k, l + 1)) end do !$acc loop seq do i = 2, 3 dvel_avg_dy(i) = & - 5e-1*(dvelL_dy_vf(i)%sf(j, k, l) & + 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) & + dvelR_dy_vf(i)%sf(j, k, l + 1)) end do !$acc loop seq do i = 1, 3 dvel_avg_dz(i) = & - 5e-1*(dvelL_dz_vf(i)%sf(j, k, l) & + 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) & + dvelR_dz_vf(i)%sf(j, k, l + 1)) end do @@ -4004,13 +4004,13 @@ contains do k = isy%beg, isy%end do j = isx%beg, isx%end - dvel_avg_dx(1) = 5e-1*(dvelL_dx_vf(1)%sf(j, k, l) & + dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) & + dvelR_dx_vf(1)%sf(j, k, l + 1)) - dvel_avg_dy(2) = 5e-1*(dvelL_dy_vf(2)%sf(j, k, l) & + dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) & + dvelR_dy_vf(2)%sf(j, k, l + 1)) - dvel_avg_dz(3) = 5e-1*(dvelL_dz_vf(3)%sf(j, k, l) & + dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) & + dvelR_dz_vf(3)%sf(j, k, l + 1)) tau_Re(3, 3) = (dvel_avg_dx(1) & diff --git a/src/simulation/m_sim_helpers.f90 b/src/simulation/m_sim_helpers.f90 index 497e2812cd..6b3fa1c4f2 100644 --- a/src/simulation/m_sim_helpers.f90 +++ b/src/simulation/m_sim_helpers.f90 @@ -62,7 +62,7 @@ subroutine s_compute_enthalpy(q_prim_vf, pres, rho, gamma, pi_inf, Re, H, alpha, pres = q_prim_vf(E_idx)%sf(j, k, l) - E = gamma*pres + pi_inf + 5e-1*rho*vel_sum + qv + E = gamma*pres + pi_inf + 5e-1_wp*rho*vel_sum + qv H = (E + pres)/rho diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index bde8627070..819cf3413e 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -1062,7 +1062,7 @@ contains dyn_pres = 0._wp do i = mom_idx%beg, mom_idx%end - dyn_pres = dyn_pres + 5e-1*v_vf(i)%sf(j, k, l)*v_vf(i)%sf(j, k, l) & + dyn_pres = dyn_pres + 5e-1_wp*v_vf(i)%sf(j, k, l)*v_vf(i)%sf(j, k, l) & /max(rho, sgm_eps) end do @@ -1108,7 +1108,7 @@ contains if (t_step == 0) dt_init = dt - if (dt < 1e-3*dt_init) call s_mpi_abort("Delta t has become too small") + if (dt < 1e-3_wp*dt_init) call s_mpi_abort("Delta t has become too small") end if if (cfl_dt) then @@ -1204,7 +1204,7 @@ contains io_time_final = maxval(io_proc_time) end if - grind_time = time_final*1.0d9/(sys_size*maxval((/1,m_glb/))*maxval((/1,n_glb/))*maxval((/1,p_glb/))) + grind_time = time_final*1.0e9_wp/(sys_size*maxval((/1,m_glb/))*maxval((/1,n_glb/))*maxval((/1,p_glb/))) print *, "Performance:", grind_time, "ns/gp/eq/rhs" inquire (FILE='time_data.dat', EXIST=file_exists) diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp index 389d024d4b..60d9158150 100644 --- a/src/simulation/m_viscous.fpp +++ b/src/simulation/m_viscous.fpp @@ -679,7 +679,7 @@ contains dqL_prim_dx_n(1)%vf(i)%sf(k, j - 1, l) + & dqR_prim_dx_n(1)%vf(i)%sf(k, j - 1, l)) - dqL_prim_dx_n(2)%vf(i)%sf(k, j, l) = 25e-2* & + dqL_prim_dx_n(2)%vf(i)%sf(k, j, l) = 25e-2_wp* & dqL_prim_dx_n(2)%vf(i)%sf(k, j, l) end do end do @@ -698,7 +698,7 @@ contains dqL_prim_dx_n(1)%vf(i)%sf(k, j, l) + & dqR_prim_dx_n(1)%vf(i)%sf(k, j, l)) - dqR_prim_dx_n(2)%vf(i)%sf(k, j, l) = 25e-2* & + dqR_prim_dx_n(2)%vf(i)%sf(k, j, l) = 25e-2_wp* & dqR_prim_dx_n(2)%vf(i)%sf(k, j, l) end do @@ -718,7 +718,7 @@ contains dqL_prim_dy_n(2)%vf(i)%sf(j - 1, k, l) + & dqR_prim_dy_n(2)%vf(i)%sf(j - 1, k, l)) - dqL_prim_dy_n(1)%vf(i)%sf(j, k, l) = 25e-2* & + dqL_prim_dy_n(1)%vf(i)%sf(j, k, l) = 25e-2_wp* & dqL_prim_dy_n(1)%vf(i)%sf(j, k, l) end do @@ -738,7 +738,7 @@ contains dqL_prim_dy_n(2)%vf(i)%sf(j, k, l) + & dqR_prim_dy_n(2)%vf(i)%sf(j, k, l)) - dqR_prim_dy_n(1)%vf(i)%sf(j, k, l) = 25e-2* & + dqR_prim_dy_n(1)%vf(i)%sf(j, k, l) = 25e-2_wp* & dqR_prim_dy_n(1)%vf(i)%sf(j, k, l) end do @@ -793,7 +793,7 @@ contains dqL_prim_dz_n(3)%vf(i)%sf(j - 1, k, l) + & dqR_prim_dz_n(3)%vf(i)%sf(j - 1, k, l)) - dqL_prim_dz_n(1)%vf(i)%sf(j, k, l) = 25e-2* & + dqL_prim_dz_n(1)%vf(i)%sf(j, k, l) = 25e-2_wp* & dqL_prim_dz_n(1)%vf(i)%sf(j, k, l) end do @@ -814,7 +814,7 @@ contains dqL_prim_dz_n(3)%vf(i)%sf(j, k, l) + & dqR_prim_dz_n(3)%vf(i)%sf(j, k, l)) - dqR_prim_dz_n(1)%vf(i)%sf(j, k, l) = 25e-2* & + dqR_prim_dz_n(1)%vf(i)%sf(j, k, l) = 25e-2_wp* & dqR_prim_dz_n(1)%vf(i)%sf(j, k, l) end do @@ -835,7 +835,7 @@ contains dqL_prim_dz_n(3)%vf(i)%sf(k, j - 1, l) + & dqR_prim_dz_n(3)%vf(i)%sf(k, j - 1, l)) - dqL_prim_dz_n(2)%vf(i)%sf(k, j, l) = 25e-2* & + dqL_prim_dz_n(2)%vf(i)%sf(k, j, l) = 25e-2_wp* & dqL_prim_dz_n(2)%vf(i)%sf(k, j, l) end do @@ -856,7 +856,7 @@ contains dqL_prim_dz_n(3)%vf(i)%sf(k, j, l) + & dqR_prim_dz_n(3)%vf(i)%sf(k, j, l)) - dqR_prim_dz_n(2)%vf(i)%sf(k, j, l) = 25e-2* & + dqR_prim_dz_n(2)%vf(i)%sf(k, j, l) = 25e-2_wp* & dqR_prim_dz_n(2)%vf(i)%sf(k, j, l) end do @@ -877,7 +877,7 @@ contains dqL_prim_dy_n(2)%vf(i)%sf(k, l, j - 1) + & dqR_prim_dy_n(2)%vf(i)%sf(k, l, j - 1)) - dqL_prim_dy_n(3)%vf(i)%sf(k, l, j) = 25e-2* & + dqL_prim_dy_n(3)%vf(i)%sf(k, l, j) = 25e-2_wp* & dqL_prim_dy_n(3)%vf(i)%sf(k, l, j) end do @@ -898,7 +898,7 @@ contains dqL_prim_dy_n(2)%vf(i)%sf(k, l, j) + & dqR_prim_dy_n(2)%vf(i)%sf(k, l, j)) - dqR_prim_dy_n(3)%vf(i)%sf(k, l, j) = 25e-2* & + dqR_prim_dy_n(3)%vf(i)%sf(k, l, j) = 25e-2_wp* & dqR_prim_dy_n(3)%vf(i)%sf(k, l, j) end do @@ -918,7 +918,7 @@ contains dqL_prim_dx_n(1)%vf(i)%sf(k, l, j - 1) + & dqR_prim_dx_n(1)%vf(i)%sf(k, l, j - 1)) - dqL_prim_dx_n(3)%vf(i)%sf(k, l, j) = 25e-2* & + dqL_prim_dx_n(3)%vf(i)%sf(k, l, j) = 25e-2_wp* & dqL_prim_dx_n(3)%vf(i)%sf(k, l, j) end do @@ -937,7 +937,7 @@ contains dqL_prim_dx_n(1)%vf(i)%sf(k, l, j) + & dqR_prim_dx_n(1)%vf(i)%sf(k, l, j)) - dqR_prim_dx_n(3)%vf(i)%sf(k, l, j) = 25e-2* & + dqR_prim_dx_n(3)%vf(i)%sf(k, l, j) = 25e-2_wp* & dqR_prim_dx_n(3)%vf(i)%sf(k, l, j) end do diff --git a/src/simulation/m_weno.fpp b/src/simulation/m_weno.fpp index cdc601cc61..143f25404d 100644 --- a/src/simulation/m_weno.fpp +++ b/src/simulation/m_weno.fpp @@ -981,11 +981,11 @@ contains vL_MD = (v_rs_ws(j, k, l, i) & + v_rs_ws(j - 1, k, l, i) & - - d_MD)*5e-1 + - d_MD)*5e-1_wp vL_LC = v_rs_ws(j, k, l, i) & - (v_rs_ws(j + 1, k, l, i) & - - v_rs_ws(j, k, l, i))*5e-1 + beta_mp*d_LC + - v_rs_ws(j, k, l, i))*5e-1_wp + beta_mp*d_LC vL_min = max(min(v_rs_ws(j, k, l, i), & v_rs_ws(j - 1, k, l, i), & @@ -1002,8 +1002,8 @@ contains vL_LC)) vL_rs_vf(j, k, l, i) = vL_rs_vf(j, k, l, i) & - + (sign(5e-1, vL_min - vL_rs_vf(j, k, l, i)) & - + sign(5e-1, vL_max - vL_rs_vf(j, k, l, i))) & + + (sign(5e-1_wp, vL_min - vL_rs_vf(j, k, l, i)) & + + sign(5e-1_wp, vL_max - vL_rs_vf(j, k, l, i))) & *min(abs(vL_min - vL_rs_vf(j, k, l, i)), & abs(vL_max - vL_rs_vf(j, k, l, i))) ! END: Left Monotonicity Preserving Bound ========================== @@ -1040,11 +1040,11 @@ contains vR_MD = (v_rs_ws(j, k, l, i) & + v_rs_ws(j + 1, k, l, i) & - - d_MD)*5e-1 + - d_MD)*5e-1_wp vR_LC = v_rs_ws(j, k, l, i) & + (v_rs_ws(j, k, l, i) & - - v_rs_ws(j - 1, k, l, i))*5e-1 + beta_mp*d_LC + - v_rs_ws(j - 1, k, l, i))*5e-1_wp + beta_mp*d_LC vR_min = max(min(v_rs_ws(j, k, l, i), & v_rs_ws(j + 1, k, l, i), & @@ -1061,8 +1061,8 @@ contains vR_LC)) vR_rs_vf(j, k, l, i) = vR_rs_vf(j, k, l, i) & - + (sign(5e-1, vR_min - vR_rs_vf(j, k, l, i)) & - + sign(5e-1, vR_max - vR_rs_vf(j, k, l, i))) & + + (sign(5e-1_wp, vR_min - vR_rs_vf(j, k, l, i)) & + + sign(5e-1_wp, vR_max - vR_rs_vf(j, k, l, i))) & *min(abs(vR_min - vR_rs_vf(j, k, l, i)), & abs(vR_max - vR_rs_vf(j, k, l, i))) ! END: Right Monotonicity Preserving Bound ========================= diff --git a/src/syscheck/syscheck.fpp b/src/syscheck/syscheck.fpp index de613a6f8d..3b9334bb50 100644 --- a/src/syscheck/syscheck.fpp +++ b/src/syscheck/syscheck.fpp @@ -53,7 +53,7 @@ program syscheck @:ACC(integer(acc_device_kind) :: devtype) @:ACC(integer :: i, num_devices) - @:ACC(real(kind(0d0)), allocatable, dimension(:) :: arr) + @:ACC(real(kind(0e0_wp)), allocatable, dimension(:) :: arr) @:ACC(integer, parameter :: N = 100) @:MPIC(call mpi_init(ierr)) From 867a17f75f5b928c84918ad6205b7618b72cc45f Mon Sep 17 00:00:00 2001 From: aricer123 <107273558+aricer123@users.noreply.github.com> Date: Mon, 23 Sep 2024 12:20:51 -0400 Subject: [PATCH 06/68] Update m_precision_select.f90 Check if old method of checking MPI support passes mpi tests --- src/common/m_precision_select.f90 | 32 +++++++------------------------ 1 file changed, 7 insertions(+), 25 deletions(-) diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90 index 9299047f74..a95ffbb736 100644 --- a/src/common/m_precision_select.f90 +++ b/src/common/m_precision_select.f90 @@ -1,41 +1,23 @@ -!> @file m_precision_select.f90 -!> @brief Contains module m_precision_select +!> +!! @file m_precision_select.f90 +!! @brief Contains module m_precision_select !> @brief This file contains the definition of floating point used in MFC module m_precision_select #ifdef MFC_MPI - use mpi !< Message Passing Interface (MPI) module + use mpi !< Message passing interface (MPI) module #endif implicit none - ! Define the available precision types integer, parameter :: single_precision = selected_real_kind(6, 37) integer, parameter :: double_precision = selected_real_kind(15, 307) - ! Set the working precision (wp) to single or double precision - integer, parameter :: wp = double_precision ! Change this to single_precision if needed - + integer, parameter :: wp = double_precision #ifdef MFC_MPI - ! Declare mpi_p as a module variable - integer :: mpi_p + integer, parameter :: mpi_p = MPI_DOUBLE_PRECISION #else integer, parameter :: mpi_p = -100 #endif -contains - - ! Subroutine to initialize mpi_p based on wp - subroutine initialize_precision() -#ifdef MFC_MPI - if (wp == single_precision) then - mpi_p = MPI_FLOAT - else if (wp == double_precision) then - mpi_p = MPI_DOUBLE_PRECISION - else - stop 'Unsupported precision kind.' - end if -#endif - end subroutine initialize_precision - -end module m_precision_select \ No newline at end of file +end module m_precision_select From 6707790603d106aaad24f328f2cdc5e0718cdb59 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Tue, 24 Sep 2024 14:44:22 -0700 Subject: [PATCH 07/68] attempt fix for double precision with mpi support --- src/common/m_phase_change.fpp | 2 +- src/common/m_precision_select.f90 | 13 ++- src/pre_process/m_patches.fpp | 16 ++-- src/simulation/m_bubbles.fpp | 6 +- src/simulation/m_riemann_solvers.fpp | 138 +++++++++++++-------------- 5 files changed, 89 insertions(+), 86 deletions(-) diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 6468bfbda8..452c0b8618 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -247,7 +247,7 @@ contains ! entropy sk(1:num_fluids) = cvs(1:num_fluids)*log((TS**gs_min(1:num_fluids)) & - /((pS + ps_inf(1:num_fluids))**(gs_min(1:num_fluids) - 1.0_wp))) + qvps(1:num_fluids) + /((pS + ps_inf(1:num_fluids))**(gs_min(1:num_fluids) - 1.0_wp))) + qvps(1:num_fluids) ! enthalpy hk(1:num_fluids) = gs_min(1:num_fluids)*cvs(1:num_fluids)*TS & diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90 index a95ffbb736..3f5a7e8bb0 100644 --- a/src/common/m_precision_select.f90 +++ b/src/common/m_precision_select.f90 @@ -1,5 +1,4 @@ -!> -!! @file m_precision_select.f90 +!> @file m_precision_select.f90 !! @brief Contains module m_precision_select !> @brief This file contains the definition of floating point used in MFC @@ -10,14 +9,18 @@ module m_precision_select implicit none + ! Define the available precision types integer, parameter :: single_precision = selected_real_kind(6, 37) integer, parameter :: double_precision = selected_real_kind(15, 307) - integer, parameter :: wp = double_precision + ! Set the working precision (wp) to single or double precision + integer, parameter :: wp = double_precision ! Change to single_precision if needed + #ifdef MFC_MPI - integer, parameter :: mpi_p = MPI_DOUBLE_PRECISION + ! Set mpi_p based on wp using the merge intrinsic function + integer, parameter :: mpi_p = merge(MPI_DOUBLE_PRECISION, MPI_FLOAT, wp == double_precision) #else - integer, parameter :: mpi_p = -100 + integer, parameter :: mpi_p = -100 ! Default value when MPI is not used #endif end module m_precision_select diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index 00fe8c415f..2859850eb0 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -663,7 +663,7 @@ contains do j = 0, n do i = 0, m myr = sqrt((x_cc(i) - x_centroid)**2 & - + (y_cc(j) - y_centroid)**2) + + (y_cc(j) - y_centroid)**2) if (myr <= radius + thickness/2._wp .and. & myr >= radius - thickness/2._wp .and. & @@ -726,7 +726,7 @@ contains do j = 0, n do i = 0, m myr = sqrt((x_cc(i) - x_centroid)**2 & - + (y_cc(j) - y_centroid)**2) + + (y_cc(j) - y_centroid)**2) if (myr <= radius + thickness/2._wp .and. & myr >= radius - thickness/2._wp .and. & @@ -1054,8 +1054,8 @@ contains if (patch_icpp(patch_id)%smoothen) then eta = 5e-1_wp + 5e-1_wp*tanh(smooth_coeff/min(dx, dy) & - *(a*x_cc(i) + b*y_cc(j) + c) & - /sqrt(a**2 + b**2)) + *(a*x_cc(i) + b*y_cc(j) + c) & + /sqrt(a**2 + b**2)) end if if ((a*x_cc(i) + b*y_cc(j) + c >= 0._wp & @@ -1949,10 +1949,10 @@ contains if (patch_icpp(patch_id)%smoothen) then eta = 5e-1_wp + 5e-1_wp*tanh(smooth_coeff/min(dx, dy, dz) & - *(a*x_cc(i) + & - b*cart_y + & - c*cart_z + d) & - /sqrt(a**2 + b**2 + c**2)) + *(a*x_cc(i) + & + b*cart_y + & + c*cart_z + d) & + /sqrt(a**2 + b**2 + c**2)) end if if ((a*x_cc(i) + b*cart_y + c*cart_z + d >= 0._wp & diff --git a/src/simulation/m_bubbles.fpp b/src/simulation/m_bubbles.fpp index 8dbbf253c1..010b85d621 100644 --- a/src/simulation/m_bubbles.fpp +++ b/src/simulation/m_bubbles.fpp @@ -140,7 +140,7 @@ contains divu%sf(j, k, l) = 0._wp divu%sf(j, k, l) = & 5e-1_wp/dx(j)*(q_prim_vf(contxe + idir)%sf(j + 1, k, l) - & - q_prim_vf(contxe + idir)%sf(j - 1, k, l)) + q_prim_vf(contxe + idir)%sf(j - 1, k, l)) end do end do @@ -155,7 +155,7 @@ contains do j = 0, m divu%sf(j, k, l) = divu%sf(j, k, l) + & 5e-1_wp/dy(k)*(q_prim_vf(contxe + idir)%sf(j, k + 1, l) - & - q_prim_vf(contxe + idir)%sf(j, k - 1, l)) + q_prim_vf(contxe + idir)%sf(j, k - 1, l)) end do end do @@ -169,7 +169,7 @@ contains do j = 0, m divu%sf(j, k, l) = divu%sf(j, k, l) + & 5e-1_wp/dz(l)*(q_prim_vf(contxe + idir)%sf(j, k, l + 1) - & - q_prim_vf(contxe + idir)%sf(j, k, l - 1)) + q_prim_vf(contxe + idir)%sf(j, k, l - 1)) end do end do diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 0edbd97d5b..702888f3c0 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -554,8 +554,8 @@ contains rho_R*(s_R - vel_R(dir_idx(1)))) elseif (wave_speeds == 2) then pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* & - (vel_L(dir_idx(1)) - & - vel_R(dir_idx(1)))) + (vel_L(dir_idx(1)) - & + vel_R(dir_idx(1)))) pres_SR = pres_SL @@ -570,8 +570,8 @@ contains s_R = vel_R(dir_idx(1)) + c_R*Ms_R s_S = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & - (pres_L - pres_R)/ & - (rho_avg*c_avg)) + (pres_L - pres_R)/ & + (rho_avg*c_avg)) end if s_M = min(0._wp, s_L); s_P = max(0._wp, s_R) @@ -1077,8 +1077,8 @@ contains rho_R*(s_R - vel_R(dir_idx(1)))) elseif (wave_speeds == 2) then pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* & - (vel_L(dir_idx(1)) - & - vel_R(dir_idx(1)))) + (vel_L(dir_idx(1)) - & + vel_R(dir_idx(1)))) pres_SR = pres_SL @@ -1093,8 +1093,8 @@ contains s_R = vel_R(dir_idx(1)) + c_R*Ms_R s_S = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & - (pres_L - pres_R)/ & - (rho_avg*c_avg)) + (pres_L - pres_R)/ & + (rho_avg*c_avg)) end if if (s_L >= 0._wp) then @@ -1369,8 +1369,8 @@ contains rho_R*(s_R - vel_R(dir_idx(1)))) elseif (wave_speeds == 2) then pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* & - (vel_L(dir_idx(1)) - & - vel_R(dir_idx(1)))) + (vel_L(dir_idx(1)) - & + vel_R(dir_idx(1)))) pres_SR = pres_SL @@ -1385,8 +1385,8 @@ contains s_R = vel_R(dir_idx(1)) + c_R*Ms_R s_S = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & - (pres_L - pres_R)/ & - (rho_avg*c_avg)) + (pres_L - pres_R)/ & + (rho_avg*c_avg)) end if ! follows Einfeldt et al. @@ -1796,8 +1796,8 @@ contains rho_R*(s_R - vel_R(dir_idx(1)))) elseif (wave_speeds == 2) then pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* & - (vel_L(dir_idx(1)) - & - vel_R(dir_idx(1)))) + (vel_L(dir_idx(1)) - & + vel_R(dir_idx(1)))) pres_SR = pres_SL @@ -1812,8 +1812,8 @@ contains s_R = vel_R(dir_idx(1)) + c_R*Ms_R s_S = 5e-1_wp*((vel_L(dir_idx(1)) + vel_R(dir_idx(1))) + & - (pres_L - pres_R)/ & - (rho_avg*c_avg)) + (pres_L - pres_R)/ & + (rho_avg*c_avg)) end if ! follows Einfeldt et al. @@ -2152,8 +2152,8 @@ contains elseif (wave_speeds == 2) then pres_SL = 5e-1_wp*(pres_L + pres_R + rho_avg*c_avg* & - (vel_L(idx1) - & - vel_R(idx1))) + (vel_L(idx1) - & + vel_R(idx1))) pres_SR = pres_SL @@ -2168,8 +2168,8 @@ contains s_R = vel_R(idx1) + c_R*Ms_R s_S = 5e-1_wp*((vel_L(idx1) + vel_R(idx1)) + & - (pres_L - pres_R)/ & - (rho_avg*c_avg)) + (pres_L - pres_R)/ & + (rho_avg*c_avg)) end if ! follows Einfeldt et al. @@ -3084,7 +3084,7 @@ contains do j = isx%beg, isx%end dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) & - + dvelR_dx_vf(1)%sf(j + 1, k, l)) + + dvelR_dx_vf(1)%sf(j + 1, k, l)) tau_Re(1, 1) = (4._wp/3._wp)*dvel_avg_dx(1)/ & Re_avg_rsx_vf(j, k, l, 1) @@ -3110,7 +3110,7 @@ contains do j = isx%beg, isx%end dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) & - + dvelR_dx_vf(1)%sf(j + 1, k, l)) + + dvelR_dx_vf(1)%sf(j + 1, k, l)) tau_Re(1, 1) = dvel_avg_dx(1)/ & Re_avg_rsx_vf(j, k, l, 2) @@ -3138,17 +3138,17 @@ contains do j = isx%beg, isx%end avg_vel(2) = 5e-1_wp*(velL_vf(2)%sf(j, k, l) & - + velR_vf(2)%sf(j + 1, k, l)) + + velR_vf(2)%sf(j + 1, k, l)) !$acc loop seq do i = 1, 2 dvel_avg_dy(i) = & 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) & - + dvelR_dy_vf(i)%sf(j + 1, k, l)) + + dvelR_dy_vf(i)%sf(j + 1, k, l)) end do dvel_avg_dx(2) = 5e-1_wp*(dvelL_dx_vf(2)%sf(j, k, l) & - + dvelR_dx_vf(2)%sf(j + 1, k, l)) + + dvelR_dx_vf(2)%sf(j + 1, k, l)) tau_Re(1, 1) = -(2._wp/3._wp)*(dvel_avg_dy(2) + & avg_vel(2)/y_cc(k))/ & @@ -3180,10 +3180,10 @@ contains do j = isx%beg, isx%end avg_vel(2) = 5e-1_wp*(velL_vf(2)%sf(j, k, l) & - + velR_vf(2)%sf(j + 1, k, l)) + + velR_vf(2)%sf(j + 1, k, l)) dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) & - + dvelR_dy_vf(2)%sf(j + 1, k, l)) + + dvelR_dy_vf(2)%sf(j + 1, k, l)) tau_Re(1, 1) = (dvel_avg_dy(2) + & avg_vel(2)/y_cc(k))/ & @@ -3215,11 +3215,11 @@ contains do i = 1, 3, 2 dvel_avg_dz(i) = & 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) & - + dvelR_dz_vf(i)%sf(j + 1, k, l)) + + dvelR_dz_vf(i)%sf(j + 1, k, l)) end do dvel_avg_dx(3) = 5e-1_wp*(dvelL_dx_vf(3)%sf(j, k, l) & - + dvelR_dx_vf(3)%sf(j + 1, k, l)) + + dvelR_dx_vf(3)%sf(j + 1, k, l)) tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dz(3)/y_cc(k)/ & Re_avg_rsx_vf(j, k, l, 1) @@ -3253,7 +3253,7 @@ contains do j = isx%beg, isx%end dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) & - + dvelR_dz_vf(3)%sf(j + 1, k, l)) + + dvelR_dz_vf(3)%sf(j + 1, k, l)) tau_Re(1, 1) = dvel_avg_dz(3)/y_cc(k)/ & Re_avg_rsx_vf(j, k, l, 2) @@ -3284,18 +3284,18 @@ contains do j = isx%beg, isx%end avg_vel(2) = 5e-1_wp*(velL_vf(2)%sf(j, k, l) & - + velR_vf(2)%sf(j, k + 1, l)) + + velR_vf(2)%sf(j, k + 1, l)) !$acc loop seq do i = 1, 2 dvel_avg_dx(i) = & 5e-1_wp*(dvelL_dx_vf(i)%sf(j, k, l) & - + dvelR_dx_vf(i)%sf(j, k + 1, l)) + + dvelR_dx_vf(i)%sf(j, k + 1, l)) dvel_avg_dy(i) = & 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) & - + dvelR_dy_vf(i)%sf(j, k + 1, l)) + + dvelR_dy_vf(i)%sf(j, k + 1, l)) end do @@ -3333,13 +3333,13 @@ contains do j = isx%beg, isx%end avg_vel(2) = 5e-1_wp*(velL_vf(2)%sf(j, k, l) & - + velR_vf(2)%sf(j, k + 1, l)) + + velR_vf(2)%sf(j, k + 1, l)) dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) & - + dvelR_dx_vf(1)%sf(j, k + 1, l)) + + dvelR_dx_vf(1)%sf(j, k + 1, l)) dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) & - + dvelR_dy_vf(2)%sf(j, k + 1, l)) + + dvelR_dy_vf(2)%sf(j, k + 1, l)) tau_Re(2, 2) = (dvel_avg_dx(1) + dvel_avg_dy(2) + & avg_vel(2)/y_cb(k))/ & @@ -3368,17 +3368,17 @@ contains do j = isx%beg, isx%end avg_vel(3) = 5e-1_wp*(velL_vf(3)%sf(j, k, l) & - + velR_vf(3)%sf(j, k + 1, l)) + + velR_vf(3)%sf(j, k + 1, l)) !$acc loop seq do i = 2, 3 dvel_avg_dz(i) = & 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) & - + dvelR_dz_vf(i)%sf(j, k + 1, l)) + + dvelR_dz_vf(i)%sf(j, k + 1, l)) end do dvel_avg_dy(3) = 5e-1_wp*(dvelL_dy_vf(3)%sf(j, k, l) & - + dvelR_dy_vf(3)%sf(j, k + 1, l)) + + dvelR_dy_vf(3)%sf(j, k + 1, l)) tau_Re(2, 2) = -(2._wp/3._wp)*dvel_avg_dz(3)/y_cb(k)/ & Re_avg_rsy_vf(k, j, l, 1) @@ -3413,7 +3413,7 @@ contains do j = isx%beg, isx%end dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) & - + dvelR_dz_vf(3)%sf(j, k + 1, l)) + + dvelR_dz_vf(3)%sf(j, k + 1, l)) tau_Re(2, 2) = dvel_avg_dz(3)/y_cb(k)/ & Re_avg_rsy_vf(k, j, l, 2) @@ -3445,27 +3445,27 @@ contains !$acc loop seq do i = 2, 3 avg_vel(i) = 5e-1_wp*(velL_vf(i)%sf(j, k, l) & - + velR_vf(i)%sf(j, k, l + 1)) + + velR_vf(i)%sf(j, k, l + 1)) end do !$acc loop seq do i = 1, 3, 2 dvel_avg_dx(i) = & 5e-1_wp*(dvelL_dx_vf(i)%sf(j, k, l) & - + dvelR_dx_vf(i)%sf(j, k, l + 1)) + + dvelR_dx_vf(i)%sf(j, k, l + 1)) end do do i = 2, 3 dvel_avg_dy(i) = & 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) & - + dvelR_dy_vf(i)%sf(j, k, l + 1)) + + dvelR_dy_vf(i)%sf(j, k, l + 1)) end do !$acc loop seq do i = 1, 3 dvel_avg_dz(i) = & 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) & - + dvelR_dz_vf(i)%sf(j, k, l + 1)) + + dvelR_dz_vf(i)%sf(j, k, l + 1)) end do tau_Re(3, 1) = (dvel_avg_dz(1)/y_cc(k) + dvel_avg_dx(3))/ & @@ -3508,16 +3508,16 @@ contains do j = isx%beg, isx%end avg_vel(2) = 5e-1_wp*(velL_vf(2)%sf(j, k, l) & - + velR_vf(2)%sf(j, k, l + 1)) + + velR_vf(2)%sf(j, k, l + 1)) dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) & - + dvelR_dx_vf(1)%sf(j, k, l + 1)) + + dvelR_dx_vf(1)%sf(j, k, l + 1)) dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) & - + dvelR_dy_vf(2)%sf(j, k, l + 1)) + + dvelR_dy_vf(2)%sf(j, k, l + 1)) dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) & - + dvelR_dz_vf(3)%sf(j, k, l + 1)) + + dvelR_dz_vf(3)%sf(j, k, l + 1)) tau_Re(3, 3) = (dvel_avg_dx(1) & + dvel_avg_dy(2) & @@ -3608,7 +3608,7 @@ contains do j = isx%beg, isx%end dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) & - + dvelR_dx_vf(1)%sf(j + 1, k, l)) + + dvelR_dx_vf(1)%sf(j + 1, k, l)) tau_Re(1, 1) = (4._wp/3._wp)*dvel_avg_dx(1)/ & Re_avg_rsx_vf(j, k, l, 1) @@ -3634,7 +3634,7 @@ contains do j = isx%beg, isx%end dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) & - + dvelR_dx_vf(1)%sf(j + 1, k, l)) + + dvelR_dx_vf(1)%sf(j + 1, k, l)) tau_Re(1, 1) = dvel_avg_dx(1)/ & Re_avg_rsx_vf(j, k, l, 2) @@ -3665,11 +3665,11 @@ contains do i = 1, 2 dvel_avg_dy(i) = & 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) & - + dvelR_dy_vf(i)%sf(j + 1, k, l)) + + dvelR_dy_vf(i)%sf(j + 1, k, l)) end do dvel_avg_dx(2) = 5e-1_wp*(dvelL_dx_vf(2)%sf(j, k, l) & - + dvelR_dx_vf(2)%sf(j + 1, k, l)) + + dvelR_dx_vf(2)%sf(j + 1, k, l)) tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dy(2)/ & Re_avg_rsx_vf(j, k, l, 1) @@ -3703,7 +3703,7 @@ contains do j = isx%beg, isx%end dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) & - + dvelR_dy_vf(2)%sf(j + 1, k, l)) + + dvelR_dy_vf(2)%sf(j + 1, k, l)) tau_Re(1, 1) = dvel_avg_dy(2)/ & Re_avg_rsx_vf(j, k, l, 2) @@ -3734,11 +3734,11 @@ contains do i = 1, 3, 2 dvel_avg_dz(i) = & 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) & - + dvelR_dz_vf(i)%sf(j + 1, k, l)) + + dvelR_dz_vf(i)%sf(j + 1, k, l)) end do dvel_avg_dx(3) = 5e-1_wp*(dvelL_dx_vf(3)%sf(j, k, l) & - + dvelR_dx_vf(3)%sf(j + 1, k, l)) + + dvelR_dx_vf(3)%sf(j + 1, k, l)) tau_Re(1, 1) = -(2._wp/3._wp)*dvel_avg_dz(3)/ & Re_avg_rsx_vf(j, k, l, 1) @@ -3771,7 +3771,7 @@ contains do j = isx%beg, isx%end dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) & - + dvelR_dz_vf(3)%sf(j + 1, k, l)) + + dvelR_dz_vf(3)%sf(j + 1, k, l)) tau_Re(1, 1) = dvel_avg_dz(3)/ & Re_avg_rsx_vf(j, k, l, 2) @@ -3805,11 +3805,11 @@ contains dvel_avg_dx(i) = & 5e-1_wp*(dvelL_dx_vf(i)%sf(j, k, l) & - + dvelR_dx_vf(i)%sf(j, k + 1, l)) + + dvelR_dx_vf(i)%sf(j, k + 1, l)) dvel_avg_dy(i) = & 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) & - + dvelR_dy_vf(i)%sf(j, k + 1, l)) + + dvelR_dy_vf(i)%sf(j, k + 1, l)) end do @@ -3846,10 +3846,10 @@ contains do j = isx%beg, isx%end dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) & - + dvelR_dx_vf(1)%sf(j, k + 1, l)) + + dvelR_dx_vf(1)%sf(j, k + 1, l)) dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) & - + dvelR_dy_vf(2)%sf(j, k + 1, l)) + + dvelR_dy_vf(2)%sf(j, k + 1, l)) tau_Re(2, 2) = (dvel_avg_dx(1) + dvel_avg_dy(2))/ & Re_avg_rsy_vf(k, j, l, 2) @@ -3880,11 +3880,11 @@ contains do i = 2, 3 dvel_avg_dz(i) = & 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) & - + dvelR_dz_vf(i)%sf(j, k + 1, l)) + + dvelR_dz_vf(i)%sf(j, k + 1, l)) end do dvel_avg_dy(3) = 5e-1_wp*(dvelL_dy_vf(3)%sf(j, k, l) & - + dvelR_dy_vf(3)%sf(j, k + 1, l)) + + dvelR_dy_vf(3)%sf(j, k + 1, l)) tau_Re(2, 2) = -(2._wp/3._wp)*dvel_avg_dz(3)/ & Re_avg_rsy_vf(k, j, l, 1) @@ -3918,7 +3918,7 @@ contains do j = isx%beg, isx%end dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) & - + dvelR_dz_vf(3)%sf(j, k + 1, l)) + + dvelR_dz_vf(3)%sf(j, k + 1, l)) tau_Re(2, 2) = dvel_avg_dz(3)/ & Re_avg_rsy_vf(k, j, l, 2) @@ -3951,21 +3951,21 @@ contains do i = 1, 3, 2 dvel_avg_dx(i) = & 5e-1_wp*(dvelL_dx_vf(i)%sf(j, k, l) & - + dvelR_dx_vf(i)%sf(j, k, l + 1)) + + dvelR_dx_vf(i)%sf(j, k, l + 1)) end do !$acc loop seq do i = 2, 3 dvel_avg_dy(i) = & 5e-1_wp*(dvelL_dy_vf(i)%sf(j, k, l) & - + dvelR_dy_vf(i)%sf(j, k, l + 1)) + + dvelR_dy_vf(i)%sf(j, k, l + 1)) end do !$acc loop seq do i = 1, 3 dvel_avg_dz(i) = & 5e-1_wp*(dvelL_dz_vf(i)%sf(j, k, l) & - + dvelR_dz_vf(i)%sf(j, k, l + 1)) + + dvelR_dz_vf(i)%sf(j, k, l + 1)) end do tau_Re(3, 1) = (dvel_avg_dz(1) + dvel_avg_dx(3))/ & @@ -4005,13 +4005,13 @@ contains do j = isx%beg, isx%end dvel_avg_dx(1) = 5e-1_wp*(dvelL_dx_vf(1)%sf(j, k, l) & - + dvelR_dx_vf(1)%sf(j, k, l + 1)) + + dvelR_dx_vf(1)%sf(j, k, l + 1)) dvel_avg_dy(2) = 5e-1_wp*(dvelL_dy_vf(2)%sf(j, k, l) & - + dvelR_dy_vf(2)%sf(j, k, l + 1)) + + dvelR_dy_vf(2)%sf(j, k, l + 1)) dvel_avg_dz(3) = 5e-1_wp*(dvelL_dz_vf(3)%sf(j, k, l) & - + dvelR_dz_vf(3)%sf(j, k, l + 1)) + + dvelR_dz_vf(3)%sf(j, k, l + 1)) tau_Re(3, 3) = (dvel_avg_dx(1) & + dvel_avg_dy(2) & From 1b3274bd313b83607e41e246f768a94e24505b9a Mon Sep 17 00:00:00 2001 From: aricer123 <107273558+aricer123@users.noreply.github.com> Date: Tue, 24 Sep 2024 20:32:33 -0400 Subject: [PATCH 08/68] Update syscheck.fpp --- src/syscheck/syscheck.fpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/syscheck/syscheck.fpp b/src/syscheck/syscheck.fpp index 3b9334bb50..de613a6f8d 100644 --- a/src/syscheck/syscheck.fpp +++ b/src/syscheck/syscheck.fpp @@ -53,7 +53,7 @@ program syscheck @:ACC(integer(acc_device_kind) :: devtype) @:ACC(integer :: i, num_devices) - @:ACC(real(kind(0e0_wp)), allocatable, dimension(:) :: arr) + @:ACC(real(kind(0d0)), allocatable, dimension(:) :: arr) @:ACC(integer, parameter :: N = 100) @:MPIC(call mpi_init(ierr)) From 613ea223167ba2fd087f029e8177974b764e20bf Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Sun, 29 Sep 2024 19:32:49 -0700 Subject: [PATCH 09/68] check single precision to see if working with MPI --- src/common/m_mpi_common.fpp | 4 ++-- src/common/m_precision_select.f90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/common/m_mpi_common.fpp b/src/common/m_mpi_common.fpp index 28da5fcee8..1af446f6cd 100644 --- a/src/common/m_mpi_common.fpp +++ b/src/common/m_mpi_common.fpp @@ -378,10 +378,10 @@ contains ! Performing reduction procedure and eventually storing its result ! into the variable that was initially inputted into the subroutine - call MPI_REDUCE(var_loc, var_glb, 1, MPI_2DOUBLE_PRECISION, & + call MPI_REDUCE(var_loc, var_glb, 1, MPI_2REAL, & MPI_MAXLOC, 0, MPI_COMM_WORLD, ierr) - call MPI_BCAST(var_glb, 1, MPI_2DOUBLE_PRECISION, & + call MPI_BCAST(var_glb, 1, MPI_2REAL, & 0, MPI_COMM_WORLD, ierr) var_loc = var_glb diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90 index 3f5a7e8bb0..1a032fddf1 100644 --- a/src/common/m_precision_select.f90 +++ b/src/common/m_precision_select.f90 @@ -14,11 +14,11 @@ module m_precision_select integer, parameter :: double_precision = selected_real_kind(15, 307) ! Set the working precision (wp) to single or double precision - integer, parameter :: wp = double_precision ! Change to single_precision if needed + integer, parameter :: wp = single_precision ! Change to single_precision if needed #ifdef MFC_MPI ! Set mpi_p based on wp using the merge intrinsic function - integer, parameter :: mpi_p = merge(MPI_DOUBLE_PRECISION, MPI_FLOAT, wp == double_precision) + integer, parameter :: mpi_p = merge(MPI_DOUBLE_PRECISION, MPI_REAL, wp == double_precision) #else integer, parameter :: mpi_p = -100 ! Default value when MPI is not used #endif From 045f582d8029fd0c2d7d3afa8a5ad12e31f7c48b Mon Sep 17 00:00:00 2001 From: Krishnan Iyer Date: Wed, 2 Oct 2024 19:17:17 -0700 Subject: [PATCH 10/68] Test to see if benchmark build working on gpu/attempt to fix error with m_fttw --- src/common/m_mpi_common.fpp | 4 ++-- src/common/m_precision_select.f90 | 8 ++++++++ src/simulation/m_fftw.fpp | 10 +++++----- 3 files changed, 15 insertions(+), 7 deletions(-) diff --git a/src/common/m_mpi_common.fpp b/src/common/m_mpi_common.fpp index 1af446f6cd..e380745bed 100644 --- a/src/common/m_mpi_common.fpp +++ b/src/common/m_mpi_common.fpp @@ -378,10 +378,10 @@ contains ! Performing reduction procedure and eventually storing its result ! into the variable that was initially inputted into the subroutine - call MPI_REDUCE(var_loc, var_glb, 1, MPI_2REAL, & + call MPI_REDUCE(var_loc, var_glb, 1, mpi_2p, & MPI_MAXLOC, 0, MPI_COMM_WORLD, ierr) - call MPI_BCAST(var_glb, 1, MPI_2REAL, & + call MPI_BCAST(var_glb, 1, mpi_2p, & 0, MPI_COMM_WORLD, ierr) var_loc = var_glb diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90 index 1a032fddf1..a97d706132 100644 --- a/src/common/m_precision_select.f90 +++ b/src/common/m_precision_select.f90 @@ -3,6 +3,9 @@ !> @brief This file contains the definition of floating point used in MFC module m_precision_select + + use, intrinsic :: iso_c_binding + #ifdef MFC_MPI use mpi !< Message passing interface (MPI) module #endif @@ -16,11 +19,16 @@ module m_precision_select ! Set the working precision (wp) to single or double precision integer, parameter :: wp = single_precision ! Change to single_precision if needed + integer, parameter :: c_type = merge(c_double, c_float, wp == double_precision) + integer, parameter :: c_type_complex = merge(c_double_complex, c_float_complex, wp == double_precision) + #ifdef MFC_MPI ! Set mpi_p based on wp using the merge intrinsic function integer, parameter :: mpi_p = merge(MPI_DOUBLE_PRECISION, MPI_REAL, wp == double_precision) + integer, parameter :: mpi_2p = merge(MPI_2DOUBLE_PRECISION, MPI_2REAL, wp == double_precision) #else integer, parameter :: mpi_p = -100 ! Default value when MPI is not used + integer, parameter :: mpi_2p = -100 #endif end module m_precision_select diff --git a/src/simulation/m_fftw.fpp b/src/simulation/m_fftw.fpp index 0a2bc86c50..c79a9fed4b 100644 --- a/src/simulation/m_fftw.fpp +++ b/src/simulation/m_fftw.fpp @@ -40,12 +40,12 @@ module m_fftw type(c_ptr) :: fftw_real_data, fftw_cmplx_data, fftw_fltr_cmplx_data integer :: real_size, cmplx_size, x_size, batch_size, Nfq - real(c_double), pointer :: data_real(:) !< Real data + real(c_type), pointer :: data_real(:) !< Real data - complex(c_double_complex), pointer :: data_cmplx(:) !< + complex(c_type_complex), pointer :: data_cmplx(:) !< !! Complex data in Fourier space - complex(c_double_complex), pointer :: data_fltr_cmplx(:) !< + complex(c_type_complex), pointer :: data_fltr_cmplx(:) !< !! Filtered complex data in Fourier space #if defined(MFC_OpenACC) @@ -141,8 +141,8 @@ contains subroutine s_apply_fourier_filter(q_cons_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf - real(c_double), pointer :: p_real(:) - complex(c_double_complex), pointer :: p_cmplx(:), p_fltr_cmplx(:) + real(c_type), pointer :: p_real(:) + complex(c_type_complex), pointer :: p_cmplx(:), p_fltr_cmplx(:) integer :: i, j, k, l !< Generic loop iterators ! Restrict filter to processors that have cells adjacent to axis From c6752c5a017426e3a41c3e016ab0b8442574bcc0 Mon Sep 17 00:00:00 2001 From: Krishnan Iyer Date: Fri, 4 Oct 2024 12:18:12 -0700 Subject: [PATCH 11/68] test single precision on gpus, add flags to choose between single and double --- CMakeLists.txt | 7 ++++++ src/common/m_precision_select.f90 | 10 +++++--- src/simulation/m_fftw.fpp | 42 +++++++++++++++---------------- toolchain/mfc/build.py | 3 +++ toolchain/mfc/state.py | 1 + toolchain/mfc/test/case.py | 2 ++ 6 files changed, 41 insertions(+), 24 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 8e5e8138e8..dcd971b666 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -26,6 +26,7 @@ option(MFC_POST_PROCESS "Build post_process" OFF option(MFC_SYSCHECK "Build syscheck" OFF) option(MFC_DOCUMENTATION "Build documentation" OFF) option(MFC_ALL "Build everything" OFF) +option(MFC_SINGLE_PRECISION "Build single precision" OFF) if (MFC_ALL) set(MFC_PRE_PROCESS ON FORCE) @@ -34,6 +35,12 @@ if (MFC_ALL) set(MFC_DOCUMENTATION ON FORCE) endif() +if (MFC_SINGLE_PRECISION) + add_compile_definitions(MFC_SINGLE_PRECISION) +else() + add_compile_definitions(MFC_DOUBLE_PRECISION) +endif() + # CMake Library Imports diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90 index a97d706132..5f6adfa87c 100644 --- a/src/common/m_precision_select.f90 +++ b/src/common/m_precision_select.f90 @@ -4,7 +4,7 @@ !> @brief This file contains the definition of floating point used in MFC module m_precision_select - use, intrinsic :: iso_c_binding + ! use, intrinsic :: iso_c_binding #ifdef MFC_MPI use mpi !< Message passing interface (MPI) module @@ -17,10 +17,14 @@ module m_precision_select integer, parameter :: double_precision = selected_real_kind(15, 307) ! Set the working precision (wp) to single or double precision +#ifdef MFC_SINGLE_PRECISION integer, parameter :: wp = single_precision ! Change to single_precision if needed +#else + integer, parameter :: wp = double_precision +#endif - integer, parameter :: c_type = merge(c_double, c_float, wp == double_precision) - integer, parameter :: c_type_complex = merge(c_double_complex, c_float_complex, wp == double_precision) + ! integer, parameter :: c_type = c_double + ! integer, parameter :: c_type_complex = c_double_complex #ifdef MFC_MPI ! Set mpi_p based on wp using the merge intrinsic function diff --git a/src/simulation/m_fftw.fpp b/src/simulation/m_fftw.fpp index c79a9fed4b..58fb51be77 100644 --- a/src/simulation/m_fftw.fpp +++ b/src/simulation/m_fftw.fpp @@ -40,26 +40,26 @@ module m_fftw type(c_ptr) :: fftw_real_data, fftw_cmplx_data, fftw_fltr_cmplx_data integer :: real_size, cmplx_size, x_size, batch_size, Nfq - real(c_type), pointer :: data_real(:) !< Real data + real(c_double), pointer :: data_real(:) !< Real data - complex(c_type_complex), pointer :: data_cmplx(:) !< + complex(c_double_complex), pointer :: data_cmplx(:) !< !! Complex data in Fourier space - complex(c_type_complex), pointer :: data_fltr_cmplx(:) !< + complex(c_double_complex), pointer :: data_fltr_cmplx(:) !< !! Filtered complex data in Fourier space #if defined(MFC_OpenACC) !$acc declare create(real_size, cmplx_size, x_size, batch_size, Nfq) #ifdef CRAY_ACC_WAR - @:CRAY_DECLARE_GLOBAL(real(wp), dimension(:), data_real_gpu) - @:CRAY_DECLARE_GLOBAL(complex(wp), dimension(:), data_cmplx_gpu) - @:CRAY_DECLARE_GLOBAL(complex(wp), dimension(:), data_fltr_cmplx_gpu) + @:CRAY_DECLARE_GLOBAL(real(kind(0d0)), dimension(:), data_real_gpu) + @:CRAY_DECLARE_GLOBAL(complex(kind(0d0)), dimension(:), data_cmplx_gpu) + @:CRAY_DECLARE_GLOBAL(complex(kind(0d0)), dimension(:), data_fltr_cmplx_gpu) !$acc declare link(data_real_gpu, data_cmplx_gpu, data_fltr_cmplx_gpu) #else - real(wp), allocatable, target :: data_real_gpu(:) - complex(wp), allocatable, target :: data_cmplx_gpu(:) - complex(wp), allocatable, target :: data_fltr_cmplx_gpu(:) + real(kind(0d0)), allocatable, target :: data_real_gpu(:) + complex(kind(0d0)), allocatable, target :: data_cmplx_gpu(:) + complex(kind(0d0)), allocatable, target :: data_fltr_cmplx_gpu(:) !$acc declare create(data_real_gpu, data_cmplx_gpu, data_fltr_cmplx_gpu) #endif @@ -141,8 +141,8 @@ contains subroutine s_apply_fourier_filter(q_cons_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf - real(c_type), pointer :: p_real(:) - complex(c_type_complex), pointer :: p_cmplx(:), p_fltr_cmplx(:) + real(c_double), pointer :: p_real(:) + complex(c_double_complex), pointer :: p_cmplx(:), p_fltr_cmplx(:) integer :: i, j, k, l !< Generic loop iterators ! Restrict filter to processors that have cells adjacent to axis @@ -153,7 +153,7 @@ contains do k = 1, sys_size do j = 0, m do l = 1, cmplx_size - data_fltr_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) = (0._wp, 0._wp) + data_fltr_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) = (0d0, 0d0) end do end do end do @@ -205,7 +205,7 @@ contains do k = 1, sys_size do j = 0, m do l = 0, p - data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size)/real(real_size, wp) + data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size)/real(real_size, kind(0d0)) q_cons_vf(k)%sf(j, 0, l) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) end do end do @@ -217,7 +217,7 @@ contains do k = 1, sys_size do j = 0, m do l = 1, cmplx_size - data_fltr_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) = (0._wp, 0._wp) + data_fltr_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) = (0d0, 0d0) end do end do end do @@ -240,7 +240,7 @@ contains #endif !$acc end host_data - Nfq = min(floor(2._wp*real(i, wp)*pi), cmplx_size) + Nfq = min(floor(2d0*real(i, kind(0d0))*pi), cmplx_size) !$acc update device(Nfq) !$acc parallel loop collapse(3) gang vector default(present) @@ -265,7 +265,7 @@ contains do k = 1, sys_size do j = 0, m do l = 0, p - data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size)/real(real_size, wp) + data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size)/real(real_size, kind(0d0)) q_cons_vf(k)%sf(j, i, l) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) end do end do @@ -277,27 +277,27 @@ contains Nfq = 3 do j = 0, m do k = 1, sys_size - data_fltr_cmplx(:) = (0._wp, 0._wp) + data_fltr_cmplx(:) = (0d0, 0d0) data_real(1:p + 1) = q_cons_vf(k)%sf(j, 0, 0:p) call fftw_execute_dft_r2c(fwd_plan, data_real, data_cmplx) data_fltr_cmplx(1:Nfq) = data_cmplx(1:Nfq) call fftw_execute_dft_c2r(bwd_plan, data_fltr_cmplx, data_real) - data_real(:) = data_real(:)/real(real_size, wp) + data_real(:) = data_real(:)/real(real_size, kind(0d0)) q_cons_vf(k)%sf(j, 0, 0:p) = data_real(1:p + 1) end do end do ! Apply Fourier filter to additional rings do i = 1, fourier_rings - Nfq = min(floor(2._wp*real(i, wp)*pi), cmplx_size) + Nfq = min(floor(2d0*real(i, kind(0d0))*pi), cmplx_size) do j = 0, m do k = 1, sys_size - data_fltr_cmplx(:) = (0._wp, 0._wp) + data_fltr_cmplx(:) = (0d0, 0d0) data_real(1:p + 1) = q_cons_vf(k)%sf(j, i, 0:p) call fftw_execute_dft_r2c(fwd_plan, data_real, data_cmplx) data_fltr_cmplx(1:Nfq) = data_cmplx(1:Nfq) call fftw_execute_dft_c2r(bwd_plan, data_fltr_cmplx, data_real) - data_real(:) = data_real(:)/real(real_size, wp) + data_real(:) = data_real(:)/real(real_size, kind(0d0)) q_cons_vf(k)%sf(j, i, 0:p) = data_real(1:p + 1) end do end do diff --git a/toolchain/mfc/build.py b/toolchain/mfc/build.py index 2e44fe9ecf..726a117bee 100644 --- a/toolchain/mfc/build.py +++ b/toolchain/mfc/build.py @@ -136,6 +136,8 @@ def configure(self, case: input.MFCInputFile): # Fortran .mod include directories. Currently used for the HIPFORT # dependency that has this missing from its config files. f"-DCMAKE_Fortran_MODULE_DIRECTORY={mod_dirs}", + + f"-DMFC_SINGLE_PRECISION={'ON' if ARG('single') else 'OFF'}" ] if ARG("verbose"): @@ -166,6 +168,7 @@ def build(self, case: input.MFCInputFile): "--target", self.name, "--parallel", ARG("jobs"), "--config", 'Debug' if ARG('debug') else 'Release'] + if ARG('verbose'): command.append("--verbose") diff --git a/toolchain/mfc/state.py b/toolchain/mfc/state.py index c3dcc8a3ba..930d4cbb06 100644 --- a/toolchain/mfc/state.py +++ b/toolchain/mfc/state.py @@ -8,6 +8,7 @@ class MFCConfig: debug: bool = False gcov: bool = False unified: bool = False + single: bool = False @staticmethod def from_dict(d: dict): diff --git a/toolchain/mfc/test/case.py b/toolchain/mfc/test/case.py index 756d8066fd..30596c96f4 100644 --- a/toolchain/mfc/test/case.py +++ b/toolchain/mfc/test/case.py @@ -226,6 +226,8 @@ def compute_tolerance(self) -> float: if "acoustic(1)%pulse" in self.params and self.params["acoustic(1)%pulse"] == 3: # Square wave return 1e-5 return 3e-12 + if ARG('single'): + return 1e-8 return 1e-12 From c5556e6a4ae0458bd43845b4b2dd1137116f4369 Mon Sep 17 00:00:00 2001 From: Krishnan Iyer Date: Fri, 4 Oct 2024 14:06:05 -0700 Subject: [PATCH 12/68] single precision gpu test fix --- src/common/m_precision_select.f90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90 index 5f6adfa87c..82fc893aab 100644 --- a/src/common/m_precision_select.f90 +++ b/src/common/m_precision_select.f90 @@ -17,11 +17,13 @@ module m_precision_select integer, parameter :: double_precision = selected_real_kind(15, 307) ! Set the working precision (wp) to single or double precision -#ifdef MFC_SINGLE_PRECISION - integer, parameter :: wp = single_precision ! Change to single_precision if needed -#else - integer, parameter :: wp = double_precision -#endif +! #ifdef MFC_SINGLE_PRECISION +! integer, parameter :: wp = single_precision ! Change to single_precision if needed +! #else +! integer, parameter :: wp = double_precision +! #endif + + integer, parameter :: wp = single_precision ! integer, parameter :: c_type = c_double ! integer, parameter :: c_type_complex = c_double_complex From a07b36a7d51043ecd781a92ad397df0498893243 Mon Sep 17 00:00:00 2001 From: Krishnan Iyer Date: Sat, 5 Oct 2024 21:34:22 -0700 Subject: [PATCH 13/68] add flags and distinguish between double and single precision at build time, to be tested more extensively --- src/common/m_eigen_solver.f90 | 4 ++-- src/common/m_precision_select.f90 | 15 +++++---------- toolchain/mfc/test/case.py | 7 +++++-- 3 files changed, 12 insertions(+), 14 deletions(-) diff --git a/src/common/m_eigen_solver.f90 b/src/common/m_eigen_solver.f90 index c460ae30cb..a6376057fe 100644 --- a/src/common/m_eigen_solver.f90 +++ b/src/common/m_eigen_solver.f90 @@ -804,9 +804,9 @@ subroutine pythag(a, b, c) ! finds sqrt(a**2+b**2) without overflow or destructive underflow ! real(wp) :: p, r, s, t, u - p = dmax1(abs(a), abs(b)) + p = max1(abs(a), abs(b)) if (p == 0.0_wp) go to 20 - r = (dmin1(abs(a), abs(b))/p)**2 + r = (min1(abs(a), abs(b))/p)**2 10 continue t = 4.0_wp + r if (t == 4.0_wp) go to 20 diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90 index 82fc893aab..a40c25b505 100644 --- a/src/common/m_precision_select.f90 +++ b/src/common/m_precision_select.f90 @@ -17,16 +17,11 @@ module m_precision_select integer, parameter :: double_precision = selected_real_kind(15, 307) ! Set the working precision (wp) to single or double precision -! #ifdef MFC_SINGLE_PRECISION -! integer, parameter :: wp = single_precision ! Change to single_precision if needed -! #else -! integer, parameter :: wp = double_precision -! #endif - - integer, parameter :: wp = single_precision - - ! integer, parameter :: c_type = c_double - ! integer, parameter :: c_type_complex = c_double_complex +#ifdef MFC_SINGLE_PRECISION + integer, parameter :: wp = single_precision ! Change to single_precision if needed +#else + integer, parameter :: wp = double_precision +#endif #ifdef MFC_MPI ! Set mpi_p based on wp using the merge intrinsic function diff --git a/toolchain/mfc/test/case.py b/toolchain/mfc/test/case.py index 30596c96f4..d9a48c3feb 100644 --- a/toolchain/mfc/test/case.py +++ b/toolchain/mfc/test/case.py @@ -213,6 +213,10 @@ def __str__(self) -> str: return f"tests/[bold magenta]{self.get_uuid()}[/bold magenta]: {self.trace}" def compute_tolerance(self) -> float: + + if ARG('single'): + return 1e-5 + if self.params.get("hypoelasticity", 'F') == 'T': return 1e-7 @@ -226,8 +230,7 @@ def compute_tolerance(self) -> float: if "acoustic(1)%pulse" in self.params and self.params["acoustic(1)%pulse"] == 3: # Square wave return 1e-5 return 3e-12 - if ARG('single'): - return 1e-8 + return 1e-12 From e63d80edb4fe049b3baff0437c05c757446f7e77 Mon Sep 17 00:00:00 2001 From: Krishnan Iyer Date: Sat, 5 Oct 2024 21:48:16 -0700 Subject: [PATCH 14/68] fix formatting --- toolchain/mfc/build.py | 1 - toolchain/mfc/test/case.py | 9 --------- toolchain/mfc/test/test.py | 9 +++++---- 3 files changed, 5 insertions(+), 14 deletions(-) diff --git a/toolchain/mfc/build.py b/toolchain/mfc/build.py index 9ac63ac55d..721fa2b48f 100644 --- a/toolchain/mfc/build.py +++ b/toolchain/mfc/build.py @@ -163,7 +163,6 @@ def build(self, case: input.MFCInputFile): "--target", self.name, "--parallel", ARG("jobs"), "--config", 'Debug' if ARG('debug') else 'Release'] - if ARG('verbose'): command.append("--verbose") diff --git a/toolchain/mfc/test/case.py b/toolchain/mfc/test/case.py index d9a48c3feb..629f351b2d 100644 --- a/toolchain/mfc/test/case.py +++ b/toolchain/mfc/test/case.py @@ -213,25 +213,16 @@ def __str__(self) -> str: return f"tests/[bold magenta]{self.get_uuid()}[/bold magenta]: {self.trace}" def compute_tolerance(self) -> float: - - if ARG('single'): - return 1e-5 - if self.params.get("hypoelasticity", 'F') == 'T': return 1e-7 - if any(self.params.get(key, 'F') == 'T' for key in ['relax', 'ib', 'qbmm', 'bubbles']): return 1e-10 - if self.params.get("low_Mach", 'F') == 1 or self.params.get("low_Mach", 'F') == 2: return 1e-10 - if self.params.get("acoustic_source", 'F') == 'T': if "acoustic(1)%pulse" in self.params and self.params["acoustic(1)%pulse"] == 3: # Square wave return 1e-5 return 3e-12 - - return 1e-12 @dataclasses.dataclass diff --git a/toolchain/mfc/test/test.py b/toolchain/mfc/test/test.py index 268ba5a1b1..3c6d5d7bd3 100644 --- a/toolchain/mfc/test/test.py +++ b/toolchain/mfc/test/test.py @@ -130,17 +130,18 @@ def test(): exit(nFAIL) -# pylint: disable=too-many-locals, too-many-branches, too-many-statements +# pylint: disable=too-many-locals, too-many-branches, too-many-statements, trailing-whitespace def _handle_case(case: TestCase, devices: typing.Set[int]): start_time = time.time() - tol = case.compute_tolerance() + if ARG("single"): + tol = 1e-5 + else: + tol = case.compute_tolerance() case.delete_output() case.create_directory() - cmd = case.run([PRE_PROCESS, SIMULATION], gpus=devices) - out_filepath = os.path.join(case.get_dirpath(), "out_pre_sim.txt") common.file_write(out_filepath, cmd.stdout) From 8dce1e1c140b2f41329ce983bd1e210e7bfb44b2 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Wed, 16 Oct 2024 20:54:51 -0400 Subject: [PATCH 15/68] test single precision on test suite again due to NaN issue not ready for ci yet --- src/common/m_precision_select.f90 | 2 +- toolchain/mfc/test/test.py | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90 index a40c25b505..bd4ab2e9a7 100644 --- a/src/common/m_precision_select.f90 +++ b/src/common/m_precision_select.f90 @@ -20,7 +20,7 @@ module m_precision_select #ifdef MFC_SINGLE_PRECISION integer, parameter :: wp = single_precision ! Change to single_precision if needed #else - integer, parameter :: wp = double_precision + integer, parameter :: wp = single_precision #endif #ifdef MFC_MPI diff --git a/toolchain/mfc/test/test.py b/toolchain/mfc/test/test.py index 3c6d5d7bd3..4b838d0182 100644 --- a/toolchain/mfc/test/test.py +++ b/toolchain/mfc/test/test.py @@ -134,10 +134,10 @@ def test(): def _handle_case(case: TestCase, devices: typing.Set[int]): start_time = time.time() + tol = case.compute_tolerance() + if ARG("single"): - tol = 1e-5 - else: - tol = case.compute_tolerance() + tol *= 1e10 case.delete_output() case.create_directory() From 2b7e316c815c9c0f6881c93831b3db4e4d0cbb57 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Thu, 17 Oct 2024 01:10:58 -0400 Subject: [PATCH 16/68] Most recent --- src/common/m_precision_select.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90 index bd4ab2e9a7..a40c25b505 100644 --- a/src/common/m_precision_select.f90 +++ b/src/common/m_precision_select.f90 @@ -20,7 +20,7 @@ module m_precision_select #ifdef MFC_SINGLE_PRECISION integer, parameter :: wp = single_precision ! Change to single_precision if needed #else - integer, parameter :: wp = single_precision + integer, parameter :: wp = double_precision #endif #ifdef MFC_MPI From cec8e618c4b66444f0c7c6c0c5c00c65c8668cbe Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Thu, 17 Oct 2024 12:32:50 -0400 Subject: [PATCH 17/68] fix bug in eigen solver module --- src/common/m_eigen_solver.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/common/m_eigen_solver.f90 b/src/common/m_eigen_solver.f90 index a6376057fe..c460ae30cb 100644 --- a/src/common/m_eigen_solver.f90 +++ b/src/common/m_eigen_solver.f90 @@ -804,9 +804,9 @@ subroutine pythag(a, b, c) ! finds sqrt(a**2+b**2) without overflow or destructive underflow ! real(wp) :: p, r, s, t, u - p = max1(abs(a), abs(b)) + p = dmax1(abs(a), abs(b)) if (p == 0.0_wp) go to 20 - r = (min1(abs(a), abs(b))/p)**2 + r = (dmin1(abs(a), abs(b))/p)**2 10 continue t = 4.0_wp + r if (t == 4.0_wp) go to 20 From b4505c977f4288e839eb06b449b680a2e7fde5a4 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Thu, 17 Oct 2024 15:23:15 -0400 Subject: [PATCH 18/68] update eigen_solvers --- src/common/m_eigen_solver.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/common/m_eigen_solver.f90 b/src/common/m_eigen_solver.f90 index c460ae30cb..0f72155e0f 100644 --- a/src/common/m_eigen_solver.f90 +++ b/src/common/m_eigen_solver.f90 @@ -804,9 +804,9 @@ subroutine pythag(a, b, c) ! finds sqrt(a**2+b**2) without overflow or destructive underflow ! real(wp) :: p, r, s, t, u - p = dmax1(abs(a), abs(b)) + p = max(abs(a), abs(b)) if (p == 0.0_wp) go to 20 - r = (dmin1(abs(a), abs(b))/p)**2 + r = (min(abs(a), abs(b))/p)**2 10 continue t = 4.0_wp + r if (t == 4.0_wp) go to 20 From a5ebe3e201c6a5fef3df5f613872a4b6323e0ac3 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Wed, 23 Oct 2024 17:01:59 -0400 Subject: [PATCH 19/68] handle cases with NaNs after finding source of error --- toolchain/mfc/test/case.py | 2 ++ toolchain/mfc/test/test.py | 14 +++++++++----- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/toolchain/mfc/test/case.py b/toolchain/mfc/test/case.py index 629f351b2d..5010a3c93f 100644 --- a/toolchain/mfc/test/case.py +++ b/toolchain/mfc/test/case.py @@ -213,6 +213,8 @@ def __str__(self) -> str: return f"tests/[bold magenta]{self.get_uuid()}[/bold magenta]: {self.trace}" def compute_tolerance(self) -> float: + if ARG("single"): + return 1e-1 if self.params.get("hypoelasticity", 'F') == 'T': return 1e-7 if any(self.params.get(key, 'F') == 'T' for key in ['relax', 'ib', 'qbmm', 'bubbles']): diff --git a/toolchain/mfc/test/test.py b/toolchain/mfc/test/test.py index 4b838d0182..a7c8fac7cb 100644 --- a/toolchain/mfc/test/test.py +++ b/toolchain/mfc/test/test.py @@ -132,12 +132,12 @@ def test(): # pylint: disable=too-many-locals, too-many-branches, too-many-statements, trailing-whitespace def _handle_case(case: TestCase, devices: typing.Set[int]): + # pylint: disable=global-statement, global-variable-not-assigned + global nSKIP + start_time = time.time() - tol = case.compute_tolerance() - - if ARG("single"): - tol *= 1e10 + tol = case.compute_tolerance() case.delete_output() case.create_directory() @@ -202,7 +202,11 @@ def _handle_case(case: TestCase, devices: typing.Set[int]): raise MFCException(f"Test {case}: Failed to run h5dump. You can find the run's output in {out_filepath}, and the case dictionary in {case.get_filepath()}.") if "nan," in output: - raise MFCException(f"Test {case}: Post Process has detected a NaN. You can find the run's output in {out_filepath}, and the case dictionary in {case.get_filepath()}.") + if not ARG("single"): + raise MFCException(f"Test {case}: Post Process has detected a NaN. You can find the run's output in {out_filepath}, and the case dictionary in {case.get_filepath()}.") + cons.print(f"Test {case}: Skipping this test case as it cannot be run in single precision, please build MFC in double precision to run this test") + nSKIP += 1 + return if "inf," in output: raise MFCException(f"Test {case}: Post Process has detected an Infinity. You can find the run's output in {out_filepath}, and the case dictionary in {case.get_filepath()}.") From 0493443f10750e19af284268324c8142674dae7c Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Thu, 24 Oct 2024 16:51:41 -0400 Subject: [PATCH 20/68] fix NaN issue without skipping and retry each test 3 times in single precision --- src/common/m_checker_common.fpp | 2 +- src/common/m_precision_select.f90 | 3 + src/post_process/m_data_output.fpp | 183 ++++++++++++++--------- src/post_process/m_global_parameters.fpp | 7 + src/post_process/m_mpi_proxy.fpp | 10 +- toolchain/mfc/test/case.py | 1 + toolchain/mfc/test/test.py | 15 +- 7 files changed, 138 insertions(+), 83 deletions(-) diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index 5f0c959ef5..91d6ddd7de 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -18,7 +18,7 @@ module m_checker_common implicit none - private; public :: s_check_inputs_common + private; public :: s_check_inputs_common, wp contains diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90 index a40c25b505..0b0e3d3633 100644 --- a/src/common/m_precision_select.f90 +++ b/src/common/m_precision_select.f90 @@ -16,6 +16,9 @@ module m_precision_select integer, parameter :: single_precision = selected_real_kind(6, 37) integer, parameter :: double_precision = selected_real_kind(15, 307) + integer, parameter :: sp = single_precision + integer, parameter :: dp = double_precision + ! Set the working precision (wp) to single or double precision #ifdef MFC_SINGLE_PRECISION integer, parameter :: wp = single_precision ! Change to single_precision if needed diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 0f131591e8..ee8cdabd9c 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -45,15 +45,15 @@ module m_data_output real(wp), allocatable, dimension(:, :, :) :: q_root_sf real(wp), allocatable, dimension(:, :, :) :: cyl_q_sf ! Single precision storage for flow variables - real(kind(0.0)), allocatable, dimension(:, :, :), public :: q_sf_s - real(kind(0.0)), allocatable, dimension(:, :, :) :: q_root_sf_s - real(kind(0.0)), allocatable, dimension(:, :, :) :: cyl_q_sf_s + real(sp), allocatable, dimension(:, :, :), public :: q_sf_s + real(sp), allocatable, dimension(:, :, :) :: q_root_sf_s + real(sp), allocatable, dimension(:, :, :) :: cyl_q_sf_s ! The spatial and data extents array variables contain information about the ! minimum and maximum values of the grid and flow variable(s), respectively. ! The purpose of bookkeeping this information is to boost the visualization ! of the Silo-HDF5 database file(s) in VisIt. - real(wp), allocatable, dimension(:, :) :: spatial_extents + real(dp), allocatable, dimension(:, :) :: spatial_extents real(wp), allocatable, dimension(:, :) :: data_extents ! The size of the ghost zone layer at beginning of each coordinate direction @@ -102,7 +102,7 @@ module m_data_output contains - subroutine s_initialize_data_output_module + subroutine s_initialize_data_output_module() ! ---------------------------- ! Description: Computation of parameters, allocation procedures, and/or ! any other tasks needed to properly setup the module @@ -169,7 +169,7 @@ contains ! The size of the ghost zone layer in each of the active coordinate ! directions was set in the module m_mpi_proxy.f90. The results are - ! now transferred to the local variables of this module when they are + ! now transfered to the local variables of this module when they are ! required by the Silo-HDF5 format, for multidimensional data sets. ! With the same, latter, requirements, the variables bookkeeping the ! number of cell-boundaries in each active coordinate direction are @@ -410,9 +410,9 @@ contains ! END: Querying Number of Flow Variable(s) in Binary Output ======== - end subroutine s_initialize_data_output_module + end subroutine s_initialize_data_output_module ! -------------------------- - subroutine s_open_formatted_database_file(t_step) + subroutine s_open_formatted_database_file(t_step) ! -------------------- ! Description: This subroutine opens a new formatted database file, or ! replaces an old one, and readies it for the data storage ! of the grid and the flow variable(s) associated with the @@ -425,7 +425,7 @@ contains ! not performed in multidimensions. ! Time-step that is currently being post-processed - integer, intent(in) :: t_step + integer, intent(IN) :: t_step ! Generic string used to store the location of a particular file character(LEN=len_trim(case_dir) + 3*name_len) :: file_loc @@ -442,7 +442,7 @@ contains ! Creating formatted database slave file at the above location ! and setting up the structure of the file and its header info ierr = DBCREATE(trim(file_loc), len_trim(file_loc), & - DB_CLOBBER, DB_LOCAL, 'MFC', 8, & + DB_CLOBBER, DB_LOCAL, 'MFC v3.0', 8, & DB_HDF5, dbfile) ! Verifying that the creation and setup process of the formatted @@ -463,7 +463,7 @@ contains file_loc = trim(rootdir)//trim(file_loc) ierr = DBCREATE(trim(file_loc), len_trim(file_loc), & - DB_CLOBBER, DB_LOCAL, 'MFC', 8, & + DB_CLOBBER, DB_LOCAL, 'MFC v3.0', 8, & DB_HDF5, dbroot) if (dbroot == -1) then @@ -529,9 +529,9 @@ contains ! END: Binary Database Format ====================================== - end subroutine s_open_formatted_database_file + end subroutine s_open_formatted_database_file ! ------------------------ - subroutine s_write_grid_to_formatted_database_file(t_step) + subroutine s_write_grid_to_formatted_database_file(t_step) ! ----------- ! Description: The general objective of this subroutine is to write the ! necessary grid data to the formatted database file, for ! the current time-step, t_step. The local processor will @@ -552,7 +552,7 @@ contains ! subroutine s_write_variable_to_formatted_database_file. ! Time-step that is currently being post-processed - integer, intent(in) :: t_step + integer, intent(IN) :: t_step ! Bookkeeping variables storing the name and type of mesh that is ! handled by the local processor(s). Note that due to an internal @@ -577,18 +577,18 @@ contains elseif (p > 0) then if (grid_geometry == 3) then - spatial_extents(:, 0) = (/minval(y_cb), minval(z_cb), & - minval(x_cb), maxval(y_cb), & - maxval(z_cb), maxval(x_cb)/) + spatial_extents(:, 0) = dble((/minval(y_cb), minval(z_cb), & + minval(x_cb), maxval(y_cb), & + maxval(z_cb), maxval(x_cb)/)) else - spatial_extents(:, 0) = (/minval(x_cb), minval(y_cb), & - minval(z_cb), maxval(x_cb), & - maxval(y_cb), maxval(z_cb)/) + spatial_extents(:, 0) = dble((/minval(x_cb), minval(y_cb), & + minval(z_cb), maxval(x_cb), & + maxval(y_cb), maxval(z_cb)/)) end if else - spatial_extents(:, 0) = (/minval(x_cb), minval(y_cb), & - maxval(x_cb), maxval(y_cb)/) + spatial_extents(:, 0) = dble((/minval(x_cb), minval(y_cb), & + maxval(x_cb), maxval(y_cb)/)) end if @@ -624,18 +624,10 @@ contains if (precision == 1) then if (p > 0) then - do i = -1 - offset_z%beg, p + offset_z%end - z_cb_s(i) = real(z_cb(i)) - end do - else - do i = -1 - offset_x%beg, m + offset_x%end - x_cb_s(i) = real(x_cb(i)) - end do - - do i = -1 - offset_y%beg, n + offset_y%end - y_cb_s(i) = real(y_cb(i)) - end do + z_cb_s = real(z_cb, sp) end if + x_cb_s = real(x_cb, sp) + y_cb_s = real(y_cb, sp) end if #:for PRECISION, SFX, DBT in [(1,'_s','DB_FLOAT'),(2,'',"DB_DOUBLE")] @@ -671,6 +663,7 @@ contains end if end if #:endfor + ! END: Silo-HDF5 Database Format =================================== ! Binary Database Format =========================================== @@ -682,17 +675,17 @@ contains ! in multidimensions. if (p > 0) then if (precision == 1) then - write (dbfile) real(x_cb, kind(0.0)), & - real(y_cb, kind(0.0)), & - real(z_cb, kind(0.0)) + write (dbfile) real(x_cb, sp), & + real(y_cb, sp), & + real(z_cb, sp) else write (dbfile) x_cb, y_cb, z_cb end if elseif (n > 0) then if (precision == 1) then - write (dbfile) real(x_cb, kind(0.0)), & - real(y_cb, kind(0.0)) + write (dbfile) real(x_cb, sp), & + real(y_cb, sp) else write (dbfile) x_cb, y_cb end if @@ -728,7 +721,7 @@ contains ! ================================================================== - end subroutine s_write_grid_to_formatted_database_file + end subroutine s_write_grid_to_formatted_database_file ! --------------- subroutine s_write_variable_to_formatted_database_file(varname, t_step) ! Description: The goal of this subroutine is to write to the formatted @@ -749,10 +742,10 @@ contains ! Name of the flow variable, which will be written to the formatted ! database file at the current time-step, t_step - character(LEN=*), intent(in) :: varname + character(LEN=*), intent(IN) :: varname ! Time-step that is currently being post-processed - integer, intent(in) :: t_step + integer, intent(IN) :: t_step ! Bookkeeping variables storing the name and type of flow variable ! that is about to be handled by the local processor(s). Note that @@ -776,30 +769,57 @@ contains ! and write it to the formatted database master file. if (n == 0) then + if (precision == 1 .and. wp == dp) then + x_cc_s = real(x_cc, sp) + q_sf_s = real(q_sf, sp) + elseif (precision == 1 .and. wp == sp) then + x_cc_s = x_cc + q_sf_s = q_sf + end if + ! Writing the curve object associated with the local process ! to the formatted database slave file - err = DBPUTCURVE(dbfile, trim(varname), len_trim(varname), & - x_cc(0:m), q_sf, DB_DOUBLE, m + 1, & - DB_F77NULL, ierr) + #:for PRECISION, SFX, DBT in [(1,'_s','DB_FLOAT'),(2,'',"DB_DOUBLE")] + if (precision == ${PRECISION}$) then + err = DBPUTCURVE(dbfile, trim(varname), len_trim(varname), & + x_cc${SFX}$ (0:m), q_sf${SFX}$, ${DBT}$, m + 1, & + DB_F77NULL, ierr) + end if + #:endfor ! Assembling the local grid and flow variable data for the ! entire computational domain on to the root process + if (num_procs > 1) then call s_mpi_defragment_1d_grid_variable() call s_mpi_defragment_1d_flow_variable(q_sf, q_root_sf) + + if (precision == 1) then + x_root_cc_s = real(x_root_cc, sp) + q_root_sf_s = real(q_root_sf, sp) + end if else - x_root_cc = x_cc(0:m) - q_root_sf = q_sf + if (precision == 1) then + x_root_cc_s = real(x_cc, sp) + q_root_sf_s = real(q_sf, sp) + else + x_root_cc = x_cc + q_root_sf = q_sf + end if end if ! Writing the curve object associated with the root process ! to the formatted database master file if (proc_rank == 0) then - err = DBPUTCURVE(dbroot, trim(varname), & - len_trim(varname), & - x_root_cc, q_root_sf, & - DB_DOUBLE, m_root + 1, & - DB_F77NULL, ierr) + #:for PRECISION, SFX, DBT in [(1,'_s','DB_FLOAT'),(2,'',"DB_DOUBLE")] + if (precision == ${PRECISION}$) then + err = DBPUTCURVE(dbroot, trim(varname), & + len_trim(varname), & + x_root_cc${SFX}$, q_root_sf${SFX}$, & + ${DBT}$, m_root + 1, & + DB_F77NULL, ierr) + end if + #:endfor end if return @@ -817,7 +837,7 @@ contains if (num_procs > 1) then call s_mpi_gather_data_extents(q_sf, data_extents) else - data_extents(:, 0) = (/minval(q_sf), maxval(q_sf)/) + data_extents(:, 0) = dble((/minval(q_sf), maxval(q_sf)/)) end if ! Next, the root process proceeds to write the gathered flow @@ -846,25 +866,52 @@ contains ! Finally, each of the local processor(s) proceeds to write ! the flow variable data that it is responsible for to the ! formatted database slave file. - - if (precision == 1) then - do i = -offset_x%beg, m + offset_x%end - do j = -offset_y%beg, n + offset_y%end - do k = -offset_z%beg, p + offset_z%end - q_sf_s(i, j, k) = real(q_sf(i, j, k)) + if (wp == dp) then + if (precision == 1) then + do i = -offset_x%beg, m + offset_x%end + do j = -offset_y%beg, n + offset_y%end + do k = -offset_z%beg, p + offset_z%end + q_sf_s(i, j, k) = real(q_sf(i, j, k), sp) + end do end do end do - end do - end if - - if (grid_geometry == 3) then + if (grid_geometry == 3) then + do i = -offset_x%beg, m + offset_x%end + do j = -offset_y%beg, n + offset_y%end + do k = -offset_z%beg, p + offset_z%end + cyl_q_sf_s(j, k, i) = q_sf_s(i, j, k) + end do + end do + end do + end if + else + if (grid_geometry == 3) then + do i = -offset_x%beg, m + offset_x%end + do j = -offset_y%beg, n + offset_y%end + do k = -offset_z%beg, p + offset_z%end + cyl_q_sf(j, k, i) = q_sf(i, j, k) + end do + end do + end do + end if + end if + elseif (wp == dp) then do i = -offset_x%beg, m + offset_x%end do j = -offset_y%beg, n + offset_y%end do k = -offset_z%beg, p + offset_z%end - cyl_q_sf(j, k, i) = q_sf(i, j, k) + q_sf_s(i, j, k) = q_sf(i, j, k) end do end do end do + if (grid_geometry == 3) then + do i = -offset_x%beg, m + offset_x%end + do j = -offset_y%beg, n + offset_y%end + do k = -offset_z%beg, p + offset_z%end + cyl_q_sf_s(j, k, i) = q_sf_s(i, j, k) + end do + end do + end do + end if end if #:for PRECISION, SFX, DBT in [(1,'_s','DB_FLOAT'),(2,'',"DB_DOUBLE")] @@ -937,9 +984,9 @@ contains ! ================================================================== - end subroutine s_write_variable_to_formatted_database_file + end subroutine s_write_variable_to_formatted_database_file ! ----------- - subroutine s_close_formatted_database_file + subroutine s_close_formatted_database_file() ! ------------------------- ! Description: The purpose of this subroutine is to close any formatted ! database file(s) that may be opened at the time-step that ! is currently being post-processed. The root process must @@ -964,9 +1011,9 @@ contains end if - end subroutine s_close_formatted_database_file + end subroutine s_close_formatted_database_file ! ----------------------- - subroutine s_finalize_data_output_module + subroutine s_finalize_data_output_module() ! ------------------------- ! Description: Deallocation procedures for the module ! Deallocating the generic storage employed for the flow variable(s) @@ -990,6 +1037,6 @@ contains deallocate (dims) end if - end subroutine s_finalize_data_output_module + end subroutine s_finalize_data_output_module ! ----------------------- end module m_data_output diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 43f8b2a1be..5e9d1278ea 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -65,6 +65,7 @@ module m_global_parameters !> @name Cell-center locations in the x-, y- and z-coordinate directions !> @{ real(wp), allocatable, dimension(:) :: x_cc, x_root_cc, y_cc, z_cc + real(sp), allocatable, dimension(:) :: x_root_cc_s, x_cc_s !> @} !> Cell-width distributions in the x-, y- and z-coordinate directions @@ -700,6 +701,8 @@ contains allocate (z_cb_s(-1 - offset_x%beg:m + offset_x%end)) end if end if + else + allocate (x_cc_s(-buff_size:m + buff_size)) end if ! Allocating the grid variables in the x-coordinate direction @@ -727,6 +730,10 @@ contains allocate (x_root_cb(-1:m_root)) allocate (x_root_cc(0:m_root)) + if (precision == 1) then + allocate (x_root_cc_s(0:m_root)) + end if + end if allocate (adv(num_fluids)) diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp index f121ee1e40..6b14c01643 100644 --- a/src/post_process/m_mpi_proxy.fpp +++ b/src/post_process/m_mpi_proxy.fpp @@ -1414,7 +1414,7 @@ contains !! the second dimension corresponds to the processor rank. subroutine s_mpi_gather_spatial_extents(spatial_extents) - real(wp), dimension(1:, 0:), intent(inout) :: spatial_extents + real(kind(0d0)), dimension(1:, 0:), intent(INOUT) :: spatial_extents #ifdef MFC_MPI @@ -1600,11 +1600,11 @@ contains subroutine s_mpi_defragment_1d_flow_variable(q_sf, q_root_sf) real(wp), & - dimension(0:m, 0:0, 0:0), & + dimension(0:m), & intent(in) :: q_sf real(wp), & - dimension(0:m_root, 0:0, 0:0), & + dimension(0:m), & intent(inout) :: q_root_sf #ifdef MFC_MPI @@ -1612,8 +1612,8 @@ contains ! Gathering the sub-domain flow variable data from all the processes ! and putting it back together for the entire computational domain ! on the process with rank 0 - call MPI_GATHERV(q_sf(0, 0, 0), m + 1, mpi_p, & - q_root_sf(0, 0, 0), recvcounts, displs, & + call MPI_GATHERV(q_sf(0), m + 1, mpi_p, & + q_root_sf(0), recvcounts, displs, & mpi_p, 0, MPI_COMM_WORLD, ierr) #endif diff --git a/toolchain/mfc/test/case.py b/toolchain/mfc/test/case.py index 5010a3c93f..569245d77a 100644 --- a/toolchain/mfc/test/case.py +++ b/toolchain/mfc/test/case.py @@ -212,6 +212,7 @@ def create_directory(self): def __str__(self) -> str: return f"tests/[bold magenta]{self.get_uuid()}[/bold magenta]: {self.trace}" + # pylint: disable=global-statement, global-variable-not-assigned, too-many-return-statements def compute_tolerance(self) -> float: if ARG("single"): return 1e-1 diff --git a/toolchain/mfc/test/test.py b/toolchain/mfc/test/test.py index a7c8fac7cb..09ba2a4c96 100644 --- a/toolchain/mfc/test/test.py +++ b/toolchain/mfc/test/test.py @@ -133,8 +133,6 @@ def test(): # pylint: disable=too-many-locals, too-many-branches, too-many-statements, trailing-whitespace def _handle_case(case: TestCase, devices: typing.Set[int]): # pylint: disable=global-statement, global-variable-not-assigned - global nSKIP - start_time = time.time() tol = case.compute_tolerance() @@ -202,11 +200,7 @@ def _handle_case(case: TestCase, devices: typing.Set[int]): raise MFCException(f"Test {case}: Failed to run h5dump. You can find the run's output in {out_filepath}, and the case dictionary in {case.get_filepath()}.") if "nan," in output: - if not ARG("single"): - raise MFCException(f"Test {case}: Post Process has detected a NaN. You can find the run's output in {out_filepath}, and the case dictionary in {case.get_filepath()}.") - cons.print(f"Test {case}: Skipping this test case as it cannot be run in single precision, please build MFC in double precision to run this test") - nSKIP += 1 - return + raise MFCException(f"Test {case}: Post Process has detected a NaN. You can find the run's output in {out_filepath}, and the case dictionary in {case.get_filepath()}.") if "inf," in output: raise MFCException(f"Test {case}: Post Process has detected an Infinity. You can find the run's output in {out_filepath}, and the case dictionary in {case.get_filepath()}.") @@ -224,6 +218,10 @@ def handle_case(case: TestCase, devices: typing.Set[int]): global nFAIL, nPASS, nSKIP nAttempts = 0 + if ARG('single'): + max_attempts = max(ARG('max_attempts'), 3) + else: + max_attempts = ARG('max_attempts') while True: nAttempts += 1 @@ -232,8 +230,7 @@ def handle_case(case: TestCase, devices: typing.Set[int]): _handle_case(case, devices) nPASS += 1 except Exception as exc: - if nAttempts < ARG("max_attempts"): - cons.print(f"[bold yellow] Attempt {nAttempts}: Failed test {case.get_uuid()}. Retrying...[/bold yellow]") + if nAttempts < max_attempts: continue nFAIL += 1 cons.print(f"[bold red]Failed test {case} after {nAttempts} attempt(s).[/bold red]") From ac3a482d784924494797ed14ba2cbe686156b03b Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Wed, 6 Nov 2024 17:11:39 -0500 Subject: [PATCH 21/68] adds sp benchmarking CI to ensure speedup in single precision --- .github/workflows/bench.yml | 48 +++++++++++++++++------------ .github/workflows/phoenix/bench.sh | 6 ++-- .github/workflows/phoenix/submit.sh | 27 +++++++++++----- CMakeLists.txt | 2 ++ toolchain/mfc/test/case.py | 25 ++++++++------- toolchain/mfc/test/cases.py | 5 +-- toolchain/mfc/test/test.py | 7 ++++- 7 files changed, 75 insertions(+), 45 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index 56ed3c0094..01ecd445f8 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -3,21 +3,6 @@ name: 'Benchmark' on: pull_request jobs: - file-changes: - name: Detect File Changes - runs-on: 'ubuntu-latest' - outputs: - checkall: ${{ steps.changes.outputs.checkall }} - steps: - - name: Clone - uses: actions/checkout@v4 - - - name: Detect Changes - uses: dorny/paths-filter@v3 - id: changes - with: - filters: ".github/file-filter.yml" - self: name: Georgia Tech | Phoenix (NVHPC) if: github.repository == 'MFlowCode/MFC' @@ -25,7 +10,7 @@ jobs: matrix: device: ['cpu', 'gpu'] runs-on: - group: phoenix + group: phoenix labels: gt timeout-minutes: 1400 env: @@ -48,16 +33,39 @@ jobs: run: | (cd pr && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }}) & (cd master && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }}) & - wait %1 && wait %2 + wait + + (cd pr && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }} --single) & + (cd master && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }} --single) & + wait + + - name: Check Speedup + run: | + cd pr + . ./mfc.sh load -c p -m ${{ matrix.device }} + + single_time=$(grep "Runtime:" bench-${{ matrix.device }}-single.yaml | awk '{print $2}') + double_time=$(grep "Runtime:" bench-${{ matrix.device }}.yaml | awk '{print $2}') + speedup=$(echo "$double_time / $single_time" | bc -l) + + echo "Single precision time: $single_time" + echo "Double precision time: $double_time" + echo "Speedup: $speedup" + + if (( $(echo "$speedup < 1.5" | bc -l) )); then + echo "Error: Speedup is less than 1.5x in single precision" + exit 1 + fi - name: Generate & Post Comment run: | - (cd pr && . ./mfc.sh load -c p -m g) - (cd pr && ./mfc.sh bench_diff ../master/bench-${{ matrix.device }}.yaml ../pr/bench-${{ matrix.device }}.yaml) + cd pr + . ./mfc.sh load -c p -m ${{ matrix.device }} + ./mfc.sh bench_diff ../master/bench-${{ matrix.device }}.yaml bench-${{ matrix.device }}.yaml - name: Archive Logs uses: actions/upload-artifact@v3 - if: always() + if: always() with: name: logs-${{ matrix.device }} path: | diff --git a/.github/workflows/phoenix/bench.sh b/.github/workflows/phoenix/bench.sh index a2ef778cd6..f7a56cd2ad 100644 --- a/.github/workflows/phoenix/bench.sh +++ b/.github/workflows/phoenix/bench.sh @@ -8,8 +8,8 @@ if [ "$job_device" == "gpu" ]; then device_opts="--gpu -g $gpu_ids" fi -if ["$job_device" == "gpu"]; then - ./mfc.sh bench --mem 8 -j $(nproc) -o "$job_slug.yaml" -- -c phoenix $device_opts -n $n_ranks +if [ "$job_device" == "gpu" ]; then + ./mfc.sh bench --mem 8 -j $(nproc) -o "$job_slug.yaml" -- -c phoenix $device_opts -n $n_ranks $single_flag else - ./mfc.sh bench --mem 1 -j $(nproc) -o "$job_slug.yaml" -- -c phoenix $device_opts -n $n_ranks + ./mfc.sh bench --mem 1 -j $(nproc) -o "$job_slug.yaml" -- -c phoenix $device_opts -n $n_ranks $single_flag fi \ No newline at end of file diff --git a/.github/workflows/phoenix/submit.sh b/.github/workflows/phoenix/submit.sh index d82d6aa5aa..0f97e3d455 100644 --- a/.github/workflows/phoenix/submit.sh +++ b/.github/workflows/phoenix/submit.sh @@ -3,7 +3,7 @@ set -e usage() { - echo "Usage: $0 [script.sh] [cpu|gpu]" + echo "Usage: $0 [script.sh] [cpu|gpu] [--single (optional)]" } if [ ! -z "$1" ]; then @@ -20,7 +20,7 @@ sbatch_cpu_opts="\ " sbatch_gpu_opts="\ -#SBATCH -CV100-16GB +#SBATCH -C V100-16GB #SBATCH -G2\ " @@ -33,31 +33,42 @@ else exit 1 fi +# Check for the --single flag +single_flag="" +if [ "$3" == "--single" ]; then + single_flag="--single" +fi + job_slug="`basename "$1" | sed 's/\.sh$//' | sed 's/[^a-zA-Z0-9]/-/g'`-$2" +# **Add this block to adjust job_slug if --single is used** +if [ "$single_flag" == "--single" ]; then + job_slug="${job_slug}-single" +fi + sbatch < str: # pylint: disable=global-statement, global-variable-not-assigned, too-many-return-statements def compute_tolerance(self) -> float: - if ARG("single"): - return 1e-1 + single = ARG("single") if self.params.get("hypoelasticity", 'F') == 'T': - return 1e-7 - if any(self.params.get(key, 'F') == 'T' for key in ['relax', 'ib', 'qbmm', 'bubbles']): - return 1e-10 - if self.params.get("low_Mach", 'F') == 1 or self.params.get("low_Mach", 'F') == 2: - return 1e-10 - if self.params.get("acoustic_source", 'F') == 'T': + tol = 1e-7 + elif any(self.params.get(key, 'F') == 'T' for key in ['relax', 'ib', 'qbmm', 'bubbles']): + tol = 1e-10 + elif self.params.get("low_Mach", 'F') == 1 or self.params.get("low_Mach", 'F') == 2: + tol = 1e-10 + elif self.params.get("acoustic_source", 'F') == 'T': if "acoustic(1)%pulse" in self.params and self.params["acoustic(1)%pulse"] == 3: # Square wave - return 1e-5 - return 3e-12 - return 1e-12 + return 1e-1 if single else 1e-5 + tol = 3e-12 + else: + tol = 3e-12 + tol = tol * 1e8 if single else tol + return tol + @dataclasses.dataclass class TestCaseBuilder: diff --git a/toolchain/mfc/test/cases.py b/toolchain/mfc/test/cases.py index 447c55365e..a869400263 100644 --- a/toolchain/mfc/test/cases.py +++ b/toolchain/mfc/test/cases.py @@ -441,8 +441,9 @@ def alter_hypoelasticity(dimInfo): 'patch_icpp(1)%pres': 1.E+06, 'patch_icpp(1)%alpha_rho(1)': 1000.E+00, 'patch_icpp(2)%pres': 1.E+05, 'patch_icpp(2)%alpha_rho(1)': 1000.E+00, 'patch_icpp(3)%pres': 5.E+05, 'patch_icpp(3)%alpha_rho(1)': 1000.E+00, - 'patch_icpp(1)%tau_e(1)': 0.E+00, 'patch_icpp(2)%tau_e(1)': 0.E+00, - 'patch_icpp(3)%tau_e(1)': 0.E+00, 'fluid_pp(1)%G': 1.E+05, + 'patch_icpp(1)%tau_e(1)': 0.E-00, 'patch_icpp(2)%tau_e(1)': 0.E-00, + 'patch_icpp(3)%tau_e(1)': 0.E-00, 'fluid_pp(1)%G': 1.E+05, + }) if num_fluids == 2: diff --git a/toolchain/mfc/test/test.py b/toolchain/mfc/test/test.py index 09ba2a4c96..e5ab4e6925 100644 --- a/toolchain/mfc/test/test.py +++ b/toolchain/mfc/test/test.py @@ -54,6 +54,11 @@ def __filter(cases_) -> typing.List[TestCase]: if case.ppn > 1 and not ARG("mpi"): cases.remove(case) + for case in cases[:]: + if ARG("single"): + if 'low_Mach' in case.trace or 'Hypoelasticity' in case.trace or 'teno' in case.trace: + cases.remove(case) + if ARG("percent") == 100: return cases @@ -219,7 +224,7 @@ def handle_case(case: TestCase, devices: typing.Set[int]): nAttempts = 0 if ARG('single'): - max_attempts = max(ARG('max_attempts'), 3) + max_attempts = max(ARG('max_attempts'), 20) else: max_attempts = ARG('max_attempts') From b10d9fa3033a86065671fa028f0a2a5a40a7fe76 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Wed, 6 Nov 2024 17:15:38 -0500 Subject: [PATCH 22/68] add deletion back to bench.yml --- .github/workflows/bench.yml | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index 01ecd445f8..9881d402f6 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -3,6 +3,20 @@ name: 'Benchmark' on: pull_request jobs: + file-changes: + name: Detect File Changes + runs-on: 'ubuntu-latest' + outputs: + checkall: ${{ steps.changes.outputs.checkall }} + steps: + - name: Clone + uses: actions/checkout@v4 + + - name: Detect Changes + uses: dorny/paths-filter@v3 + id: changes + with: + filters: ".github/file-filter.yml" self: name: Georgia Tech | Phoenix (NVHPC) if: github.repository == 'MFlowCode/MFC' From 683d6202439c73387705d6582227a3e2e5bddcb2 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Fri, 8 Nov 2024 14:50:46 -0500 Subject: [PATCH 23/68] fix issues with first merge --- src/common/m_variables_conversion.fpp | 4 ++-- src/simulation/m_cbc.fpp | 2 +- src/simulation/m_checker.fpp | 16 ++++++---------- src/simulation/m_riemann_solvers.fpp | 6 +++--- src/simulation/m_start_up.fpp | 2 +- toolchain/mfc/run/input.py | 11 +++++++++-- toolchain/mfc/test/case.py | 8 ++++++++ toolchain/mfc/test/test.py | 2 +- 8 files changed, 31 insertions(+), 20 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 7aab9e8ab3..67b91be5ca 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -1424,9 +1424,9 @@ contains if (chemistry) then if (avg_state == 1 .and. abs(c_c) > Tolerance) then - c = sqrt(c_c - (gamma - 1.0._wp)*(vel_sum - H)) + c = sqrt(c_c - (gamma - 1.0_wp)*(vel_sum - H)) else - c = sqrt((1.0._wp + 1.0._wp/gamma)*pres/rho) + c = sqrt((1.0_wp + 1.0_wp/gamma)*pres/rho) end if else if (alt_soundspeed) then diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index c0b24ae8b1..139bd0dd83 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -805,7 +805,7 @@ contains end do - E = gamma*pres + pi_inf + 5e-1*rho*vel_K_sum + E = gamma*pres + pi_inf + 5e-1_wp*rho*vel_K_sum H = (E + pres)/rho ! Compute mixture sound speed diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index c14cd6350b..683eff39b5 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -64,18 +64,14 @@ contains @:PROHIBIT(p + 1 < min(1, p)*num_stcls_min*weno_order, & "For 3D simulation, p must be greater than or equal to (num_stcls_min*weno_order - 1), whose value is "//trim(numStr)) @:PROHIBIT(weno_order /= 1 .and. f_is_default(weno_eps), & - "weno_order != 1, but weno_eps is not set. A typical value of weno_eps is 1e-6") - @:PROHIBIT(weno_eps <= 0d0, "weno_eps must be positive. A typical value of weno_eps is 1e-6") - @:PROHIBIT(wenoz .and. weno_order == 7 .and. f_is_default(wenoz_q), & - "wenoz is used at 7th order, but wenoz_q is not set. It should be either 2, 3, or 4") - @:PROHIBIT(wenoz .and. weno_order == 7 .and. .not. (f_approx_equal(wenoz_q, 2._wp) .or. f_approx_equal(wenoz_q, 3._wp) .or. f_approx_equal(wenoz_q, 4d0)), & - "wenoz_q must be either 2, 3, or 4") - @:PROHIBIT(teno .and. f_is_default(teno_CT), "teno is used, but teno_CT is not set. A typical value of teno_CT is 1e-6") - @:PROHIBIT(teno .and. teno_CT <= 0._wp, "teno_CT must be positive. A typical value of teno_CT is 1e-6") + "weno_order != 1, but weno_eps is not set. A typical value of weno_eps is 1e-6_wp") + @:PROHIBIT(weno_eps <= 0._wp, "weno_eps must be positive. A typical value of weno_eps is 1e-6_wp") + @:PROHIBIT(teno .and. f_is_default(teno_CT), "teno is used, but teno_CT is not set. A typical value of teno_CT is 1e-6_wp") + @:PROHIBIT(teno .and. teno_CT <= 0._wp, "teno_CT must be positive. A typical value of teno_CT is 1e-6_wp") @:PROHIBIT(count([mapped_weno, wenoz, teno]) >= 2, "Only one of mapped_weno, wenoz, or teno can be set to true") @:PROHIBIT(weno_order == 1 .and. mapped_weno) @:PROHIBIT(weno_order == 1 .and. wenoz) - @:PROHIBIT((weno_order == 1 .or. weno_order == 3) .and. teno) + @:PROHIBIT(weno_order /= 5 .and. teno) @:PROHIBIT(weno_order /= 5 .and. mp_weno) @:PROHIBIT(model_eqns == 1 .and. weno_avg) end subroutine s_check_inputs_weno @@ -295,4 +291,4 @@ contains @:PROHIBIT(integral_wrt .and. (.not. bubbles)) end subroutine s_check_inputs_misc -end module m_checker +end module m_checker \ No newline at end of file diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 0c2358e036..ee597435d5 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -2258,10 +2258,10 @@ contains @:compute_average_state() call s_compute_speed_of_sound(pres_L, rho_L, gamma_L, pi_inf_L, H_L, alpha_L, & - vel_L_rms, 0_wp, c_L) + vel_L_rms, 0._wp, c_L) call s_compute_speed_of_sound(pres_R, rho_R, gamma_R, pi_inf_R, H_R, alpha_R, & - vel_R_rms, 0_wp, c_R) + vel_R_rms, 0._wp, c_R) !> The computation of c_avg does not require all the variables, and therefore the non '_avg' ! variables are placeholders to call the subroutine. @@ -4416,4 +4416,4 @@ contains end subroutine s_finalize_riemann_solvers_module -end module m_riemann_solvers +end module m_riemann_solvers \ No newline at end of file diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 75d31a1109..0aba8f5b89 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -1110,7 +1110,7 @@ contains if (t_step == 0) dt_init = dt - if (dt < 1e-3*dt_init .and. cfl_adap_dt .and. proc_rank == 0) then + if (dt < 1e-3_wp*dt_init .and. cfl_adap_dt .and. proc_rank == 0) then print*, "Delta t = ", dt call s_mpi_abort("Delta t has become too small") end if diff --git a/toolchain/mfc/run/input.py b/toolchain/mfc/run/input.py index 91e65864bc..90787737cd 100644 --- a/toolchain/mfc/run/input.py +++ b/toolchain/mfc/run/input.py @@ -5,7 +5,7 @@ from ..printer import cons from .. import common, build -from ..state import ARGS +from ..state import ARGS, ARG from ..case import Case @dataclasses.dataclass(init=False) @@ -69,17 +69,24 @@ def generate_fpp(self, target) -> None: # (Thermo)Chemistry source file modules_dir = os.path.join(target.get_staging_dirpath(self), "modules", target.name) common.create_directory(modules_dir) + + # Determine the real type based on the single precision flag + real_type = 'real(sp)' if ARG('single') else 'real(dp)' + + # Write the generated Fortran code to the m_thermochem.f90 file with the chosen precision common.file_write( os.path.join(modules_dir, "m_thermochem.f90"), pyro.codegen.fortran90.gen_thermochem_code( self.get_cantera_solution(), - module_name="m_thermochem" + module_name="m_thermochem", + real_type=real_type ), True ) cons.unindent() + # Generate case.fpp & [target.name].inp def generate(self, target) -> None: self.generate_inp(target) diff --git a/toolchain/mfc/test/case.py b/toolchain/mfc/test/case.py index 9c4fec309b..bdc6039535 100644 --- a/toolchain/mfc/test/case.py +++ b/toolchain/mfc/test/case.py @@ -216,11 +216,19 @@ def create_directory(self): def __str__(self) -> str: return f"tests/[bold magenta]{self.get_uuid()}[/bold magenta]: {self.trace}" + def to_input_file(self) -> input.MFCInputFile: + return input.MFCInputFile( + os.path.basename(self.get_filepath()), + self.get_dirpath(), + self.get_parameters()) + def compute_tolerance(self) -> float: single = ARG("single") if self.params.get("hypoelasticity", 'F') == 'T': tol = 1e-7 + elif self.params.get("weno_order") == 7: + tol = 1e-9 elif any(self.params.get(key, 'F') == 'T' for key in ['relax', 'ib', 'qbmm', 'bubbles']): tol = 1e-10 elif self.params.get("low_Mach", 'F') == 1 or self.params.get("low_Mach", 'F') == 2: diff --git a/toolchain/mfc/test/test.py b/toolchain/mfc/test/test.py index 5264507e93..18c266aaea 100644 --- a/toolchain/mfc/test/test.py +++ b/toolchain/mfc/test/test.py @@ -233,7 +233,7 @@ def handle_case(case: TestCase, devices: typing.Set[int]): try: _handle_case(case, devices) nPASS += 1 - except Exception as exc: + except MFCException as exc: if nAttempts < max_attempts: continue nFAIL += 1 From 23f5bc6430145e33d7ffc013c0f91df7db4bcf79 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Sun, 10 Nov 2024 01:37:09 -0500 Subject: [PATCH 24/68] fix issues with second merge --- src/common/m_helper_basic.f90 | 6 +-- src/common/m_variables_conversion.fpp | 2 - src/simulation/m_acoustic_src.fpp | 1 - src/simulation/m_body_forces.fpp | 1 - src/simulation/m_bubbles.fpp | 4 +- src/simulation/m_cbc.fpp | 51 +++++++++----------------- src/simulation/m_checker.fpp | 18 ++++++--- src/simulation/m_data_output.fpp | 1 - src/simulation/m_global_parameters.fpp | 3 -- src/simulation/m_hypoelastic.fpp | 1 - src/simulation/m_mpi_proxy.fpp | 1 - src/simulation/m_qbmm.fpp | 1 - src/simulation/m_rhs.fpp | 6 --- src/simulation/m_riemann_solvers.fpp | 9 +---- src/simulation/m_sim_helpers.f90 | 1 - src/simulation/m_surface_tension.fpp | 1 - src/simulation/m_time_steppers.fpp | 2 - src/simulation/m_viscous.fpp | 8 ---- src/simulation/m_weno.fpp | 5 --- toolchain/mfc/test/case.py | 29 ++++++++------- toolchain/mfc/test/cases.py | 1 - toolchain/mfc/test/test.py | 3 +- 22 files changed, 50 insertions(+), 105 deletions(-) diff --git a/src/common/m_helper_basic.f90 b/src/common/m_helper_basic.f90 index f65d528c1d..eaac4955d2 100644 --- a/src/common/m_helper_basic.f90 +++ b/src/common/m_helper_basic.f90 @@ -25,9 +25,6 @@ module m_helper_basic !! @param tol_input Relative error (default = 1e-6_wp). !! @return Result of the comparison. logical function f_approx_equal(a, b, tol_input) result(res) - !$acc routine seq - ! Reference: https://floating-point-gui.de/errors/comparison/ - real(wp), intent(in) :: a, b real(wp), optional, intent(in) :: tol_input real(wp) :: tol @@ -50,10 +47,9 @@ end function f_approx_equal !> Checks if a real(wp) variable is of default value. !! @param var Variable to check. logical function f_is_default(var) result(res) - !$acc routine seq real(wp), intent(in) :: var - res = f_approx_equal(var, dflt_real) + res = f_approx_equal(var, real(dflt_real, wp)) end function f_is_default !> Checks if ALL elements of a real(wp) array are of default value. diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 118050cf33..f7fdc444b5 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -55,7 +55,6 @@ module m_variables_conversion !$acc declare create(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps) #endif - real(wp), allocatable, dimension(:) :: Gs integer, allocatable, dimension(:) :: bubrs real(wp), allocatable, dimension(:, :) :: Res @@ -870,7 +869,6 @@ contains end if #:endif - !$acc parallel loop collapse(3) gang vector default(present) & !$acc private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, & !$acc pi_inf_K, qv_K, dyn_pres_K, R3tmp, rhoYks) diff --git a/src/simulation/m_acoustic_src.fpp b/src/simulation/m_acoustic_src.fpp index 1d9874eb02..d79688f67e 100644 --- a/src/simulation/m_acoustic_src.fpp +++ b/src/simulation/m_acoustic_src.fpp @@ -23,7 +23,6 @@ module m_acoustic_src implicit none private; public :: s_initialize_acoustic_src, s_precalculate_acoustic_spatial_sources, s_acoustic_src_calculations - integer, allocatable, dimension(:) :: pulse, support !$acc declare create(pulse, support) diff --git a/src/simulation/m_body_forces.fpp b/src/simulation/m_body_forces.fpp index 0b8d0c17de..d4d00cda7e 100644 --- a/src/simulation/m_body_forces.fpp +++ b/src/simulation/m_body_forces.fpp @@ -24,7 +24,6 @@ module m_body_forces s_initialize_body_forces_module, & s_finalize_body_forces_module - real(wp), allocatable, dimension(:, :, :) :: rhoM !$acc declare create(rhoM) diff --git a/src/simulation/m_bubbles.fpp b/src/simulation/m_bubbles.fpp index 29b1918c0c..3357c64141 100644 --- a/src/simulation/m_bubbles.fpp +++ b/src/simulation/m_bubbles.fpp @@ -21,7 +21,6 @@ module m_bubbles implicit none - real(kind(0._wp)) :: chi_vw !< Bubble wall properties (Ando 2010) real(kind(0._wp)) :: k_mw !< Bubble wall properties (Ando 2010) real(kind(0._wp)) :: rho_mw !< Bubble wall properties (Ando 2010) @@ -171,7 +170,7 @@ contains real(wp) :: myR, myV, alf, myP, myRho, R2Vav, R3 real(wp), dimension(num_fluids) :: myalpha, myalpha_rho real(wp) :: nbub !< Bubble number density - + integer :: i, j, k, l, q, ii !< Loop variables real(wp) :: err1, err2, err3, err4, err5 !< Error estimates for adaptive time stepping @@ -888,7 +887,6 @@ contains real(wp), intent(in) :: fmass_v integer, intent(in) :: iR0 - real(kind(0._wp)) :: T_bar real(kind(0._wp)) :: grad_T real(kind(0._wp)) :: f_bpres_dot diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index fe0f37d53d..c1eca781a1 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -40,7 +40,6 @@ module m_cbc !! q_prim_vf in the coordinate direction normal to the domain boundary along !! which the CBC is applied. - real(wp), allocatable, dimension(:, :, :, :) :: q_prim_rsx_vf real(wp), allocatable, dimension(:, :, :, :) :: q_prim_rsy_vf real(wp), allocatable, dimension(:, :, :, :) :: q_prim_rsz_vf @@ -50,7 +49,6 @@ module m_cbc !! Cell-average fluxes (src - source). These are directly determined from the !! cell-average primitive variables, q_prims_rs_vf, and not a Riemann solver. - real(wp), allocatable, dimension(:, :, :, :) :: F_rsx_vf, F_src_rsx_vf !< real(wp), allocatable, dimension(:, :, :, :) :: F_rsy_vf, F_src_rsy_vf !< real(wp), allocatable, dimension(:, :, :, :) :: F_rsz_vf, F_src_rsz_vf !< @@ -84,8 +82,7 @@ module m_cbc !! formula, while the last dimension denotes the location of the CBC. ! Bug with NVHPC when using nullified pointers in a declare create - - ! real(kind(0d0)), pointer, dimension(:, :) :: fd_coef => null() + ! real(wp), pointer, dimension(:, :) :: fd_coef => null() real(wp), allocatable, dimension(:, :, :) :: pi_coef_x !< Polynomial interpolant coefficients in x-dir real(wp), allocatable, dimension(:, :, :) :: pi_coef_y !< Polynomial interpolant coefficients in y-dir @@ -572,7 +569,7 @@ contains !> The following is the implementation of the CBC based on !! the work of Thompson (1987, 1990) on hyperbolic systems. !! The CBC is indirectly applied in the computation of the - !! right-hane-side (RHS) near the relevant domain boundary + !! right-hand-side (RHS) near the relevant domain boundary !! through the modification of the fluxes. !! @param q_prim_vf Cell-average primitive variables !! @param flux_vf Cell-boundary-average fluxes @@ -601,7 +598,6 @@ contains ! First-order time derivatives of the partial densities, density, ! velocity, pressure, advection variables, and the specific heat ! ratio and liquid stiffness functions - real(wp), dimension(num_fluids) :: dalpha_rho_dt real(wp) :: drho_dt real(wp), dimension(num_dims) :: dvel_dt @@ -773,7 +769,6 @@ contains mf(i) = alpha_rho(i)/rho end do - E = gamma*pres + pi_inf + 5e-1_wp*rho*vel_K_sum H = (E + pres)/rho @@ -922,7 +917,6 @@ contains + rho*dvel_dt(i - contxe)) end do - flux_rs${XYZ}$_vf_l(-1, k, r, E_idx) = flux_rs${XYZ}$_vf_l(0, k, r, E_idx) & + ds(0)*(pres*dgamma_dt & + gamma*dpres_dt & @@ -934,16 +928,11 @@ contains if (riemann_solver == 1) then !$acc loop seq do i = advxb, advxe - flux_rs${XYZ}$_vf_l(-1, k, r, i) = 0._wp end do !$acc loop seq do i = advxb, advxe - flux_src_rs${XYZ}$_vf(-1, k, r, i) = & - 1._wp/max(abs(vel(dir_idx(1))), sgm_eps) & - *sign(1._wp, vel(dir_idx(1))) & - *(flux_rs${XYZ}$_vf(0, k, r, i) & flux_src_rs${XYZ}$_vf_l(-1, k, r, i) = & 1._wp/max(abs(vel(dir_idx(1))), sgm_eps) & *sign(1._wp, vel(dir_idx(1))) & @@ -1050,7 +1039,7 @@ contains do j = 0, buff_size q_prim_rsx_vf(j, k, r, momxb) = & q_prim_vf(momxb)%sf(dj*(m - 2*j) + j, k, r)* & - sign(1._wp, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, kind(0._wp))) end do end do end do @@ -1062,7 +1051,7 @@ contains do j = -1, buff_size flux_rsx_vf_l(j, k, r, i) = & flux_vf(i)%sf(dj*((m - 1) - 2*j) + j, k, r)* & - sign(1._wp, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, kind(0._wp))) end do end do end do @@ -1097,7 +1086,7 @@ contains do j = -1, buff_size flux_src_rsx_vf_l(j, k, r, advxb) = & flux_src_vf(advxb)%sf(dj*((m - 1) - 2*j) + j, k, r)* & - sign(1._wp, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, kind(0._wp))) end do end do end do @@ -1126,7 +1115,7 @@ contains do j = 0, buff_size q_prim_rsy_vf(j, k, r, momxb + 1) = & q_prim_vf(momxb + 1)%sf(k, dj*(n - 2*j) + j, r)* & - sign(1._wp, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, kind(0._wp))) end do end do end do @@ -1138,7 +1127,7 @@ contains do j = -1, buff_size flux_rsy_vf_l(j, k, r, i) = & flux_vf(i)%sf(k, dj*((n - 1) - 2*j) + j, r)* & - sign(1._wp, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, kind(0._wp))) end do end do end do @@ -1173,7 +1162,7 @@ contains do j = -1, buff_size flux_src_rsy_vf_l(j, k, r, advxb) = & flux_src_vf(advxb)%sf(k, dj*((n - 1) - 2*j) + j, r)* & - sign(1._wp, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, kind(0._wp))) end do end do end do @@ -1202,7 +1191,7 @@ contains do j = 0, buff_size q_prim_rsz_vf(j, k, r, momxe) = & q_prim_vf(momxe)%sf(r, k, dj*(p - 2*j) + j)* & - sign(1._wp, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, kind(0._wp))) end do end do end do @@ -1214,7 +1203,7 @@ contains do j = -1, buff_size flux_rsz_vf_l(j, k, r, i) = & flux_vf(i)%sf(r, k, dj*((p - 1) - 2*j) + j)* & - sign(1._wp, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, kind(0._wp))) end do end do end do @@ -1249,7 +1238,7 @@ contains do j = -1, buff_size flux_src_rsz_vf_l(j, k, r, advxb) = & flux_src_vf(advxb)%sf(r, k, dj*((p - 1) - 2*j) + j)* & - sign(1._wp, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, kind(0._wp))) end do end do end do @@ -1298,9 +1287,8 @@ contains do k = is2%beg, is2%end do j = -1, buff_size flux_vf(i)%sf(dj*((m - 1) - 2*j) + j, k, r) = & - flux_rsx_vf_l(j, k, r, i)* & - sign(1._wp, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, kind(0._wp))) end do end do end do @@ -1333,9 +1321,8 @@ contains do k = is2%beg, is2%end do j = -1, buff_size flux_src_vf(advxb)%sf(dj*((m - 1) - 2*j) + j, k, r) = & - flux_src_rsx_vf_l(j, k, r, advxb)* & - sign(1._wp, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, kind(0._wp))) end do end do end do @@ -1351,9 +1338,8 @@ contains do k = is2%beg, is2%end do j = -1, buff_size flux_vf(i)%sf(k, dj*((n - 1) - 2*j) + j, r) = & - flux_rsy_vf_l(j, k, r, i)* & - sign(1._wp, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, kind(0._wp))) end do end do end do @@ -1387,9 +1373,8 @@ contains do k = is2%beg, is2%end do j = -1, buff_size flux_src_vf(advxb)%sf(k, dj*((n - 1) - 2*j) + j, r) = & - flux_src_rsy_vf_l(j, k, r, advxb)* & - sign(1._wp, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, kind(0._wp))) end do end do end do @@ -1406,9 +1391,8 @@ contains do k = is2%beg, is2%end do j = -1, buff_size flux_vf(i)%sf(r, k, dj*((p - 1) - 2*j) + j) = & - flux_rsz_vf_l(j, k, r, i)* & - sign(1._wp, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, kind(0._wp))) end do end do end do @@ -1442,9 +1426,8 @@ contains do k = is2%beg, is2%end do j = -1, buff_size flux_src_vf(advxb)%sf(r, k, dj*((p - 1) - 2*j) + j) = & - flux_src_rsz_vf_l(j, k, r, advxb)* & - sign(1._wp, -real(cbc_loc, wp)) + sign(1._wp, -real(cbc_loc, kind(0._wp))) end do end do end do diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index 97e13e2b89..3c909156e9 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -64,14 +64,20 @@ contains @:PROHIBIT(p + 1 < min(1, p)*num_stcls_min*weno_order, & "For 3D simulation, p must be greater than or equal to (num_stcls_min*weno_order - 1), whose value is "//trim(numStr)) @:PROHIBIT(weno_order /= 1 .and. f_is_default(weno_eps), & - "weno_order != 1, but weno_eps is not set. A typical value of weno_eps is 1e-6_wp") - @:PROHIBIT(weno_eps <= 0._wp, "weno_eps must be positive. A typical value of weno_eps is 1e-6_wp") - @:PROHIBIT(teno .and. f_is_default(teno_CT), "teno is used, but teno_CT is not set. A typical value of teno_CT is 1e-6_wp") - @:PROHIBIT(teno .and. teno_CT <= 0._wp, "teno_CT must be positive. A typical value of teno_CT is 1e-6_wp") + "weno_order != 1, but weno_eps is not set. A typical value of weno_eps is 1e-6") + + @:PROHIBIT(weno_eps <= 0._wp, "weno_eps must be positive. A typical value of weno_eps is 1e-6") + @:PROHIBIT(wenoz .and. weno_order == real(7, wp) .and. f_is_default(real(wenoz_q, wp)), & + "wenoz is used at 7th order, but wenoz_q is not set. It should be either 2, 3, or 4") + @:PROHIBIT(wenoz .and. weno_order == real(7, wp) .and. .not. (f_approx_equal(real(wenoz_q, wp), real(2, wp)) .or. & + f_approx_equal(real(wenoz_q, wp), real(3, wp)) .or. f_approx_equal(real(wenoz_q, wp), real(4, wp))), & + "wenoz_q must be either 2, 3, or 4") + @:PROHIBIT(teno .and. f_is_default(teno_CT), "teno is used, but teno_CT is not set. A typical value of teno_CT is 1e-6") + @:PROHIBIT(teno .and. teno_CT <= 0._wp, "teno_CT must be positive. A typical value of teno_CT is 1e-6") @:PROHIBIT(count([mapped_weno, wenoz, teno]) >= 2, "Only one of mapped_weno, wenoz, or teno can be set to true") @:PROHIBIT(weno_order == 1 .and. mapped_weno) @:PROHIBIT(weno_order == 1 .and. wenoz) - @:PROHIBIT(weno_order /= 5 .and. teno) + @:PROHIBIT((weno_order == 1 .or. weno_order == 3) .and. teno) @:PROHIBIT(weno_order /= 5 .and. mp_weno) @:PROHIBIT(model_eqns == 1 .and. weno_avg) end subroutine s_check_inputs_weno @@ -298,4 +304,4 @@ contains @:PROHIBIT(integral_wrt .and. (.not. bubbles)) end subroutine s_check_inputs_misc -end module m_checker \ No newline at end of file +end module m_checker diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 02f3ae4411..209e5e302b 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -48,7 +48,6 @@ module m_data_output s_close_probe_files, & s_finalize_data_output_module - real(wp), allocatable, dimension(:, :, :) :: icfl_sf !< ICFL stability criterion real(wp), allocatable, dimension(:, :, :) :: vcfl_sf !< VCFL stability criterion real(wp), allocatable, dimension(:, :, :) :: ccfl_sf !< CCFL stability criterion diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index 6a5d248470..442f6b6cdb 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -350,7 +350,6 @@ module m_global_parameters integer :: nb !< Number of eq. bubble sizes #:endif - real(wp) :: R0ref !< Reference bubble size real(wp) :: Ca !< Cavitation number real(wp) :: Web !< Weber number @@ -370,7 +369,6 @@ module m_global_parameters integer :: bubble_model !< Gilmore or Keller--Miksis bubble model integer :: thermal !< Thermal behavior. 1 = adiabatic, 2 = isotherm, 3 = transfer - real(wp), allocatable, dimension(:, :, :) :: ptil !< Pressure modification !$acc declare create(ptil) @@ -442,7 +440,6 @@ module m_global_parameters !$acc declare create(momxb, momxe, advxb, advxe, contxb, contxe, intxb, intxe, bubxb, bubxe, strxb, strxe, chemxb, chemxe) - real(wp), allocatable, dimension(:) :: gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps !$acc declare create(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps) diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index ba71f44368..8b50f3611a 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -22,7 +22,6 @@ module m_hypoelastic private; public :: s_initialize_hypoelastic_module, & s_compute_hypoelastic_rhs - real(wp), allocatable, dimension(:) :: Gs !$acc declare create(Gs) diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index 40f10a790f..849856fc99 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -32,7 +32,6 @@ module m_mpi_proxy implicit none - real(wp), private, allocatable, dimension(:), target :: q_cons_buff_send !< !! This variable is utilized to pack and send the buffer of the cell-average !! conservative variables, for a single computational domain boundary at the diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp index ffd8e57a76..d7942b15e7 100644 --- a/src/simulation/m_qbmm.fpp +++ b/src/simulation/m_qbmm.fpp @@ -28,7 +28,6 @@ module m_qbmm private; public :: s_initialize_qbmm_module, s_mom_inv, s_coeff, s_compute_qbmm_rhs - real(wp), allocatable, dimension(:, :, :, :, :) :: momrhs !$acc declare create(momrhs) diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 2cce02fb2b..173253dc50 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -147,7 +147,6 @@ module m_rhs !> @} !$acc declare create(alf_sum) - real(wp), allocatable, dimension(:, :, :) :: blkmod1, blkmod2, alpha1, alpha2, Kterm real(wp), allocatable, dimension(:, :, :, :) :: qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, qR_rsx_vf, qR_rsy_vf, qR_rsz_vf real(wp), allocatable, dimension(:, :, :, :) :: dqL_rsx_vf, dqL_rsy_vf, dqL_rsz_vf, dqR_rsx_vf, dqR_rsy_vf, dqR_rsz_vf @@ -155,15 +154,12 @@ module m_rhs !$acc declare create(qL_rsx_vf, qL_rsy_vf, qL_rsz_vf, qR_rsx_vf, qR_rsy_vf, qR_rsz_vf) !$acc declare create(dqL_rsx_vf, dqL_rsy_vf, dqL_rsz_vf, dqR_rsx_vf, dqR_rsy_vf, dqR_rsz_vf) - real(wp), allocatable, dimension(:) :: gamma_min, pres_inf !$acc declare create(gamma_min, pres_inf) - real(wp), allocatable, dimension(:, :) :: Res !$acc declare create(Res) - real(wp), allocatable, dimension(:, :, :) :: nbub !< Bubble number density !$acc declare create(nbub) @@ -622,7 +618,6 @@ contains integer, intent(in) :: t_step real(wp), intent(inout) :: time_avg - real(wp), dimension(0:m, 0:n, 0:p) :: nbub real(wp) :: t_start, t_finish integer :: i, j, k, l, id !< Generic loop iterators @@ -648,7 +643,6 @@ contains if (mpp_lim .and. bubbles) then !$acc parallel loop collapse(3) gang vector default(present) - do l = idwbuff(3)%beg, idwbuff(3)%end do k = idwbuff(2)%beg, idwbuff(2)%end do j = idwbuff(1)%beg, idwbuff(1)%end diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 630a7bf8ba..f06fa41ba8 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -104,11 +104,9 @@ module m_riemann_solvers !$acc declare create(is1, is2, is3, isx, isy, isz) - real(wp), allocatable, dimension(:) :: Gs !$acc declare create(Gs) - real(wp), allocatable, dimension(:, :) :: Res !$acc declare create(Res) @@ -298,7 +296,6 @@ contains integer, intent(in) :: norm_dir type(int_bounds_info), intent(in) :: ix, iy, iz - real(wp), dimension(num_fluids) :: alpha_rho_L, alpha_rho_R real(wp) :: rho_L, rho_R real(wp), dimension(num_dims) :: vel_L, vel_R @@ -338,7 +335,6 @@ contains real(wp) :: Ms_L, Ms_R, pres_SL, pres_SR real(wp) :: alpha_L_sum, alpha_R_sum - integer :: i, j, k, l, q !< Generic loop iterators ! Populating the buffers of the left and right Riemann problem @@ -480,7 +476,6 @@ contains end do end if - if (chemistry) then !$acc loop seq do i = chemxb, chemxe @@ -915,7 +910,6 @@ contains integer, intent(in) :: norm_dir type(int_bounds_info), intent(in) :: ix, iy, iz - real(wp), dimension(num_fluids) :: alpha_rho_L, alpha_rho_R real(wp) :: rho_L, rho_R real(wp), dimension(num_dims) :: vel_L, vel_R @@ -2180,7 +2174,6 @@ contains end do end if - if (chemistry) then c_sum_Yi_Phi = 0.0_wp !$acc loop seq @@ -4373,4 +4366,4 @@ contains end subroutine s_finalize_riemann_solvers_module -end module m_riemann_solvers \ No newline at end of file +end module m_riemann_solvers diff --git a/src/simulation/m_sim_helpers.f90 b/src/simulation/m_sim_helpers.f90 index 71da04d637..f52b25e65a 100644 --- a/src/simulation/m_sim_helpers.f90 +++ b/src/simulation/m_sim_helpers.f90 @@ -236,7 +236,6 @@ subroutine s_compute_dt_from_cfl(vel, c, max_dt, rho, Re_l, j, k, l) !1D icfl_dt = cfl_target*(dx(j)/(abs(vel(1)) + c)) - if (viscous) then vcfl_dt = cfl_target*(dx(j)**2._wp)/minval(1/(rho*Re_l)) end if diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp index f0b9b13481..9a84c4cfc8 100644 --- a/src/simulation/m_surface_tension.fpp +++ b/src/simulation/m_surface_tension.fpp @@ -34,7 +34,6 @@ module m_surface_tension !> @) !$acc declare create(c_divs) - !> @name cell boundary reconstructed gradient components and magnitude !> @{ real(wp), allocatable, dimension(:, :, :, :) :: gL_x, gR_x, gL_y, gR_y, gL_z, gR_z diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 2118a546ed..ec59a555cb 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -44,7 +44,6 @@ module m_time_steppers implicit none - type(vector_field), allocatable, dimension(:) :: q_cons_ts !< !! Cell-average conservative variables at each time-stage (TS) @@ -830,7 +829,6 @@ contains integer, intent(in) :: t_step real(wp), intent(inout) :: time_avg - real(wp) :: start, finish call cpu_time(start) diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp index dcf6e559ee..d19009d1fd 100644 --- a/src/simulation/m_viscous.fpp +++ b/src/simulation/m_viscous.fpp @@ -28,7 +28,6 @@ module m_viscous type(int_bounds_info) :: is1_viscous, is2_viscous, is3_viscous !$acc declare create(is1_viscous, is2_viscous, is3_viscous, iv) - real(wp), allocatable, dimension(:, :) :: Res_viscous !$acc declare create(Res_viscous) @@ -1361,7 +1360,6 @@ contains end if !$acc parallel loop collapse(2) gang vector default(present) - do l = idwbuff(3)%beg, idwbuff(3)%end do k = idwbuff(2)%beg, idwbuff(2)%end grad_x%sf(idwbuff(1)%beg, k, l) = & @@ -1374,7 +1372,6 @@ contains end do if (n > 0) then !$acc parallel loop collapse(2) gang vector default(present) - do l = idwbuff(3)%beg, idwbuff(3)%end do j = idwbuff(1)%beg, idwbuff(1)%end grad_y%sf(j, idwbuff(2)%beg, l) = & @@ -1387,7 +1384,6 @@ contains end do if (p > 0) then !$acc parallel loop collapse(2) gang vector default(present) - do k = idwbuff(2)%beg, idwbuff(2)%end do j = idwbuff(1)%beg, idwbuff(1)%end grad_z%sf(j, k, idwbuff(3)%beg) = & @@ -1403,7 +1399,6 @@ contains if (bc_x%beg <= -3) then !$acc parallel loop collapse(2) gang vector default(present) - do l = idwbuff(3)%beg, idwbuff(3)%end do k = idwbuff(2)%beg, idwbuff(2)%end grad_x%sf(0, k, l) = (-3._wp*var%sf(0, k, l) + 4._wp*var%sf(1, k, l) - var%sf(2, k, l))/ & @@ -1413,7 +1408,6 @@ contains end if if (bc_x%end <= -3) then !$acc parallel loop collapse(2) gang vector default(present) - do l = idwbuff(3)%beg, idwbuff(3)%end do k = idwbuff(2)%beg, idwbuff(2)%end grad_x%sf(m, k, l) = (3._wp*var%sf(m, k, l) - 4._wp*var%sf(m - 1, k, l) + var%sf(m - 2, k, l))/ & @@ -1424,7 +1418,6 @@ contains if (n > 0) then if (bc_y%beg <= -3 .and. bc_y%beg /= -13) then !$acc parallel loop collapse(2) gang vector default(present) - do l = idwbuff(3)%beg, idwbuff(3)%end do j = idwbuff(1)%beg, idwbuff(1)%end grad_y%sf(j, 0, l) = (-3._wp*var%sf(j, 0, l) + 4._wp*var%sf(j, 1, l) - var%sf(j, 2, l))/ & @@ -1434,7 +1427,6 @@ contains end if if (bc_y%end <= -3) then !$acc parallel loop collapse(2) gang vector default(present) - do l = idwbuff(3)%beg, idwbuff(3)%end do j = idwbuff(1)%beg, idwbuff(1)%end grad_y%sf(j, n, l) = (3._wp*var%sf(j, n, l) - 4._wp*var%sf(j, n - 1, l) + var%sf(j, n - 2, l))/ & diff --git a/src/simulation/m_weno.fpp b/src/simulation/m_weno.fpp index da87ea1731..34cbd22b5a 100644 --- a/src/simulation/m_weno.fpp +++ b/src/simulation/m_weno.fpp @@ -44,7 +44,6 @@ module m_weno !! stencils (WS) that are annexed to each position of a given scalar field. !> @{ - real(wp), allocatable, dimension(:, :, :, :) :: v_rs_ws_x, v_rs_ws_y, v_rs_ws_z !> @} @@ -111,7 +110,6 @@ module m_weno ! !> @} - real(wp) :: test !$acc declare create(test) @@ -482,7 +480,6 @@ contains end if end if - end if #:endfor @@ -512,7 +509,6 @@ contains integer, intent(in) :: weno_dir type(int_bounds_info), intent(in) :: is1_weno_d, is2_weno_d, is3_weno_d - real(wp), dimension(-weno_polyn:weno_polyn - 1) :: dvd real(wp), dimension(0:weno_num_stencils) :: poly real(wp), dimension(0:weno_num_stencils) :: alpha @@ -926,7 +922,6 @@ contains end subroutine s_weno - !> The computation of parameters, the allocation of memory, !! the association of pointers and/or the execution of any !! other procedures that are required for the setup of the diff --git a/toolchain/mfc/test/case.py b/toolchain/mfc/test/case.py index bdc6039535..a09f586797 100644 --- a/toolchain/mfc/test/case.py +++ b/toolchain/mfc/test/case.py @@ -222,25 +222,28 @@ def to_input_file(self) -> input.MFCInputFile: self.get_dirpath(), self.get_parameters()) - def compute_tolerance(self) -> float: + if self.override_tol: + return self.override_tol + + tolerance = 1e-12 # Default single = ARG("single") + if self.params.get("hypoelasticity", 'F') == 'T': - tol = 1e-7 - elif self.params.get("weno_order") == 7: - tol = 1e-9 + tolerance = 1e-7 elif any(self.params.get(key, 'F') == 'T' for key in ['relax', 'ib', 'qbmm', 'bubbles']): - tol = 1e-10 - elif self.params.get("low_Mach", 'F') == 1 or self.params.get("low_Mach", 'F') == 2: - tol = 1e-10 + tolerance = 1e-10 + elif self.params.get("low_Mach", 'F') in [1, 2]: + tolerance = 1e-10 elif self.params.get("acoustic_source", 'F') == 'T': - if "acoustic(1)%pulse" in self.params and self.params["acoustic(1)%pulse"] == 3: # Square wave + if self.params.get("acoustic(1)%pulse") == 3: # Square wave return 1e-1 if single else 1e-5 - tol = 3e-12 - else: - tol = 3e-12 - tol = tol * 1e8 if single else tol - return tol + tolerance = 3e-12 + elif self.params.get("weno_order") == 7: + tolerance = 1e-9 + + return 1e8 * tolerance if single else tolerance + @dataclasses.dataclass diff --git a/toolchain/mfc/test/cases.py b/toolchain/mfc/test/cases.py index bf8cce95fd..192d590946 100644 --- a/toolchain/mfc/test/cases.py +++ b/toolchain/mfc/test/cases.py @@ -455,7 +455,6 @@ def alter_hypoelasticity(dimInfo): 'patch_icpp(3)%pres': 5.E+05, 'patch_icpp(3)%alpha_rho(1)': 1000.E+00, 'patch_icpp(1)%tau_e(1)': 0.E-00, 'patch_icpp(2)%tau_e(1)': 0.E-00, 'patch_icpp(3)%tau_e(1)': 0.E-00, 'fluid_pp(1)%G': 1.E+05, - }) if num_fluids == 2: diff --git a/toolchain/mfc/test/test.py b/toolchain/mfc/test/test.py index 18c266aaea..5a538f1eeb 100644 --- a/toolchain/mfc/test/test.py +++ b/toolchain/mfc/test/test.py @@ -20,6 +20,7 @@ nPASS = 0 nSKIP = 0 +# pylint: disable=too-many-branches, trailing-whitespace def __filter(cases_) -> typing.List[TestCase]: cases = cases_[:] @@ -233,7 +234,7 @@ def handle_case(case: TestCase, devices: typing.Set[int]): try: _handle_case(case, devices) nPASS += 1 - except MFCException as exc: + except Exception as exc: if nAttempts < max_attempts: continue nFAIL += 1 From aca66bf7d6660364425e967baf9ff5fd798a0576 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Sun, 10 Nov 2024 15:05:11 -0500 Subject: [PATCH 25/68] fix Benchmarking Speedup CI --- .github/workflows/bench.yml | 20 +------------------- toolchain/mfc/bench.py | 32 +++++++++++++++++++++++++------- 2 files changed, 26 insertions(+), 26 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index 30a651dc38..ab12be78bd 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -52,25 +52,7 @@ jobs: (cd pr && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }} --single) & (cd master && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }} --single) & wait - - - name: Check Speedup - run: | - cd pr - . ./mfc.sh load -c p -m ${{ matrix.device }} - - single_time=$(grep "Runtime:" bench-${{ matrix.device }}-single.yaml | awk '{print $2}') - double_time=$(grep "Runtime:" bench-${{ matrix.device }}.yaml | awk '{print $2}') - speedup=$(echo "$double_time / $single_time" | bc -l) - - echo "Single precision time: $single_time" - echo "Double precision time: $double_time" - echo "Speedup: $speedup" - - if (( $(echo "$speedup < 1.5" | bc -l) )); then - echo "Error: Speedup is less than 1.5x in single precision" - exit 1 - fi - + - name: Generate & Post Comment run: | cd pr diff --git a/toolchain/mfc/bench.py b/toolchain/mfc/bench.py index 93f719c4b2..fd1287c7bd 100644 --- a/toolchain/mfc/bench.py +++ b/toolchain/mfc/bench.py @@ -17,7 +17,7 @@ class BenchCase: args: typing.List[str] -def bench(targets = None): +def bench(targets=None): if targets is None: targets = ARG("targets") @@ -31,7 +31,7 @@ def bench(targets = None): cons.indent() cons.print() - CASES = [ BenchCase(**case) for case in file_load_yaml(MFC_BENCH_FILEPATH) ] + CASES = [BenchCase(**case) for case in file_load_yaml(MFC_BENCH_FILEPATH)] for case in CASES: case.args = case.args + ARG("--") @@ -40,14 +40,17 @@ def bench(targets = None): results = { "metadata": { "invocation": sys.argv[1:], - "lock": dataclasses.asdict(CFG()) + "lock": dataclasses.asdict(CFG()) }, "cases": {}, } + single_precision_runtime = None + double_precision_runtime = None + for i, case in enumerate(CASES): summary_filepath = os.path.join(bench_dirpath, f"{case.slug}.yaml") - log_filepath = os.path.join(bench_dirpath, f"{case.slug}.out") + log_filepath = os.path.join(bench_dirpath, f"{case.slug}.out") cons.print(f"{str(i+1).zfill(len(CASES) // 10 + 1)}/{len(CASES)}: {case.slug} @ [bold]{os.path.relpath(case.path)}[/bold]") cons.indent() @@ -65,13 +68,28 @@ def bench(targets = None): stdout=log_file, stderr=subprocess.STDOUT) + output_summary = file_load_yaml(summary_filepath) results["cases"][case.slug] = { - "description": dataclasses.asdict(case), - "output_summary": file_load_yaml(summary_filepath), + "description": dataclasses.asdict(case), + "output_summary": output_summary, } - file_dump_yaml(ARG("output"), results) + if "single" in case.slug: + single_precision_runtime = output_summary.get("exec") + elif "double" in case.slug: + double_precision_runtime = output_summary.get("exec") + + # Check for speedup requirement + if single_precision_runtime and double_precision_runtime: + speedup = double_precision_runtime / single_precision_runtime + cons.print(f"Single precision runtime: {single_precision_runtime}") + cons.print(f"Double precision runtime: {double_precision_runtime}") + cons.print(f"Speedup: {speedup:.2f}") + if speedup < 1.2: + raise MFCException("Error: Single precision runtime is not at least 1.2 times faster than double precision.") + + file_dump_yaml(ARG("output"), results) cons.print(f"Wrote results to [bold magenta]{os.path.relpath(ARG('output'))}[/bold magenta].") cons.unindent() From b525b1f6db57182340e24f8bb86309e19ddf4b88 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Mon, 11 Nov 2024 13:10:17 -0500 Subject: [PATCH 26/68] just test bench.yml changes --- .github/workflows/bench.yml | 18 +++++++-------- .github/workflows/phoenix/submit.sh | 2 -- toolchain/mfc/bench.py | 34 +++++++---------------------- 3 files changed, 17 insertions(+), 37 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index ab12be78bd..dba4d22757 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -17,6 +17,7 @@ jobs: id: changes with: filters: ".github/file-filter.yml" + self: name: Georgia Tech | Phoenix (NVHPC) if: github.repository == 'MFlowCode/MFC' @@ -24,7 +25,7 @@ jobs: matrix: device: ['cpu', 'gpu'] runs-on: - group: phoenix + group: phoenix labels: gt timeout-minutes: 1400 env: @@ -47,18 +48,17 @@ jobs: run: | (cd pr && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }}) & (cd master && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }}) & - wait + wait %1 && wait %2 (cd pr && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }} --single) & (cd master && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }} --single) & - wait - + wait %3 && wait %4 + - name: Generate & Post Comment run: | - cd pr - . ./mfc.sh load -c p -m ${{ matrix.device }} - ./mfc.sh bench_diff ../master/bench-${{ matrix.device }}.yaml bench-${{ matrix.device }}.yaml - + (cd pr && . ./mfc.sh load -c p -m g) + (cd pr && ./mfc.sh bench_diff ../master/bench-${{ matrix.device }}.yaml ../pr/bench-${{ matrix.device }}.yaml) + (cd pr && ./mfc.sh bench_diff ../master/bench-${{ matrix.device }}-single.yaml ../pr/bench-${{ matrix.device }}-single.yaml) - name: Archive Logs uses: actions/upload-artifact@v4 if: always() @@ -68,4 +68,4 @@ jobs: pr/bench-${{ matrix.device }}.* pr/build/benchmarks/* master/bench-${{ matrix.device }}.* - master/build/benchmarks/* + master/build/benchmarks/* \ No newline at end of file diff --git a/.github/workflows/phoenix/submit.sh b/.github/workflows/phoenix/submit.sh index 0f97e3d455..778083ab62 100644 --- a/.github/workflows/phoenix/submit.sh +++ b/.github/workflows/phoenix/submit.sh @@ -33,7 +33,6 @@ else exit 1 fi -# Check for the --single flag single_flag="" if [ "$3" == "--single" ]; then single_flag="--single" @@ -41,7 +40,6 @@ fi job_slug="`basename "$1" | sed 's/\.sh$//' | sed 's/[^a-zA-Z0-9]/-/g'`-$2" -# **Add this block to adjust job_slug if --single is used** if [ "$single_flag" == "--single" ]; then job_slug="${job_slug}-single" fi diff --git a/toolchain/mfc/bench.py b/toolchain/mfc/bench.py index fd1287c7bd..0a25b25106 100644 --- a/toolchain/mfc/bench.py +++ b/toolchain/mfc/bench.py @@ -17,7 +17,7 @@ class BenchCase: args: typing.List[str] -def bench(targets=None): +def bench(targets = None): if targets is None: targets = ARG("targets") @@ -31,7 +31,7 @@ def bench(targets=None): cons.indent() cons.print() - CASES = [BenchCase(**case) for case in file_load_yaml(MFC_BENCH_FILEPATH)] + CASES = [ BenchCase(**case) for case in file_load_yaml(MFC_BENCH_FILEPATH) ] for case in CASES: case.args = case.args + ARG("--") @@ -40,17 +40,14 @@ def bench(targets=None): results = { "metadata": { "invocation": sys.argv[1:], - "lock": dataclasses.asdict(CFG()) + "lock": dataclasses.asdict(CFG()) }, "cases": {}, } - single_precision_runtime = None - double_precision_runtime = None - for i, case in enumerate(CASES): summary_filepath = os.path.join(bench_dirpath, f"{case.slug}.yaml") - log_filepath = os.path.join(bench_dirpath, f"{case.slug}.out") + log_filepath = os.path.join(bench_dirpath, f"{case.slug}.out") cons.print(f"{str(i+1).zfill(len(CASES) // 10 + 1)}/{len(CASES)}: {case.slug} @ [bold]{os.path.relpath(case.path)}[/bold]") cons.indent() @@ -68,28 +65,13 @@ def bench(targets=None): stdout=log_file, stderr=subprocess.STDOUT) - output_summary = file_load_yaml(summary_filepath) results["cases"][case.slug] = { - "description": dataclasses.asdict(case), - "output_summary": output_summary, + "description": dataclasses.asdict(case), + "output_summary": file_load_yaml(summary_filepath), } - if "single" in case.slug: - single_precision_runtime = output_summary.get("exec") - elif "double" in case.slug: - double_precision_runtime = output_summary.get("exec") - - # Check for speedup requirement - if single_precision_runtime and double_precision_runtime: - speedup = double_precision_runtime / single_precision_runtime - cons.print(f"Single precision runtime: {single_precision_runtime}") - cons.print(f"Double precision runtime: {double_precision_runtime}") - cons.print(f"Speedup: {speedup:.2f}") - - if speedup < 1.2: - raise MFCException("Error: Single precision runtime is not at least 1.2 times faster than double precision.") - file_dump_yaml(ARG("output"), results) + cons.print(f"Wrote results to [bold magenta]{os.path.relpath(ARG('output'))}[/bold magenta].") cons.unindent() @@ -185,4 +167,4 @@ def _lock_to_str(lock): cons.raw.print(table) if err != 0: - raise MFCException("Benchmarking failed") + raise MFCException("Benchmarking failed") \ No newline at end of file From 63c793902db30632c0f93092d64d1f4acb295b8d Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Mon, 18 Nov 2024 00:47:49 -0500 Subject: [PATCH 27/68] fix changes to CI --- .github/workflows/bench.yml | 30 +++--- .github/workflows/phoenix/bench.sh | 30 ++++-- .github/workflows/phoenix/submit.sh | 57 +++++------ src/common/m_derived_types.fpp | 2 +- toolchain/mfc/bench.py | 146 +++++++++++++--------------- toolchain/mfc/test/test.py | 2 +- 6 files changed, 128 insertions(+), 139 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index 49e327a007..40d5b9cd3a 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -11,7 +11,6 @@ jobs: steps: - name: Clone uses: actions/checkout@v4 - - name: Detect Changes uses: dorny/paths-filter@v3 id: changes @@ -26,7 +25,7 @@ jobs: matrix: device: ['cpu', 'gpu'] runs-on: - group: phoenix + group: phoenix labels: gt timeout-minutes: 1400 env: @@ -37,7 +36,6 @@ jobs: uses: actions/checkout@v4 with: path: pr - - name: Clone - Master uses: actions/checkout@v4 with: @@ -45,28 +43,28 @@ jobs: ref: master path: master - - name: Bench (Master v. PR) + - name: Bench (Master vs PR) run: | - (cd pr && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }}) & - (cd master && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }}) & + (cd pr && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }} double) & + (cd master && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }} double) & wait %1 && wait %2 - (cd pr && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }} --single) & - (cd master && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }} --single) & - wait %3 && wait %4 + (cd pr && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }} single) & + wait %3 - - name: Generate & Post Comment + - name: Check PR Single vs Double Precision run: | - (cd pr && . ./mfc.sh load -c p -m g) - (cd pr && ./mfc.sh bench_diff ../master/bench-${{ matrix.device }}.yaml ../pr/bench-${{ matrix.device }}.yaml) - (cd pr && ./mfc.sh bench_diff ../master/bench-${{ matrix.device }}-single.yaml ../pr/bench-${{ matrix.device }}-single.yaml) + # Compare single and double precision within the PR + cd pr + . ./mfc.sh load -c p -m ${{ matrix.device }} + ./mfc.sh bench_diff bench-${{ matrix.device }}-double.yaml bench-${{ matrix.device }}-single.yaml + - name: Archive Logs uses: actions/upload-artifact@v4 - if: always() + if: always() with: name: logs-${{ matrix.device }} path: | pr/bench-${{ matrix.device }}.* - pr/build/benchmarks/* master/bench-${{ matrix.device }}.* - master/build/benchmarks/* \ No newline at end of file + diff --git a/.github/workflows/phoenix/bench.sh b/.github/workflows/phoenix/bench.sh index c2353e2ed8..1cdfb19be7 100644 --- a/.github/workflows/phoenix/bench.sh +++ b/.github/workflows/phoenix/bench.sh @@ -1,16 +1,32 @@ #!/bin/bash +job_device="${1}" +job_precision="${2}" + +if [ -z "$job_device" ] || [ -z "$job_precision" ]; then + echo "Usage: $0 [cpu|gpu] [single|double]" + exit 1 +fi + n_ranks=12 +precision_flag="" + +if [ "$job_precision" == "single" ]; then + precision_flag="--single" +fi if [ "$job_device" == "gpu" ]; then - n_ranks=$(nvidia-smi -L | wc -l) # number of GPUs on node - gpu_ids=$(seq -s ' ' 0 $(($n_ranks-1))) # 0,1,2,...,gpu_count-1 + n_ranks=$(nvidia-smi -L | wc -l) + gpu_ids=$(seq -s ' ' 0 $(($n_ranks-1))) device_opts="--gpu -g $gpu_ids" +else + device_opts="" fi - -if ["$job_device" == "gpu"]; then - ./mfc.sh bench --mem 12 -j $(nproc) -o "$job_slug.yaml" -- -c phoenix $device_opts -n $n_ranks $single_flag -else - ./mfc.sh bench --mem 1 -j $(nproc) -o "$job_slug.yaml" -- -c phoenix $device_opts -n $n_ranks $single_flag +mem_value=1 +if [ "$job_device" == "gpu" ]; then + mem_value=12 fi + +./mfc.sh bench --mem $mem_value -j $(nproc) -o "bench-${job_device}-${job_precision}.yaml" -- $precision_flag -c phoenix $device_opts -n $n_ranks + diff --git a/.github/workflows/phoenix/submit.sh b/.github/workflows/phoenix/submit.sh index f9b52c3906..dd29d5ecaf 100644 --- a/.github/workflows/phoenix/submit.sh +++ b/.github/workflows/phoenix/submit.sh @@ -1,48 +1,37 @@ #!/bin/bash -set -e - +set -es usage() { - echo "Usage: $0 [script.sh] [cpu|gpu] [--single (optional)]" + echo "Usage: $0 [script.sh] [cpu|gpu] [single|double]" } if [ ! -z "$1" ]; then - sbatch_script_contents=`cat $1` + script_path="$1" else usage exit 1 fi -sbatch_cpu_opts="\ -#SBATCH -p cpu-small # partition -#SBATCH --ntasks-per-node=24 # Number of cores per node required -#SBATCH --mem-per-cpu=2G # Memory per core\ -" - -sbatch_gpu_opts="\ -#SBATCH -C V100-16GB -#SBATCH -G2\ -" - if [ "$2" == "cpu" ]; then - sbatch_device_opts="$sbatch_cpu_opts" + sbatch_device_opts="#SBATCH -p cpu-small +#SBATCH --ntasks-per-node=24 +#SBATCH --mem-per-cpu=2G" elif [ "$2" == "gpu" ]; then - sbatch_device_opts="$sbatch_gpu_opts" + sbatch_device_opts="#SBATCH -C V100-16GB +#SBATCH -G2" else usage exit 1 fi -single_flag="" -if [ "$3" == "--single" ]; then - single_flag="--single" +if [ "$3" != "single" ] && [ "$3" != "double" ]; then + usage + exit 1 fi -job_slug="`basename "$1" | sed 's/\.sh$//' | sed 's/[^a-zA-Z0-9]/-/g'`-$2" - -if [ "$single_flag" == "--single" ]; then - job_slug="${job_slug}-single" -fi +job_device="$2" +job_precision="$3" +job_slug="$(basename "$1" | sed 's/\.sh$//' | sed 's/[^a-zA-Z0-9]/-/g')-$job_device-$job_precision" sbatch < Derived type adding beginning (beg) and end bounds info as attributes type bounds_info diff --git a/toolchain/mfc/bench.py b/toolchain/mfc/bench.py index 0a25b25106..5630fdf138 100644 --- a/toolchain/mfc/bench.py +++ b/toolchain/mfc/bench.py @@ -1,14 +1,13 @@ import os, sys, uuid, subprocess, dataclasses, typing, math - import rich.table - from .printer import cons -from .state import ARG, CFG -from .build import get_targets, DEFAULT_TARGETS, SIMULATION -from .common import system, MFC_BENCH_FILEPATH, MFC_BUILD_DIR, format_list_to_string -from .common import file_load_yaml, file_dump_yaml, create_directory -from .common import MFCException +from .state import ARG, CFG +from .build import get_targets, DEFAULT_TARGETS, SIMULATION +from .common import system, MFC_BENCH_FILEPATH, MFC_BUILD_DIR, format_list_to_string +from .common import file_load_yaml, file_dump_yaml, create_directory +from .common import MFCException +SINGLE_PRECISION_SPEEDUP_THRESHOLD = 1.25 # Minimum speedup for PR double vs single precision @dataclasses.dataclass class BenchCase: @@ -16,22 +15,32 @@ class BenchCase: path: str args: typing.List[str] - -def bench(targets = None): +def bench(targets=None, precision="double"): + """ + Benchmarks the provided targets in the specified precision mode (single or double). + """ if targets is None: targets = ARG("targets") - targets = get_targets(targets) + if precision not in ["single", "double"]: + raise ValueError("Precision must be 'single' or 'double'.") + # Set precision_flag based on precision + if precision == "single": + precision_flag = ["--single"] + else: + precision_flag = [] # No flag needed for double precision + + targets = get_targets(targets) bench_dirpath = os.path.join(MFC_BUILD_DIR, "benchmarks", str(uuid.uuid4())[:4]) create_directory(bench_dirpath) - cons.print() - cons.print(f"[bold]Benchmarking {format_list_to_string(ARG('targets'), 'magenta')} ([magenta]{os.path.relpath(bench_dirpath)}[/magenta]):[/bold]") + cons.print(f"[bold]Benchmarking {format_list_to_string(ARG('targets'), 'magenta')} in {precision} precision " + f"([magenta]{os.path.relpath(bench_dirpath)}[/magenta]):[/bold]") cons.indent() cons.print() - CASES = [ BenchCase(**case) for case in file_load_yaml(MFC_BENCH_FILEPATH) ] + CASES = [BenchCase(**case) for case in file_load_yaml(MFC_BENCH_FILEPATH)] for case in CASES: case.args = case.args + ARG("--") @@ -40,18 +49,18 @@ def bench(targets = None): results = { "metadata": { "invocation": sys.argv[1:], - "lock": dataclasses.asdict(CFG()) + "lock": dataclasses.asdict(CFG()), + "precision": precision, }, "cases": {}, } for i, case in enumerate(CASES): - summary_filepath = os.path.join(bench_dirpath, f"{case.slug}.yaml") - log_filepath = os.path.join(bench_dirpath, f"{case.slug}.out") + summary_filepath = os.path.join(bench_dirpath, f"{case.slug}-{precision}.yaml") + log_filepath = os.path.join(bench_dirpath, f"{case.slug}-{precision}.out") - cons.print(f"{str(i+1).zfill(len(CASES) // 10 + 1)}/{len(CASES)}: {case.slug} @ [bold]{os.path.relpath(case.path)}[/bold]") + cons.print(f"{str(i + 1).zfill(len(str(len(CASES))))}/{len(CASES)}: {case.slug} @ [bold]{os.path.relpath(case.path)}[/bold]") cons.indent() - cons.print() cons.print(f"> Log: [bold]{os.path.relpath(log_filepath)}[/bold]") cons.print(f"> Summary: [bold]{os.path.relpath(summary_filepath)}[/bold]") @@ -61,58 +70,62 @@ def bench(targets = None): ["--targets"] + [t.name for t in targets] + ["--output-summary", summary_filepath] + case.args + - ["--", "--gbpp", ARG('mem')], + precision_flag, # Use the precision_flag here stdout=log_file, - stderr=subprocess.STDOUT) + stderr=subprocess.STDOUT + ) results["cases"][case.slug] = { - "description": dataclasses.asdict(case), + "description": dataclasses.asdict(case), "output_summary": file_load_yaml(summary_filepath), } + cons.unindent() file_dump_yaml(ARG("output"), results) - cons.print(f"Wrote results to [bold magenta]{os.path.relpath(ARG('output'))}[/bold magenta].") - cons.unindent() - -# TODO: This function is too long and not nicely written at all. Someone should -# refactor it... -# pylint: disable=too-many-branches def diff(): + """ + Compares the results between two benchmark YAML files (lhs vs rhs). + Checks both PR vs master and PR single vs PR double precision. + """ lhs, rhs = file_load_yaml(ARG("lhs")), file_load_yaml(ARG("rhs")) - cons.print(f"[bold]Comparing Benchmarks: Speedups from [magenta]{os.path.relpath(ARG('lhs'))}[/magenta] to [magenta]{os.path.relpath(ARG('rhs'))}[/magenta] are displayed below. Thus, numbers > 1 represent increases in performance.[/bold]") - if lhs["metadata"] != rhs["metadata"]: + lhs_precision = lhs["metadata"].get("precision", "double") + rhs_precision = rhs["metadata"].get("precision", "double") + + is_pr_single_vs_double = lhs_precision == "double" and rhs_precision == "single" + + cons.print(f"[bold]Comparing Benchmarks: Speedups from [magenta]{os.path.relpath(ARG('lhs'))}[/magenta] to " + f"[magenta]{os.path.relpath(ARG('rhs'))}[/magenta][/bold]") + + if lhs["metadata"] != rhs["metadata"] and not is_pr_single_vs_double: def _lock_to_str(lock): return ' '.join([f"{k}={v}" for k, v in lock.items()]) cons.print(f"""\ [bold yellow]Warning[/bold yellow]: Metadata in lhs and rhs are not equal. - This could mean that the benchmarks are not comparable (e.g. one was run on CPUs and the other on GPUs). lhs: * Invocation: [magenta]{' '.join(lhs['metadata']['invocation'])}[/magenta] * Modes: {_lock_to_str(lhs['metadata']['lock'])} + * Precision: {lhs_precision} rhs: * Invocation: {' '.join(rhs['metadata']['invocation'])} * Modes: [magenta]{_lock_to_str(rhs['metadata']['lock'])}[/magenta] + * Precision: {rhs_precision} """) slugs = set(lhs["cases"].keys()) & set(rhs["cases"].keys()) if len(slugs) not in [len(lhs["cases"]), len(rhs["cases"])]: cons.print(f"""\ [bold yellow]Warning[/bold yellow]: Cases in lhs and rhs are not equal. - * rhs cases: {', '.join(set(rhs['cases'].keys()) - slugs)}. - * lhs cases: {', '.join(set(lhs['cases'].keys()) - slugs)}. - Using intersection: {slugs} with {len(slugs)} elements. - """) + Using intersection: {slugs} with {len(slugs)} elements.""") table = rich.table.Table(show_header=True, box=rich.table.box.SIMPLE) - table.add_column("[bold]Case[/bold]", justify="left") - table.add_column("[bold]Pre Process[/bold]", justify="right") - table.add_column("[bold]Simulation[/bold]", justify="right") - table.add_column("[bold]Post Process[/bold]", justify="right") + table.add_column("[bold]Case[/bold]", justify="left") + table.add_column("[bold]Speedup (Exec)[/bold]", justify="right") + table.add_column("[bold]Speedup (Grind)[/bold]", justify="right") err = 0 @@ -120,51 +133,26 @@ def _lock_to_str(lock): lhs_summary = lhs["cases"][slug]["output_summary"] rhs_summary = rhs["cases"][slug]["output_summary"] - speedups = ['N/A', 'N/A', 'N/A'] - - for i, target in enumerate(sorted(DEFAULT_TARGETS, key=lambda t: t.runOrder)): - if (target.name not in lhs_summary) or (target.name not in rhs_summary): + try: + exec_speedup = lhs_summary["exec"] / rhs_summary["exec"] + grind_speedup = lhs_summary["grind"] / rhs_summary["grind"] + if is_pr_single_vs_double and exec_speedup < SINGLE_PRECISION_SPEEDUP_THRESHOLD: + cons.print(f"[bold red]Error[/bold red]: Case {slug} failed speedup requirement: " + f"Exec speedup {exec_speedup:.2f} < {SINGLE_PRECISION_SPEEDUP_THRESHOLD}.") err = 1 - if target.name not in lhs_summary: - cons.print(f"{target.name} not present in lhs_summary - Case: {slug}") - - if target.name not in rhs_summary: - cons.print(f"{target.name} not present in rhs_summary - Case: {slug}") - - continue + table.add_row(slug, f"{exec_speedup:.2f}x", f"{grind_speedup:.2f}x") - if not math.isfinite(lhs_summary[target.name]["exec"]) or not math.isfinite(rhs_summary[target.name]["exec"]): - err = 1 - cons.print(f"lhs_summary or rhs_summary reports non-real exec time for {target.name} - Case: {slug}") - - exec_time_speedup = "N/A" - try: - exec_time_speedup = f'{lhs_summary[target.name]["exec"] / rhs_summary[target.name]["exec"]:.2f}' - except Exception as _: - err = 1 - cons.print(f"lhs_summary or rhs_summary reports non-real exec time for {target.name} - Case: {slug}") - - speedups[i] = f"Exec: {exec_time_speedup}" - - if target == SIMULATION: - grind_time_speedup = "N/A" - if not math.isfinite(lhs_summary[target.name]["grind"]) or not math.isfinite(rhs_summary[target.name]["grind"]): - err = 1 - cons.print(f"lhs_summary or rhs_summary reports non-real grind time for {target.name} - Case: {slug}") - - try: - grind_time_speedup = f'{lhs_summary[target.name]["grind"] / rhs_summary[target.name]["grind"]:.2f}' - except Exception as _: - err = 1 - cons.print(f"lhs_summary or rhs_summary reports non-real grind time for {target.name} - Case: {slug}") - - speedups[i] += f" & Grind: {grind_time_speedup}" - - table.add_row(f"[magenta]{slug}[/magenta]", *speedups) + except KeyError as e: + table.add_row(slug, "Error", "Error") + cons.print(f"[bold yellow]Warning[/bold yellow]: Missing key {e} for case {slug}.") + except ZeroDivisionError: + table.add_row(slug, "Inf", "Inf") + cons.print(f"[bold yellow]Warning[/bold yellow]: Zero execution time in case {slug}.") cons.raw.print(table) - if err != 0: - raise MFCException("Benchmarking failed") \ No newline at end of file + if err: + raise MFCException("Benchmarking failed: Some cases did not meet the performance requirements.") + diff --git a/toolchain/mfc/test/test.py b/toolchain/mfc/test/test.py index 4a8a1a7ef9..6f9d246f3e 100644 --- a/toolchain/mfc/test/test.py +++ b/toolchain/mfc/test/test.py @@ -55,7 +55,7 @@ def __filter(cases_) -> typing.List[TestCase]: for case in cases[:]: if ARG("single"): - skip = ['low_mach', 'Hypoelasticity', 'teno', 'Chemistry'] + skip = ['low_Mach', 'Hypoelasticity', 'teno', 'Chemistry'] if any(label in case.trace for label in skip): cases.remove(case) From 23053e8c16f8d35db01c3ff52c0b8131f9101251 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Mon, 18 Nov 2024 16:45:03 -0500 Subject: [PATCH 28/68] fix small issue --- .github/workflows/phoenix/submit.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/phoenix/submit.sh b/.github/workflows/phoenix/submit.sh index dd29d5ecaf..04d0f95de7 100644 --- a/.github/workflows/phoenix/submit.sh +++ b/.github/workflows/phoenix/submit.sh @@ -1,6 +1,6 @@ #!/bin/bash -set -es +set -e usage() { echo "Usage: $0 [script.sh] [cpu|gpu] [single|double]" } From 06cdb686b977c836cb63c5dbc61268df6ddffacd Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Mon, 18 Nov 2024 18:18:57 -0500 Subject: [PATCH 29/68] more fixes --- .github/workflows/phoenix/submit.sh | 60 ++++++++++++++++++----------- 1 file changed, 38 insertions(+), 22 deletions(-) diff --git a/.github/workflows/phoenix/submit.sh b/.github/workflows/phoenix/submit.sh index 04d0f95de7..6baffe679b 100644 --- a/.github/workflows/phoenix/submit.sh +++ b/.github/workflows/phoenix/submit.sh @@ -1,59 +1,75 @@ #!/bin/bash set -e + usage() { - echo "Usage: $0 [script.sh] [cpu|gpu] [single|double]" + echo "Usage: $0 [script.sh] [cpu|gpu]" } if [ ! -z "$1" ]; then - script_path="$1" + sbatch_script_contents=`cat $1` else usage exit 1 fi +sbatch_cpu_opts="\ +#SBATCH -p cpu-small # partition +#SBATCH --ntasks-per-node=24 # Number of cores per node required +#SBATCH --mem-per-cpu=2G # Memory per core\ +" + +sbatch_gpu_opts="\ +#SBATCH -CV100-16GB +#SBATCH -G2\ +" + if [ "$2" == "cpu" ]; then - sbatch_device_opts="#SBATCH -p cpu-small -#SBATCH --ntasks-per-node=24 -#SBATCH --mem-per-cpu=2G" + sbatch_device_opts="$sbatch_cpu_opts" elif [ "$2" == "gpu" ]; then - sbatch_device_opts="#SBATCH -C V100-16GB -#SBATCH -G2" + sbatch_device_opts="$sbatch_gpu_opts" else usage exit 1 fi -if [ "$3" != "single" ] && [ "$3" != "double" ]; then - usage - exit 1 +# Set default precision to 'double' if not provided + +if [ -z "$3" ]; then + precision="double" +else + if [ "$3" != "single" ] && [ "$3" != "double" ]; then + usage + exit 1 + fi + precision="$3" fi -job_device="$2" -job_precision="$3" -job_slug="$(basename "$1" | sed 's/\.sh$//' | sed 's/[^a-zA-Z0-9]/-/g')-$job_device-$job_precision" + +job_slug="`basename "$1" | sed 's/\.sh$//' | sed 's/[^a-zA-Z0-9]/-/g'`-$2-$precision" sbatch < Date: Thu, 21 Nov 2024 14:57:45 -0500 Subject: [PATCH 30/68] another small CI fix --- .github/workflows/phoenix/bench.sh | 2 -- 1 file changed, 2 deletions(-) diff --git a/.github/workflows/phoenix/bench.sh b/.github/workflows/phoenix/bench.sh index 1cdfb19be7..5d4cfa77c1 100644 --- a/.github/workflows/phoenix/bench.sh +++ b/.github/workflows/phoenix/bench.sh @@ -1,7 +1,5 @@ #!/bin/bash -job_device="${1}" -job_precision="${2}" if [ -z "$job_device" ] || [ -z "$job_precision" ]; then echo "Usage: $0 [cpu|gpu] [single|double]" From 60b0e5041713422deaf20478be4f5bc3be8e9bc8 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Sat, 23 Nov 2024 22:49:58 -0800 Subject: [PATCH 31/68] CI fix --- .github/workflows/bench.yml | 5 ++++ .github/workflows/phoenix/bench.sh | 2 ++ toolchain/mfc/bench.py | 46 ++++++++++++++---------------- 3 files changed, 29 insertions(+), 24 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index 40d5b9cd3a..da30070f26 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -52,6 +52,11 @@ jobs: (cd pr && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }} single) & wait %3 + - name: Generate & Post Comment + run: | + (cd pr && . ./mfc.sh load -c p -m g) + (cd pr && ./mfc.sh bench_diff ../master/bench-${{ matrix.device }}-double.yaml ../pr/bench-${{ matrix.device }}-double.yaml) + - name: Check PR Single vs Double Precision run: | # Compare single and double precision within the PR diff --git a/.github/workflows/phoenix/bench.sh b/.github/workflows/phoenix/bench.sh index 5d4cfa77c1..6d61bf7a48 100644 --- a/.github/workflows/phoenix/bench.sh +++ b/.github/workflows/phoenix/bench.sh @@ -26,5 +26,7 @@ if [ "$job_device" == "gpu" ]; then mem_value=12 fi +./mfc.sh clean +./mfc.sh build -j 8 -- $precision_flag ./mfc.sh bench --mem $mem_value -j $(nproc) -o "bench-${job_device}-${job_precision}.yaml" -- $precision_flag -c phoenix $device_opts -n $n_ranks diff --git a/toolchain/mfc/bench.py b/toolchain/mfc/bench.py index 5630fdf138..fb65df64ff 100644 --- a/toolchain/mfc/bench.py +++ b/toolchain/mfc/bench.py @@ -1,41 +1,30 @@ -import os, sys, uuid, subprocess, dataclasses, typing, math -import rich.table +import os, sys, uuid, subprocess, dataclasses, typing from .printer import cons from .state import ARG, CFG -from .build import get_targets, DEFAULT_TARGETS, SIMULATION +from .build import get_targets from .common import system, MFC_BENCH_FILEPATH, MFC_BUILD_DIR, format_list_to_string from .common import file_load_yaml, file_dump_yaml, create_directory from .common import MFCException -SINGLE_PRECISION_SPEEDUP_THRESHOLD = 1.25 # Minimum speedup for PR double vs single precision - @dataclasses.dataclass class BenchCase: slug: str path: str args: typing.List[str] -def bench(targets=None, precision="double"): - """ - Benchmarks the provided targets in the specified precision mode (single or double). - """ +def bench(targets=None): if targets is None: targets = ARG("targets") - if precision not in ["single", "double"]: - raise ValueError("Precision must be 'single' or 'double'.") + precision = "single" if ARG("single") else "double" - # Set precision_flag based on precision - if precision == "single": - precision_flag = ["--single"] - else: - precision_flag = [] # No flag needed for double precision + additional_args = ARG("--") targets = get_targets(targets) bench_dirpath = os.path.join(MFC_BUILD_DIR, "benchmarks", str(uuid.uuid4())[:4]) create_directory(bench_dirpath) - cons.print(f"[bold]Benchmarking {format_list_to_string(ARG('targets'), 'magenta')} in {precision} precision " + cons.print(f"[bold]Benchmarking {format_list_to_string(ARG('targets'), 'magenta')} in '{precision}' precision " f"([magenta]{os.path.relpath(bench_dirpath)}[/magenta]):[/bold]") cons.indent() cons.print() @@ -43,14 +32,16 @@ def bench(targets=None, precision="double"): CASES = [BenchCase(**case) for case in file_load_yaml(MFC_BENCH_FILEPATH)] for case in CASES: - case.args = case.args + ARG("--") + case.args = case.args + additional_args + if precision == "single": + case.args.append("--single") case.path = os.path.abspath(case.path) results = { "metadata": { "invocation": sys.argv[1:], "lock": dataclasses.asdict(CFG()), - "precision": precision, + "precision": precision }, "cases": {}, } @@ -65,12 +56,19 @@ def bench(targets=None, precision="double"): cons.print(f"> Summary: [bold]{os.path.relpath(summary_filepath)}[/bold]") with open(log_filepath, "w") as log_file: + command = [ + "./mfc.sh", "run", case.path, "--case-optimization", + "--targets" + ] + [t.name for t in targets] + [ + "--output-summary", summary_filepath + ] + case.args + + cons.print(f"Case precision: {precision}") + cons.print(f"Case args: {case.args}") + cons.print(f"Running command: {' '.join(command)}") + system( - ["./mfc.sh", "run", case.path, "--case-optimization"] + - ["--targets"] + [t.name for t in targets] + - ["--output-summary", summary_filepath] + - case.args + - precision_flag, # Use the precision_flag here + command, stdout=log_file, stderr=subprocess.STDOUT ) From e11da224bf29ff27a76ec87e45350b813f328dfa Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Sun, 24 Nov 2024 14:36:19 -0800 Subject: [PATCH 32/68] CI fix --- .github/workflows/bench.yml | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index da30070f26..b325b1c33c 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -68,8 +68,11 @@ jobs: uses: actions/upload-artifact@v4 if: always() with: - name: logs-${{ matrix.device }} - path: | - pr/bench-${{ matrix.device }}.* - master/bench-${{ matrix.device }}.* + name: logs-${{ matrix.device }} + path: | + pr/bench-${{ matrix.device }}-*.* + pr/build/benchmarks/* + master/bench-${{ matrix.device }}-*.* + master/build/benchmarks/* + From 2b2702ead894ef018b1f4a38f5c015567277663a Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Sun, 24 Nov 2024 22:17:56 -0800 Subject: [PATCH 33/68] revert CI changes --- .github/workflows/bench.yml | 38 +++---- .github/workflows/phoenix/bench.sh | 31 ++---- .github/workflows/phoenix/submit.sh | 17 +-- toolchain/mfc/bench.py | 160 +++++++++++++++------------- 4 files changed, 110 insertions(+), 136 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index b325b1c33c..227ff26d12 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -11,6 +11,7 @@ jobs: steps: - name: Clone uses: actions/checkout@v4 + - name: Detect Changes uses: dorny/paths-filter@v3 id: changes @@ -25,7 +26,7 @@ jobs: matrix: device: ['cpu', 'gpu'] runs-on: - group: phoenix + group: phoenix labels: gt timeout-minutes: 1400 env: @@ -36,6 +37,7 @@ jobs: uses: actions/checkout@v4 with: path: pr + - name: Clone - Master uses: actions/checkout@v4 with: @@ -43,36 +45,24 @@ jobs: ref: master path: master - - name: Bench (Master vs PR) + - name: Bench (Master v. PR) run: | - (cd pr && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }} double) & - (cd master && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }} double) & + (cd pr && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }}) & + (cd master && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }}) & wait %1 && wait %2 - (cd pr && bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/bench.sh ${{ matrix.device }} single) & - wait %3 - - name: Generate & Post Comment run: | (cd pr && . ./mfc.sh load -c p -m g) - (cd pr && ./mfc.sh bench_diff ../master/bench-${{ matrix.device }}-double.yaml ../pr/bench-${{ matrix.device }}-double.yaml) - - - name: Check PR Single vs Double Precision - run: | - # Compare single and double precision within the PR - cd pr - . ./mfc.sh load -c p -m ${{ matrix.device }} - ./mfc.sh bench_diff bench-${{ matrix.device }}-double.yaml bench-${{ matrix.device }}-single.yaml + (cd pr && ./mfc.sh bench_diff ../master/bench-${{ matrix.device }}.yaml ../pr/bench-${{ matrix.device }}.yaml) - name: Archive Logs uses: actions/upload-artifact@v4 - if: always() + if: always() with: - name: logs-${{ matrix.device }} - path: | - pr/bench-${{ matrix.device }}-*.* - pr/build/benchmarks/* - master/bench-${{ matrix.device }}-*.* - master/build/benchmarks/* - - + name: logs-${{ matrix.device }} + path: | + pr/bench-${{ matrix.device }}.* + pr/build/benchmarks/* + master/bench-${{ matrix.device }}.* + master/build/benchmarks/* \ No newline at end of file diff --git a/.github/workflows/phoenix/bench.sh b/.github/workflows/phoenix/bench.sh index 6d61bf7a48..8b8499eb0c 100644 --- a/.github/workflows/phoenix/bench.sh +++ b/.github/workflows/phoenix/bench.sh @@ -1,32 +1,15 @@ #!/bin/bash - -if [ -z "$job_device" ] || [ -z "$job_precision" ]; then - echo "Usage: $0 [cpu|gpu] [single|double]" - exit 1 -fi - n_ranks=12 -precision_flag="" - -if [ "$job_precision" == "single" ]; then - precision_flag="--single" -fi if [ "$job_device" == "gpu" ]; then - n_ranks=$(nvidia-smi -L | wc -l) - gpu_ids=$(seq -s ' ' 0 $(($n_ranks-1))) + n_ranks=$(nvidia-smi -L | wc -l) # number of GPUs on node + gpu_ids=$(seq -s ' ' 0 $(($n_ranks-1))) # 0,1,2,...,gpu_count-1 device_opts="--gpu -g $gpu_ids" -else - device_opts="" fi -mem_value=1 -if [ "$job_device" == "gpu" ]; then - mem_value=12 -fi - -./mfc.sh clean -./mfc.sh build -j 8 -- $precision_flag -./mfc.sh bench --mem $mem_value -j $(nproc) -o "bench-${job_device}-${job_precision}.yaml" -- $precision_flag -c phoenix $device_opts -n $n_ranks - +if ["$job_device" == "gpu"]; then + ./mfc.sh bench --mem 12 -j $(nproc) -o "$job_slug.yaml" -- -c phoenix $device_opts -n $n_ranks +else + ./mfc.sh bench --mem 1 -j $(nproc) -o "$job_slug.yaml" -- -c phoenix $device_opts -n $n_ranks +fi \ No newline at end of file diff --git a/.github/workflows/phoenix/submit.sh b/.github/workflows/phoenix/submit.sh index 6baffe679b..9e894abd07 100644 --- a/.github/workflows/phoenix/submit.sh +++ b/.github/workflows/phoenix/submit.sh @@ -33,20 +33,7 @@ else exit 1 fi -# Set default precision to 'double' if not provided - -if [ -z "$3" ]; then - precision="double" -else - if [ "$3" != "single" ] && [ "$3" != "double" ]; then - usage - exit 1 - fi - precision="$3" -fi - - -job_slug="`basename "$1" | sed 's/\.sh$//' | sed 's/[^a-zA-Z0-9]/-/g'`-$2-$precision" +job_slug="`basename "$1" | sed 's/\.sh$//' | sed 's/[^a-zA-Z0-9]/-/g'`-$2" sbatch < Log: [bold]{os.path.relpath(log_filepath)}[/bold]") cons.print(f"> Summary: [bold]{os.path.relpath(summary_filepath)}[/bold]") with open(log_filepath, "w") as log_file: - command = [ - "./mfc.sh", "run", case.path, "--case-optimization", - "--targets" - ] + [t.name for t in targets] + [ - "--output-summary", summary_filepath - ] + case.args - - cons.print(f"Case precision: {precision}") - cons.print(f"Case args: {case.args}") - cons.print(f"Running command: {' '.join(command)}") - system( - command, + ["./mfc.sh", "run", case.path, "--case-optimization"] + + ["--targets"] + [t.name for t in targets] + + ["--output-summary", summary_filepath] + + case.args + + ["--", "--gbpp", ARG('mem')], stdout=log_file, - stderr=subprocess.STDOUT - ) + stderr=subprocess.STDOUT) results["cases"][case.slug] = { - "description": dataclasses.asdict(case), + "description": dataclasses.asdict(case), "output_summary": file_load_yaml(summary_filepath), } - cons.unindent() file_dump_yaml(ARG("output"), results) + cons.print(f"Wrote results to [bold magenta]{os.path.relpath(ARG('output'))}[/bold magenta].") + cons.unindent() + +# TODO: This function is too long and not nicely written at all. Someone should +# refactor it... +# pylint: disable=too-many-branches def diff(): - """ - Compares the results between two benchmark YAML files (lhs vs rhs). - Checks both PR vs master and PR single vs PR double precision. - """ lhs, rhs = file_load_yaml(ARG("lhs")), file_load_yaml(ARG("rhs")) - lhs_precision = lhs["metadata"].get("precision", "double") - rhs_precision = rhs["metadata"].get("precision", "double") - - is_pr_single_vs_double = lhs_precision == "double" and rhs_precision == "single" - - cons.print(f"[bold]Comparing Benchmarks: Speedups from [magenta]{os.path.relpath(ARG('lhs'))}[/magenta] to " - f"[magenta]{os.path.relpath(ARG('rhs'))}[/magenta][/bold]") - - if lhs["metadata"] != rhs["metadata"] and not is_pr_single_vs_double: + cons.print(f"[bold]Comparing Benchmarks: Speedups from [magenta]{os.path.relpath(ARG('lhs'))}[/magenta] to [magenta]{os.path.relpath(ARG('rhs'))}[/magenta] are displayed below. Thus, numbers > 1 represent increases in performance.[/bold]") + if lhs["metadata"] != rhs["metadata"]: def _lock_to_str(lock): return ' '.join([f"{k}={v}" for k, v in lock.items()]) cons.print(f"""\ [bold yellow]Warning[/bold yellow]: Metadata in lhs and rhs are not equal. + This could mean that the benchmarks are not comparable (e.g. one was run on CPUs and the other on GPUs). lhs: * Invocation: [magenta]{' '.join(lhs['metadata']['invocation'])}[/magenta] * Modes: {_lock_to_str(lhs['metadata']['lock'])} - * Precision: {lhs_precision} rhs: * Invocation: {' '.join(rhs['metadata']['invocation'])} * Modes: [magenta]{_lock_to_str(rhs['metadata']['lock'])}[/magenta] - * Precision: {rhs_precision} """) slugs = set(lhs["cases"].keys()) & set(rhs["cases"].keys()) if len(slugs) not in [len(lhs["cases"]), len(rhs["cases"])]: cons.print(f"""\ [bold yellow]Warning[/bold yellow]: Cases in lhs and rhs are not equal. - Using intersection: {slugs} with {len(slugs)} elements.""") + * rhs cases: {', '.join(set(rhs['cases'].keys()) - slugs)}. + * lhs cases: {', '.join(set(lhs['cases'].keys()) - slugs)}. + Using intersection: {slugs} with {len(slugs)} elements. + """) table = rich.table.Table(show_header=True, box=rich.table.box.SIMPLE) - table.add_column("[bold]Case[/bold]", justify="left") - table.add_column("[bold]Speedup (Exec)[/bold]", justify="right") - table.add_column("[bold]Speedup (Grind)[/bold]", justify="right") + table.add_column("[bold]Case[/bold]", justify="left") + table.add_column("[bold]Pre Process[/bold]", justify="right") + table.add_column("[bold]Simulation[/bold]", justify="right") + table.add_column("[bold]Post Process[/bold]", justify="right") err = 0 @@ -131,26 +120,51 @@ def _lock_to_str(lock): lhs_summary = lhs["cases"][slug]["output_summary"] rhs_summary = rhs["cases"][slug]["output_summary"] - try: - exec_speedup = lhs_summary["exec"] / rhs_summary["exec"] - grind_speedup = lhs_summary["grind"] / rhs_summary["grind"] + speedups = ['N/A', 'N/A', 'N/A'] + + for i, target in enumerate(sorted(DEFAULT_TARGETS, key=lambda t: t.runOrder)): + if (target.name not in lhs_summary) or (target.name not in rhs_summary): - if is_pr_single_vs_double and exec_speedup < SINGLE_PRECISION_SPEEDUP_THRESHOLD: - cons.print(f"[bold red]Error[/bold red]: Case {slug} failed speedup requirement: " - f"Exec speedup {exec_speedup:.2f} < {SINGLE_PRECISION_SPEEDUP_THRESHOLD}.") err = 1 - table.add_row(slug, f"{exec_speedup:.2f}x", f"{grind_speedup:.2f}x") + if target.name not in lhs_summary: + cons.print(f"{target.name} not present in lhs_summary - Case: {slug}") - except KeyError as e: - table.add_row(slug, "Error", "Error") - cons.print(f"[bold yellow]Warning[/bold yellow]: Missing key {e} for case {slug}.") - except ZeroDivisionError: - table.add_row(slug, "Inf", "Inf") - cons.print(f"[bold yellow]Warning[/bold yellow]: Zero execution time in case {slug}.") + if target.name not in rhs_summary: + cons.print(f"{target.name} not present in rhs_summary - Case: {slug}") - cons.raw.print(table) + continue + + if not math.isfinite(lhs_summary[target.name]["exec"]) or not math.isfinite(rhs_summary[target.name]["exec"]): + err = 1 + cons.print(f"lhs_summary or rhs_summary reports non-real exec time for {target.name} - Case: {slug}") + + exec_time_speedup = "N/A" + try: + exec_time_speedup = f'{lhs_summary[target.name]["exec"] / rhs_summary[target.name]["exec"]:.2f}' + except Exception as _: + err = 1 + cons.print(f"lhs_summary or rhs_summary reports non-real exec time for {target.name} - Case: {slug}") + + speedups[i] = f"Exec: {exec_time_speedup}" + + if target == SIMULATION: + grind_time_speedup = "N/A" + if not math.isfinite(lhs_summary[target.name]["grind"]) or not math.isfinite(rhs_summary[target.name]["grind"]): + err = 1 + cons.print(f"lhs_summary or rhs_summary reports non-real grind time for {target.name} - Case: {slug}") + + try: + grind_time_speedup = f'{lhs_summary[target.name]["grind"] / rhs_summary[target.name]["grind"]:.2f}' + except Exception as _: + err = 1 + cons.print(f"lhs_summary or rhs_summary reports non-real grind time for {target.name} - Case: {slug}") - if err: - raise MFCException("Benchmarking failed: Some cases did not meet the performance requirements.") + speedups[i] += f" & Grind: {grind_time_speedup}" + + table.add_row(f"[magenta]{slug}[/magenta]", *speedups) + + cons.raw.print(table) + if err != 0: + raise MFCException("Benchmarking failed") From 973b084ad62617104c8272c0a64158298a8b107a Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Mon, 25 Nov 2024 09:44:24 -0800 Subject: [PATCH 34/68] Fix revert --- .github/workflows/bench.yml | 9 ++++----- .github/workflows/phoenix/bench.sh | 4 ++-- .github/workflows/phoenix/submit.sh | 2 +- toolchain/mfc/bench.py | 2 +- 4 files changed, 8 insertions(+), 9 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index 227ff26d12..c1b0a0a8f8 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -20,8 +20,7 @@ jobs: self: name: Georgia Tech | Phoenix (NVHPC) - if: github.repository == 'MFlowCode/MFC' && needs.file-changes.outputs.checkall == 'true' - needs: file-changes + if: github.repository == 'MFlowCode/MFC' strategy: matrix: device: ['cpu', 'gpu'] @@ -34,12 +33,12 @@ jobs: ACTIONS_ALLOW_USE_UNSECURE_NODE_VERSION: true steps: - name: Clone - PR - uses: actions/checkout@v4 + uses: actions/checkout@v3 with: path: pr - name: Clone - Master - uses: actions/checkout@v4 + uses: actions/checkout@v3 with: repository: MFlowCode/MFC ref: master @@ -57,7 +56,7 @@ jobs: (cd pr && ./mfc.sh bench_diff ../master/bench-${{ matrix.device }}.yaml ../pr/bench-${{ matrix.device }}.yaml) - name: Archive Logs - uses: actions/upload-artifact@v4 + uses: actions/upload-artifact@v3 if: always() with: name: logs-${{ matrix.device }} diff --git a/.github/workflows/phoenix/bench.sh b/.github/workflows/phoenix/bench.sh index 8b8499eb0c..a2ef778cd6 100644 --- a/.github/workflows/phoenix/bench.sh +++ b/.github/workflows/phoenix/bench.sh @@ -1,6 +1,6 @@ #!/bin/bash -n_ranks=12 +n_ranks=4 if [ "$job_device" == "gpu" ]; then n_ranks=$(nvidia-smi -L | wc -l) # number of GPUs on node @@ -9,7 +9,7 @@ if [ "$job_device" == "gpu" ]; then fi if ["$job_device" == "gpu"]; then - ./mfc.sh bench --mem 12 -j $(nproc) -o "$job_slug.yaml" -- -c phoenix $device_opts -n $n_ranks + ./mfc.sh bench --mem 8 -j $(nproc) -o "$job_slug.yaml" -- -c phoenix $device_opts -n $n_ranks else ./mfc.sh bench --mem 1 -j $(nproc) -o "$job_slug.yaml" -- -c phoenix $device_opts -n $n_ranks fi \ No newline at end of file diff --git a/.github/workflows/phoenix/submit.sh b/.github/workflows/phoenix/submit.sh index 9e894abd07..b9a70282e1 100644 --- a/.github/workflows/phoenix/submit.sh +++ b/.github/workflows/phoenix/submit.sh @@ -41,7 +41,7 @@ sbatch < Date: Mon, 25 Nov 2024 23:34:45 -0800 Subject: [PATCH 35/68] fix --- .github/workflows/bench.yml | 9 +++++---- .github/workflows/phoenix/bench.sh | 4 ++-- .github/workflows/phoenix/submit.sh | 2 +- toolchain/mfc/bench.py | 3 ++- 4 files changed, 10 insertions(+), 8 deletions(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index c1b0a0a8f8..227ff26d12 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -20,7 +20,8 @@ jobs: self: name: Georgia Tech | Phoenix (NVHPC) - if: github.repository == 'MFlowCode/MFC' + if: github.repository == 'MFlowCode/MFC' && needs.file-changes.outputs.checkall == 'true' + needs: file-changes strategy: matrix: device: ['cpu', 'gpu'] @@ -33,12 +34,12 @@ jobs: ACTIONS_ALLOW_USE_UNSECURE_NODE_VERSION: true steps: - name: Clone - PR - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: path: pr - name: Clone - Master - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: repository: MFlowCode/MFC ref: master @@ -56,7 +57,7 @@ jobs: (cd pr && ./mfc.sh bench_diff ../master/bench-${{ matrix.device }}.yaml ../pr/bench-${{ matrix.device }}.yaml) - name: Archive Logs - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 if: always() with: name: logs-${{ matrix.device }} diff --git a/.github/workflows/phoenix/bench.sh b/.github/workflows/phoenix/bench.sh index a2ef778cd6..8b8499eb0c 100644 --- a/.github/workflows/phoenix/bench.sh +++ b/.github/workflows/phoenix/bench.sh @@ -1,6 +1,6 @@ #!/bin/bash -n_ranks=4 +n_ranks=12 if [ "$job_device" == "gpu" ]; then n_ranks=$(nvidia-smi -L | wc -l) # number of GPUs on node @@ -9,7 +9,7 @@ if [ "$job_device" == "gpu" ]; then fi if ["$job_device" == "gpu"]; then - ./mfc.sh bench --mem 8 -j $(nproc) -o "$job_slug.yaml" -- -c phoenix $device_opts -n $n_ranks + ./mfc.sh bench --mem 12 -j $(nproc) -o "$job_slug.yaml" -- -c phoenix $device_opts -n $n_ranks else ./mfc.sh bench --mem 1 -j $(nproc) -o "$job_slug.yaml" -- -c phoenix $device_opts -n $n_ranks fi \ No newline at end of file diff --git a/.github/workflows/phoenix/submit.sh b/.github/workflows/phoenix/submit.sh index b9a70282e1..9e894abd07 100644 --- a/.github/workflows/phoenix/submit.sh +++ b/.github/workflows/phoenix/submit.sh @@ -41,7 +41,7 @@ sbatch < Date: Wed, 27 Nov 2024 10:56:28 -0800 Subject: [PATCH 36/68] fix --- src/common/m_helper_basic.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/common/m_helper_basic.f90 b/src/common/m_helper_basic.f90 index eaac4955d2..4de21c5289 100644 --- a/src/common/m_helper_basic.f90 +++ b/src/common/m_helper_basic.f90 @@ -49,7 +49,7 @@ end function f_approx_equal logical function f_is_default(var) result(res) real(wp), intent(in) :: var - res = f_approx_equal(var, real(dflt_real, wp)) + res = f_approx_equal(var, dflt_real) end function f_is_default !> Checks if ALL elements of a real(wp) array are of default value. From 54aea853a722fb81fb4d9b5179d6dd5bda470679 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Wed, 27 Nov 2024 13:01:54 -0800 Subject: [PATCH 37/68] fix --- misc/m_silo_proxy.f90 | 12 +-- src/common/m_constants.fpp | 10 +- src/common/m_derived_types.fpp | 5 +- src/common/m_helper_basic.f90 | 2 + src/pre_process/m_compute_levelset.fpp | 6 +- src/pre_process/m_model.fpp | 144 ++++++++++++------------- src/pre_process/m_mpi_proxy.fpp | 1 - src/pre_process/m_patches.fpp | 4 - src/simulation/m_cbc.fpp | 6 +- src/simulation/m_start_up.fpp | 2 +- src/syscheck/syscheck.fpp | 2 +- 11 files changed, 95 insertions(+), 99 deletions(-) diff --git a/misc/m_silo_proxy.f90 b/misc/m_silo_proxy.f90 index 2f3ca4d8f1..c2e57d542c 100755 --- a/misc/m_silo_proxy.f90 +++ b/misc/m_silo_proxy.f90 @@ -189,9 +189,9 @@ function DBPUTQM(dbid, name, lname, xname, lxname, yname, lyname, & !! - integer, intent(IN) :: lyname character(LEN=*), intent(IN) :: zname integer, intent(IN) :: lzname - real(kind(0d0)), dimension(:), intent(IN) :: x - real(kind(0d0)), dimension(:), intent(IN) :: y - real(kind(0d0)), dimension(:), intent(IN) :: z + real(wp), dimension(:), intent(IN) :: x + real(wp), dimension(:), intent(IN) :: y + real(wp), dimension(:), intent(IN) :: z integer, dimension(:), intent(IN) :: dims integer, intent(IN) :: ndims integer, intent(IN) :: datatype @@ -215,8 +215,8 @@ function DBPUTCURVE(dbid, curvename, lcurvename, xvals, yvals, & !! ---- integer, intent(IN) :: dbid character(LEN=*), intent(IN) :: curvename integer, intent(IN) :: lcurvename - real(kind(0d0)), dimension(:), intent(IN) :: xvals - real(kind(0d0)), dimension(:), intent(IN) :: yvals + real(wp), dimension(:), intent(IN) :: xvals + real(wp), dimension(:), intent(IN) :: yvals integer, intent(IN) :: datatype integer, intent(IN) :: npoints integer, intent(IN) :: optlist_id @@ -264,7 +264,7 @@ function DBPUTQV1(dbid, name, lname, meshname, lmeshname, var, & !! ---- integer, intent(IN) :: lname character(LEN=*), intent(IN) :: meshname integer, intent(IN) :: lmeshname - real(kind(0d0)), dimension(:, :, :), intent(IN) :: var + real(wp), dimension(:, :, :), intent(IN) :: var integer, dimension(:), intent(IN) :: dims integer, intent(IN) :: ndims integer, intent(IN) :: mixvar diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp index a32095d093..51895219bc 100644 --- a/src/common/m_constants.fpp +++ b/src/common/m_constants.fpp @@ -35,10 +35,10 @@ module m_constants integer, parameter :: Ifactor_3D = 5 !< Multiple factor of the ratio (edge to cell width) for interpolation along edges for 3D models integer, parameter :: Ifactor_bary_3D = 20 !< Multiple factor of the ratio (triangle area to cell face area) for interpolation on triangle facets for 3D models integer, parameter :: num_ray = 20 !< Default number of rays traced per cell - real(kind(0d0)), parameter :: ray_tracing_threshold = 0.9d0 !< Threshold above which the cell is marked as the model patch - real(kind(0d0)), parameter :: threshold_vector_zero = 1d-10 !< Threshold to treat the component of a vector to be zero - real(kind(0d0)), parameter :: threshold_edge_zero = 1d-10 !< Threshold to treat two edges to be overlapped - real(kind(0d0)), parameter :: threshold_bary = 1d-1 !< Threshold to interpolate a barycentric facet - real(kind(0d0)), parameter :: initial_distance_buffer = 1d12 !< Initialized levelset distance for the shortest path pair algorithm + real(wp), parameter :: ray_tracing_threshold = 0.9d0 !< Threshold above which the cell is marked as the model patch + real(wp), parameter :: threshold_vector_zero = 1d-10 !< Threshold to treat the component of a vector to be zero + real(wp), parameter :: threshold_edge_zero = 1d-10 !< Threshold to treat two edges to be overlapped + real(wp), parameter :: threshold_bary = 1d-1 !< Threshold to interpolate a barycentric facet + real(wp), parameter :: initial_distance_buffer = 1d12 !< Initialized levelset distance for the shortest path pair algorithm end module m_constants diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index 84f419b21b..f9381af013 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -168,7 +168,6 @@ module m_derived_types !! patch geometries. It is specified through its x-, y-, and z-components !! respectively. - real(wp) :: epsilon, beta !< !! The spherical harmonics eccentricity parameters. @@ -239,7 +238,7 @@ module m_derived_types integer :: model_spc !< !! Number of samples per cell to use when discretizing the STL object. - real(kind(0d0)) :: model_threshold !< + real(wp) :: model_threshold !< !! Threshold to turn on smoothen STL patch. end type ic_patch_parameters @@ -277,7 +276,7 @@ module m_derived_types integer :: model_spc !< !! Number of samples per cell to use when discretizing the STL object. - real(kind(0d0)) :: model_threshold !< + real(wp) :: model_threshold !< !! Threshold to turn on smoothen STL patch. end type ib_patch_parameters diff --git a/src/common/m_helper_basic.f90 b/src/common/m_helper_basic.f90 index 4de21c5289..cd19156571 100644 --- a/src/common/m_helper_basic.f90 +++ b/src/common/m_helper_basic.f90 @@ -25,6 +25,7 @@ module m_helper_basic !! @param tol_input Relative error (default = 1e-6_wp). !! @return Result of the comparison. logical function f_approx_equal(a, b, tol_input) result(res) + !$acc routine seq real(wp), intent(in) :: a, b real(wp), optional, intent(in) :: tol_input real(wp) :: tol @@ -47,6 +48,7 @@ end function f_approx_equal !> Checks if a real(wp) variable is of default value. !! @param var Variable to check. logical function f_is_default(var) result(res) + !$acc routine seq real(wp), intent(in) :: var res = f_approx_equal(var, dflt_real) diff --git a/src/pre_process/m_compute_levelset.fpp b/src/pre_process/m_compute_levelset.fpp index 8978ac72df..408d58429f 100644 --- a/src/pre_process/m_compute_levelset.fpp +++ b/src/pre_process/m_compute_levelset.fpp @@ -360,9 +360,9 @@ contains type(levelset_norm_field), intent(INOUT) :: levelset_norm integer, intent(IN) :: ib_patch_id - real(kind(0d0)) :: Right, Left, Bottom, Top, Front, Back - real(kind(0d0)) :: x, y, z, min_dist - real(kind(0d0)) :: side_dists(6) + real(wp) :: Right, Left, Bottom, Top, Front, Back + real(wp) :: x, y, z, min_dist + real(wp) :: side_dists(6) integer :: i, j, k !< Loop index variables diff --git a/src/pre_process/m_model.fpp b/src/pre_process/m_model.fpp index 0d9ca9d596..9305c11f04 100644 --- a/src/pre_process/m_model.fpp +++ b/src/pre_process/m_model.fpp @@ -594,16 +594,16 @@ contains !! @param boundary_edge_count Output total boundary edge counts subroutine f_check_boundary(model, boundary_v, boundary_vertex_count, boundary_edge_count) type(t_model), intent(in) :: model - real(kind(0d0)), allocatable, intent(out), dimension(:, :, :) :: boundary_v !< Output boundary vertices/normals + real(wp), allocatable, intent(out), dimension(:, :, :) :: boundary_v !< Output boundary vertices/normals integer, intent(out) :: boundary_vertex_count, boundary_edge_count !< Output boundary vertex/edge count integer :: i, j !< Model index iterator integer :: edge_count, edge_index, store_index !< Boundary edge index iterator - real(kind(0d0)), dimension(1:2, 1:2) :: edge !< Edge end points buffer - real(kind(0d0)), dimension(1:2) :: boundary_edge !< Boundary edge end points buffer - real(kind(0d0)), dimension(1:(3*model%ntrs), 1:2, 1:2) :: temp_boundary_v !< Temporary boundary vertex buffer + real(wp), dimension(1:2, 1:2) :: edge !< Edge end points buffer + real(wp), dimension(1:2) :: boundary_edge !< Boundary edge end points buffer + real(wp), dimension(1:(3*model%ntrs), 1:2, 1:2) :: temp_boundary_v !< Temporary boundary vertex buffer integer, dimension(1:(3*model%ntrs)) :: edge_occurrence !< The manifoldness of the edges - real(kind(0d0)) :: edgetan, initial, v_norm, xnormal, ynormal !< The manifoldness of the edges + real(wp) :: edgetan, initial, v_norm, xnormal, ynormal !< The manifoldness of the edges ! Total number of edges in 2D STL edge_count = 3*model%ntrs @@ -693,7 +693,7 @@ contains xnormal = initial end if - v_norm = dsqrt(xnormal**2 + ynormal**2) + v_norm = sqrt(xnormal**2 + ynormal**2) boundary_v(i, 3, 1) = xnormal/v_norm boundary_v(i, 3, 2) = ynormal/v_norm end do @@ -708,8 +708,8 @@ contains subroutine f_register_edge(temp_boundary_v, edge, edge_index, edge_count) integer, intent(inout) :: edge_index !< Edge index iterator integer, intent(inout) :: edge_count !< Total number of edges - real(kind(0d0)), intent(in), dimension(1:2, 1:2) :: edge !< Edges end points to be registered - real(kind(0d0)), dimension(1:edge_count, 1:2, 1:2) :: temp_boundary_v !< Temporary edge end vertex buffer + real(wp), intent(in), dimension(1:2, 1:2) :: edge !< Edges end points to be registered + real(wp), dimension(1:edge_count, 1:2, 1:2) :: temp_boundary_v !< Temporary edge end vertex buffer ! Increment edge index and store the edge edge_index = edge_index + 1 @@ -726,10 +726,10 @@ contains subroutine f_check_interpolation_2D(boundary_v, boundary_edge_count, spacing, interpolate) logical, intent(inout) :: interpolate !< Logical indicator of interpolation integer, intent(in) :: boundary_edge_count !< Number of boundary edges - real(kind(0d0)), intent(in), dimension(1:boundary_edge_count, 1:3, 1:2) :: boundary_v + real(wp), intent(in), dimension(1:boundary_edge_count, 1:3, 1:2) :: boundary_v t_vec3, intent(in) :: spacing - real(kind(0d0)) :: l1, cell_width !< Length of each boundary edge and cell width + real(wp) :: l1, cell_width !< Length of each boundary edge and cell width integer :: j !< Boundary edge index iterator cell_width = minval(spacing(1:2)) @@ -737,8 +737,8 @@ contains do j = 1, boundary_edge_count - l1 = dsqrt((boundary_v(j, 2, 1) - boundary_v(j, 1, 1))**2 + & - (boundary_v(j, 2, 2) - boundary_v(j, 1, 2))**2) + l1 = sqrt((boundary_v(j, 2, 1) - boundary_v(j, 1, 1))**2 + & + (boundary_v(j, 2, 2) - boundary_v(j, 1, 2))**2) if ((l1 > cell_width)) then interpolate = .true. @@ -758,8 +758,8 @@ contains type(t_model), intent(in) :: model t_vec3, intent(in) :: spacing t_vec3 :: edge_l - real(kind(0d0)) :: cell_width - real(kind(0d0)), dimension(1:3, 1:3) :: tri_v + real(wp) :: cell_width + real(wp), dimension(1:3, 1:3) :: tri_v integer :: i, j !< Loop iterator cell_width = minval(spacing) @@ -772,15 +772,15 @@ contains tri_v(3, j) = model%trs(i)%v(3, j) end do - edge_l(1) = dsqrt((tri_v(1, 2) - tri_v(1, 1))**2 + & - (tri_v(2, 2) - tri_v(2, 1))**2 + & - (tri_v(3, 2) - tri_v(3, 1))**2) - edge_l(2) = dsqrt((tri_v(1, 3) - tri_v(1, 2))**2 + & - (tri_v(2, 3) - tri_v(2, 2))**2 + & - (tri_v(3, 3) - tri_v(3, 2))**2) - edge_l(3) = dsqrt((tri_v(1, 1) - tri_v(1, 3))**2 + & - (tri_v(2, 1) - tri_v(2, 3))**2 + & - (tri_v(3, 1) - tri_v(3, 3))**2) + edge_l(1) = sqrt((tri_v(1, 2) - tri_v(1, 1))**2 + & + (tri_v(2, 2) - tri_v(2, 1))**2 + & + (tri_v(3, 2) - tri_v(3, 1))**2) + edge_l(2) = sqrt((tri_v(1, 3) - tri_v(1, 2))**2 + & + (tri_v(2, 3) - tri_v(2, 2))**2 + & + (tri_v(3, 3) - tri_v(3, 2))**2) + edge_l(3) = sqrt((tri_v(1, 1) - tri_v(1, 3))**2 + & + (tri_v(2, 1) - tri_v(2, 3))**2 + & + (tri_v(3, 1) - tri_v(3, 3))**2) if ((edge_l(1) > cell_width) .or. & (edge_l(2) > cell_width) .or. & @@ -800,14 +800,14 @@ contains !! @param interpolated_boundary_v Output all the boundary vertices of the interpolated 2D model !! @param total_vertices Total number of vertices after interpolation subroutine f_interpolate_2D(boundary_v, boundary_edge_count, spacing, interpolated_boundary_v, total_vertices) - real(kind(0d0)), intent(in), dimension(:, :, :) :: boundary_v + real(wp), intent(in), dimension(:, :, :) :: boundary_v t_vec3, intent(in) :: spacing - real(kind(0d0)), allocatable, intent(inout), dimension(:, :) :: interpolated_boundary_v + real(wp), allocatable, intent(inout), dimension(:, :) :: interpolated_boundary_v integer :: i, j, num_segments, total_vertices, boundary_edge_count - real(kind(0d0)) :: edge_length, cell_width - real(kind(0d0)), dimension(1:2) :: edge_x, edge_y, edge_del - real(kind(0d0)), allocatable :: temp_boundary_v(:, :) + real(wp) :: edge_length, cell_width + real(wp), dimension(1:2) :: edge_x, edge_y, edge_del + real(wp), allocatable :: temp_boundary_v(:, :) ! Get the number of boundary edges cell_width = minval(spacing(1:2)) @@ -823,8 +823,8 @@ contains edge_y(2) = boundary_v(i, 2, 2) ! Compute the length of the edge - edge_length = dsqrt((edge_x(2) - edge_x(1))**2 + & - (edge_y(2) - edge_y(1))**2) + edge_length = sqrt((edge_x(2) - edge_x(1))**2 + & + (edge_y(2) - edge_y(1))**2) ! Determine the number of segments if (edge_length > cell_width) then @@ -850,8 +850,8 @@ contains edge_y(2) = boundary_v(i, 2, 2) ! Compute the length of the edge - edge_length = dsqrt((edge_x(2) - edge_x(1))**2 + & - (edge_y(2) - edge_y(1))**2) + edge_length = sqrt((edge_x(2) - edge_x(1))**2 + & + (edge_y(2) - edge_y(1))**2) ! Determine the number of segments and interpolation step if (edge_length > cell_width) then @@ -893,15 +893,15 @@ contains subroutine f_interpolate_3D(model, spacing, interpolated_boundary_v, total_vertices) t_vec3, intent(in) :: spacing type(t_model), intent(in) :: model - real(kind(0d0)), allocatable, intent(inout), dimension(:, :) :: interpolated_boundary_v + real(wp), allocatable, intent(inout), dimension(:, :) :: interpolated_boundary_v integer, intent(out) :: total_vertices integer :: i, j, k, num_triangles, num_segments, num_inner_vertices - real(kind(0d0)), dimension(1:3, 1:3) :: tri + real(wp), dimension(1:3, 1:3) :: tri t_vec3 :: edge_del, cell_area t_vec3 :: bary_coord !< Barycentric coordinates - real(kind(0d0)) :: edge_length, cell_width, cell_area_min, tri_area - real(kind(0d0)), allocatable :: temp_boundary_v(:, :) + real(wp) :: edge_length, cell_width, cell_area_min, tri_area + real(wp), allocatable :: temp_boundary_v(:, :) ! Number of triangles in the model num_triangles = model%ntrs @@ -928,9 +928,9 @@ contains tri(2, 3) = model%trs(i)%v(mod(j, 3) + 1, 3) ! Compute the length of the edge - edge_length = dsqrt((tri(2, 1) - tri(1, 1))**2 + & - (tri(2, 2) - tri(1, 2))**2 + & - (tri(2, 3) - tri(1, 3))**2) + edge_length = sqrt((tri(2, 1) - tri(1, 1))**2 + & + (tri(2, 2) - tri(1, 2))**2 + & + (tri(2, 3) - tri(1, 3))**2) ! Determine the number of segments if (edge_length > cell_width) then @@ -975,9 +975,9 @@ contains tri(2, 3) = model%trs(i)%v(mod(j, 3) + 1, 3) ! Compute the length of the edge - edge_length = dsqrt((tri(2, 1) - tri(1, 1))**2 + & - (tri(2, 2) - tri(1, 2))**2 + & - (tri(2, 3) - tri(1, 3))**2) + edge_length = sqrt((tri(2, 1) - tri(1, 1))**2 + & + (tri(2, 2) - tri(1, 2))**2 + & + (tri(2, 3) - tri(1, 3))**2) ! Determine the number of segments and interpolation step if (edge_length > cell_width) then @@ -1045,12 +1045,12 @@ contains type(t_model), intent(IN) :: model t_vec3, intent(in) :: point t_vec3, intent(out) :: normals - real(kind(0d0)), intent(out) :: distance + real(wp), intent(out) :: distance - real(kind(0d0)), dimension(1:model%ntrs, 1:3) :: tri_normals - real(kind(0d0)), dimension(1:3, 1:3) :: tri - real(kind(0d0)) :: dist_min, dist_t_min - real(kind(0d0)) :: dist_min_normal, dist_buffer_normal + real(wp), dimension(1:model%ntrs, 1:3) :: tri_normals + real(wp), dimension(1:3, 1:3) :: tri + real(wp) :: dist_min, dist_t_min + real(wp) :: dist_min_normal, dist_buffer_normal t_vec3 :: midp !< Centers of the triangle facets t_vec3 :: dist_buffer !< Distance between the cell center and the vertices integer :: i, j, tri_idx !< Iterator @@ -1065,9 +1065,9 @@ contains tri(j, 1) = model%trs(i)%v(j, 1) tri(j, 2) = model%trs(i)%v(j, 2) tri(j, 3) = model%trs(i)%v(j, 3) - dist_buffer(j) = dsqrt((point(1) - tri(j, 1))**2 + & - (point(2) - tri(j, 2))**2 + & - (point(3) - tri(j, 3))**2) + dist_buffer(j) = sqrt((point(1) - tri(j, 1))**2 + & + (point(2) - tri(j, 2))**2 + & + (point(3) - tri(j, 3))**2) end do ! Get the surface center of each triangle facet @@ -1076,9 +1076,9 @@ contains end do dist_t_min = minval(dist_buffer(1:3)) - dist_buffer_normal = dsqrt((point(1) - midp(1))**2 + & - (point(2) - midp(2))**2 + & - (point(3) - midp(3))**2) + dist_buffer_normal = sqrt((point(1) - midp(1))**2 + & + (point(2) - midp(2))**2 + & + (point(3) - midp(3))**2) if (dist_t_min < dist_min) then dist_min = dist_t_min @@ -1106,21 +1106,21 @@ contains !! @return Distance which the levelset distance without interpolation function f_distance(boundary_v, boundary_vertex_count, boundary_edge_count, point, spacing) result(distance) integer, intent(in) :: boundary_vertex_count, boundary_edge_count - real(kind(0d0)), intent(in), dimension(1:boundary_edge_count, 1:3, 1:2) :: boundary_v + real(wp), intent(in), dimension(1:boundary_edge_count, 1:3, 1:2) :: boundary_v t_vec3, intent(in) :: point t_vec3, intent(in) :: spacing integer :: i - real(kind(0d0)) :: dist_buffer1, dist_buffer2 - real(kind(0d0)), dimension(1:boundary_edge_count) :: dist_buffer - real(kind(0d0)) :: distance + real(wp) :: dist_buffer1, dist_buffer2 + real(wp), dimension(1:boundary_edge_count) :: dist_buffer + real(wp) :: distance distance = 0d0 do i = 1, boundary_edge_count - dist_buffer1 = dsqrt((point(1) - boundary_v(i, 1, 1))**2 + & + dist_buffer1 = sqrt((point(1) - boundary_v(i, 1, 1))**2 + & & (point(2) - boundary_v(i, 1, 2))**2) - dist_buffer2 = dsqrt((point(1) - boundary_v(i, 2, 1))**2 + & + dist_buffer2 = sqrt((point(1) - boundary_v(i, 2, 1))**2 + & & (point(2) - boundary_v(i, 2, 2))**2) dist_buffer(i) = minval((/dist_buffer1, dist_buffer2/)) @@ -1139,14 +1139,14 @@ contains !! @param normals Output levelset normals without interpolation subroutine f_normals(boundary_v, boundary_vertex_count, boundary_edge_count, point, spacing, normals) integer, intent(in) :: boundary_vertex_count, boundary_edge_count - real(kind(0d0)), intent(in), dimension(1:boundary_edge_count, 1:3, 1:2) :: boundary_v + real(wp), intent(in), dimension(1:boundary_edge_count, 1:3, 1:2) :: boundary_v t_vec3, intent(in) :: point t_vec3, intent(in) :: spacing t_vec3, intent(out) :: normals integer :: i, idx_buffer - real(kind(0d0)) :: dist_min, dist_buffer - real(kind(0d0)) :: midp(1:3) + real(wp) :: dist_min, dist_buffer + real(wp) :: midp(1:3) dist_buffer = 0d0 dist_min = initial_distance_buffer @@ -1157,7 +1157,7 @@ contains midp(2) = (boundary_v(i, 2, 2) + boundary_v(i, 1, 2))/2 midp(3) = 0d0 - dist_buffer = dsqrt((point(1) - midp(1))**2 + & + dist_buffer = sqrt((point(1) - midp(1))**2 + & & (point(2) - midp(2))**2) if (dist_buffer < dist_min) then @@ -1180,22 +1180,22 @@ contains !! @return Distance which the levelset distance without interpolation function f_interpolated_distance(interpolated_boundary_v, total_vertices, point, spacing) result(distance) integer, intent(in) :: total_vertices - real(kind(0d0)), intent(in), dimension(1:total_vertices, 1:3) :: interpolated_boundary_v + real(wp), intent(in), dimension(1:total_vertices, 1:3) :: interpolated_boundary_v t_vec3, intent(in) :: point t_vec3, intent(in) :: spacing integer :: i !< Loop iterator - real(kind(0d0)) :: dist_buffer, min_dist - real(kind(0d0)) :: distance + real(wp) :: dist_buffer, min_dist + real(wp) :: distance distance = initial_distance_buffer dist_buffer = initial_distance_buffer min_dist = initial_distance_buffer do i = 1, total_vertices - dist_buffer = dsqrt((point(1) - interpolated_boundary_v(i, 1))**2 + & - (point(2) - interpolated_boundary_v(i, 2))**2 + & - (point(3) - interpolated_boundary_v(i, 3))**2) + dist_buffer = sqrt((point(1) - interpolated_boundary_v(i, 1))**2 + & + (point(2) - interpolated_boundary_v(i, 2))**2 + & + (point(3) - interpolated_boundary_v(i, 3))**2) if (min_dist > dist_buffer) then min_dist = dist_buffer @@ -1208,9 +1208,9 @@ contains !> This procedure calculates the barycentric facet area function f_tri_area(tri) result(tri_area) - real(kind(0d0)), dimension(1:3, 1:3), intent(in) :: tri + real(wp), dimension(1:3, 1:3), intent(in) :: tri t_vec3 :: AB, AC, cross - real(kind(0d0)) :: tri_area + real(wp) :: tri_area integer :: i !< Loop iterator do i = 1, 3 @@ -1221,7 +1221,7 @@ contains cross(1) = AB(2)*AC(3) - AB(3)*AC(2) cross(2) = AB(3)*AC(1) - AB(1)*AC(3) cross(3) = AB(1)*AC(2) - AB(2)*AC(1) - tri_area = 0.5d0*dsqrt(cross(1)**2 + cross(2)**2 + cross(3)**2) + tri_area = 0.5d0*sqrt(cross(1)**2 + cross(2)**2 + cross(3)**2) end function f_tri_area diff --git a/src/pre_process/m_mpi_proxy.fpp b/src/pre_process/m_mpi_proxy.fpp index ae8c95e01a..4673d34247 100644 --- a/src/pre_process/m_mpi_proxy.fpp +++ b/src/pre_process/m_mpi_proxy.fpp @@ -84,7 +84,6 @@ contains & 'length_x', 'length_y', 'length_z', 'radius', 'epsilon', & & 'beta', 'smooth_coeff', 'rho', 'p0', 'm0', 'r0', 'v0', & & 'pres', 'gamma', 'pi_inf', 'hcid', 'cv', 'qv', 'qvp', & - & 'model_threshold', 'cf_val'] call MPI_BCAST(patch_icpp(i)%${VAR}$, 1, mpi_p, 0, MPI_COMM_WORLD, ierr) #:endfor diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index 290af25aba..8e7e577175 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -968,7 +968,6 @@ contains @:analytical() - if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == 4)) then !zero density, reassign according to Tait EOS q_prim_vf(1)%sf(i, j, 0) = & @@ -1707,7 +1706,6 @@ contains call s_assign_patch_primitive_variables(patch_id, i, j, k, & eta, q_prim_vf, patch_id_fp) - @:analytical() ! Updating the patch identities bookkeeping variable @@ -1796,7 +1794,6 @@ contains cart_z = z_cc(k) end if - if ((.not. f_is_default(length_x) .and. & (cart_y - y_centroid)**2 & + (cart_z - z_centroid)**2 <= radius**2 .and. & @@ -1831,7 +1828,6 @@ contains if (1._wp - eta < 1e-16_wp) patch_id_fp(i, j, k) = patch_id end if - if (patch_icpp(patch_id)%smoothen) then if (.not. f_is_default(length_x)) then eta = tanh(smooth_coeff/min(dy, dz)* & diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index e5dc855738..85efd61686 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -106,9 +106,9 @@ module m_cbc !! inflow velocities, pressure, density and void fraction as well as !! outflow velocities and pressure - real(kind(0d0)), allocatable, dimension(:) :: pres_in, pres_out, Del_in, Del_out - real(kind(0d0)), allocatable, dimension(:, :) :: vel_in, vel_out - real(kind(0d0)), allocatable, dimension(:, :) :: alpha_rho_in, alpha_in + real(wp), allocatable, dimension(:) :: pres_in, pres_out, Del_in, Del_out + real(wp), allocatable, dimension(:, :) :: vel_in, vel_out + real(wp), allocatable, dimension(:, :) :: alpha_rho_in, alpha_in !$acc declare create(pres_in, pres_out, Del_in, Del_out) !$acc declare create(vel_in, vel_out) !$acc declare create(alpha_rho_in, alpha_in) diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 47d9db15aa..d2de693ec8 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -97,7 +97,7 @@ module m_start_up type(scalar_field), allocatable, dimension(:) :: grad_x_vf, grad_y_vf, grad_z_vf, norm_vf - real(kind(0d0)) :: dt_init + real(wp) :: dt_init contains diff --git a/src/syscheck/syscheck.fpp b/src/syscheck/syscheck.fpp index de613a6f8d..7fdb3cf1e7 100644 --- a/src/syscheck/syscheck.fpp +++ b/src/syscheck/syscheck.fpp @@ -53,7 +53,7 @@ program syscheck @:ACC(integer(acc_device_kind) :: devtype) @:ACC(integer :: i, num_devices) - @:ACC(real(kind(0d0)), allocatable, dimension(:) :: arr) + @:ACC(real(wp), allocatable, dimension(:) :: arr) @:ACC(integer, parameter :: N = 100) @:MPIC(call mpi_init(ierr)) From b82e704825f8cc3470fc8fa21b950212751871b4 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Wed, 27 Nov 2024 14:28:40 -0800 Subject: [PATCH 38/68] fix --- src/syscheck/syscheck.fpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/syscheck/syscheck.fpp b/src/syscheck/syscheck.fpp index 7fdb3cf1e7..de613a6f8d 100644 --- a/src/syscheck/syscheck.fpp +++ b/src/syscheck/syscheck.fpp @@ -53,7 +53,7 @@ program syscheck @:ACC(integer(acc_device_kind) :: devtype) @:ACC(integer :: i, num_devices) - @:ACC(real(wp), allocatable, dimension(:) :: arr) + @:ACC(real(kind(0d0)), allocatable, dimension(:) :: arr) @:ACC(integer, parameter :: N = 100) @:MPIC(call mpi_init(ierr)) From 2bcc8e0e8c10c1d164124398243b0a6a7db38e71 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Thu, 28 Nov 2024 12:42:41 -0800 Subject: [PATCH 39/68] final commit, remove last remaining warnings --- src/common/m_helper.fpp | 2 +- src/common/m_phase_change.fpp | 2 +- src/common/m_variables_conversion.fpp | 6 +++--- src/post_process/m_data_output.fpp | 8 ++++---- src/post_process/m_derived_variables.fpp | 8 ++++---- src/post_process/m_global_parameters.fpp | 2 +- src/pre_process/m_assign_variables.fpp | 2 +- src/pre_process/m_compute_levelset.fpp | 12 ++++++------ src/pre_process/m_model.fpp | 6 +++--- src/pre_process/m_patches.fpp | 14 +++++++------- src/pre_process/m_perturbation.fpp | 22 +++++++++++----------- 11 files changed, 42 insertions(+), 42 deletions(-) diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp index 4e8481902c..e08a0938aa 100644 --- a/src/common/m_helper.fpp +++ b/src/common/m_helper.fpp @@ -230,7 +230,7 @@ contains real(wp), intent(out) :: Re_trans, Im_trans complex :: trans, c1, c2, c3 - complex :: imag = (0., 1.) + complex :: imag = (0._wp, 1._wp) real(wp) :: f_transcoeff c1 = imag*omega*peclet diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index d0d989b173..132651e684 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -38,7 +38,7 @@ module m_phase_change !> @{ integer, parameter :: max_iter = 1e8_wp !< max # of iterations real(wp), parameter :: pCr = 4.94e7_wp !< Critical water pressure - real(wp), parameter :: TCr = 385.05 + 273.15 !< Critical water temperature + real(wp), parameter :: TCr = 385.05_wp + 273.15_wp !< Critical water temperature real(wp), parameter :: mixM = 1.0e-8_wp !< threshold for 'mixture cell'. If Y < mixM, phase change does not happen integer, parameter :: lp = 1 !< index for the liquid phase of the reacting fluid integer, parameter :: vp = 2 !< index for the vapor phase of the reacting fluid diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index e54e5eb44f..2c4737e191 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -760,7 +760,7 @@ contains !$acc loop seq do i = 1, nb mu = qK_cons_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - sig = (qK_cons_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - mu**2)**0.5 + sig = (qK_cons_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - mu**2)**0.5_wp mv(j, k, l, 1, i) = (mass_v0(i))*(mu - sig)**(3._wp)/(R0(i)**(3._wp)) mv(j, k, l, 2, i) = (mass_v0(i))*(mu - sig)**(3._wp)/(R0(i)**(3._wp)) @@ -793,7 +793,7 @@ contains !$acc loop seq do i = 1, nb mu = qK_cons_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - sig = (qK_cons_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - mu**2)**0.5 + sig = (qK_cons_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - mu**2)**0.5_wp !PRESTON (ISOTHERMAL) pb(j, k, l, 1, i) = (pb0(i))*(R0(i)**(3._wp))*(mass_n0(i) + mv(j, k, l, 1, i))/(mu - sig)**(3._wp)/(mass_n0(i) + mass_v0(i)) @@ -1137,7 +1137,7 @@ contains (gamma*q_prim_vf(E_idx)%sf(j, k, l) + pi_inf) else !Tait EOS, no conserved energy variable - q_cons_vf(E_idx)%sf(j, k, l) = 0. + q_cons_vf(E_idx)%sf(j, k, l) = 0._wp end if end if diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 44d4f73247..3d4a8e3388 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -695,7 +695,7 @@ contains else if (precision == 1) then - write (dbfile) real(x_cb, kind(0.0)) + write (dbfile) real(x_cb, wp) else write (dbfile) x_cb end if @@ -708,7 +708,7 @@ contains if (proc_rank == 0) then if (precision == 1) then - write (dbroot) real(x_root_cb, kind(0.0)) + write (dbroot) real(x_root_cb, wp) else write (dbroot) x_root_cb end if @@ -953,7 +953,7 @@ contains ! Writing the name of the flow variable and its data, associated ! with the local processor, to the formatted database slave file if (precision == 1) then - write (dbfile) varname, real(q_sf, kind(0.0)) + write (dbfile) varname, real(q_sf, wp) else write (dbfile) varname, q_sf end if @@ -971,7 +971,7 @@ contains if (proc_rank == 0) then if (precision == 1) then - write (dbroot) varname, real(q_root_sf, kind(0.0)) + write (dbroot) varname, real(q_root_sf, wp) else write (dbroot) varname, q_root_sf end if diff --git a/src/post_process/m_derived_variables.fpp b/src/post_process/m_derived_variables.fpp index 7fad1f3b21..0f03ccb11f 100644 --- a/src/post_process/m_derived_variables.fpp +++ b/src/post_process/m_derived_variables.fpp @@ -546,11 +546,11 @@ contains end do ! Compute Q - Q = 0.5*((O2(1, 1) + O2(2, 2) + O2(3, 3)) - & - (S2(1, 1) + S2(2, 2) + S2(3, 3))) + Q = 0.5_wp*((O2(1, 1) + O2(2, 2) + O2(3, 3)) - & + (S2(1, 1) + S2(2, 2) + S2(3, 3))) trS = S(1, 1) + S(2, 2) + S(3, 3) - IIS = 0.5*((S(1, 1) + S(2, 2) + S(3, 3))**2 - & - (S2(1, 1) + S2(2, 2) + S2(3, 3))) + IIS = 0.5_wp*((S(1, 1) + S(2, 2) + S(3, 3))**2 - & + (S2(1, 1) + S2(2, 2) + S2(3, 3))) q_sf(j, k, l) = Q + IIS end do diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index cc16284362..46dedba192 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -59,7 +59,7 @@ module m_global_parameters !> @name Cell-boundary locations in the x-, y- and z-coordinate directions !> @{ real(wp), allocatable, dimension(:) :: x_cb, x_root_cb, y_cb, z_cb - real(kind(0.0)), allocatable, dimension(:) :: x_cb_s, y_cb_s, z_cb_s + real(wp), allocatable, dimension(:) :: x_cb_s, y_cb_s, z_cb_s !> @} !> @name Cell-center locations in the x-, y- and z-coordinate directions diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp index 3873c7f44f..4b1e8d1843 100644 --- a/src/pre_process/m_assign_variables.fpp +++ b/src/pre_process/m_assign_variables.fpp @@ -225,7 +225,7 @@ contains B_tait = B_tait*(n_tait - 1._wp)/n_tait if (j < 177) then - q_prim_vf(E_idx)%sf(j, k, l) = 0.5*q_prim_vf(E_idx)%sf(j, k, l) + q_prim_vf(E_idx)%sf(j, k, l) = 0.5_wp*q_prim_vf(E_idx)%sf(j, k, l) end if if (qbmm) then diff --git a/src/pre_process/m_compute_levelset.fpp b/src/pre_process/m_compute_levelset.fpp index 408d58429f..555c513358 100644 --- a/src/pre_process/m_compute_levelset.fpp +++ b/src/pre_process/m_compute_levelset.fpp @@ -528,18 +528,18 @@ contains length_z = patch_ib(ib_patch_id)%length_z if (length_x /= 0._wp) then - boundary%beg = x_centroid - 0.5*length_x - boundary%end = x_centroid + 0.5*length_x + boundary%beg = x_centroid - 0.5_wp*length_x + boundary%end = x_centroid + 0.5_wp*length_x dist_sides_vec = (/1, 0, 0/) dist_surface_vec = (/0, 1, 1/) else if (length_y /= 0._wp) then - boundary%beg = y_centroid - 0.5*length_y - boundary%end = y_centroid + 0.5*length_y + boundary%beg = y_centroid - 0.5_wp*length_y + boundary%end = y_centroid + 0.5_wp*length_y dist_sides_vec = (/0, 1, 0/) dist_surface_vec = (/1, 0, 1/) else if (length_z /= 0._wp) then - boundary%beg = z_centroid - 0.5*length_z - boundary%end = z_centroid + 0.5*length_z + boundary%beg = z_centroid - 0.5_wp*length_z + boundary%end = z_centroid + 0.5_wp*length_z dist_sides_vec = (/0, 0, 1/) dist_surface_vec = (/1, 1, 0/) end if diff --git a/src/pre_process/m_model.fpp b/src/pre_process/m_model.fpp index 9305c11f04..7dd78b1578 100644 --- a/src/pre_process/m_model.fpp +++ b/src/pre_process/m_model.fpp @@ -501,10 +501,10 @@ contains do i = 1, spc call random_number(ray_origins(i, :)) - ray_origins(i, :) = point + (ray_origins(i, :) - 0.5)*spacing(:) + ray_origins(i, :) = point + (ray_origins(i, :) - 0.5_wp)*spacing(:) call random_number(ray_dirs(i, :)) - ray_dirs(i, :) = ray_dirs(i, :) - 0.5 + ray_dirs(i, :) = ray_dirs(i, :) - 0.5_wp ray_dirs(i, :) = ray_dirs(i, :)/sqrt(sum(ray_dirs(i, :)*ray_dirs(i, :))) end do @@ -549,7 +549,7 @@ contains NdotRayDirection = sum(N(:)*ray%d(:)) - if (abs(NdotRayDirection) < 0.0000001) then + if (abs(NdotRayDirection) < 0.0000001_wp) then return end if diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index 8e7e577175..992627d4a3 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -342,9 +342,9 @@ contains dycdxc = (2*ma/(1 - pa)**2)*(pa - xa) end if - yt = (5._wp*ta)*(0.2969*xa**0.5_wp - 0.126*xa - 0.3516*xa**2._wp + 0.2843*xa**3 - 0.1015*xa**4) - sin_c = dycdxc/(1 + dycdxc**2)**0.5 - cos_c = 1/(1 + dycdxc**2)**0.5 + yt = (5._wp*ta)*(0.2969_wp*xa**0.5_wp - 0.126_wp*xa - 0.3516_wp*xa**2._wp + 0.2843_wp*xa**3 - 0.1015_wp*xa**4) + sin_c = dycdxc/(1 + dycdxc**2)**0.5_wp + cos_c = 1/(1 + dycdxc**2)**0.5_wp xu = xa - yt*sin_c yu = yc + yt*cos_c @@ -509,9 +509,9 @@ contains dycdxc = (2*ma/(1 - pa)**2)*(pa - xa) end if - yt = (5._wp*ta)*(0.2969*xa**0.5_wp - 0.126*xa - 0.3516*xa**2._wp + 0.2843*xa**3 - 0.1015*xa**4) - sin_c = dycdxc/(1 + dycdxc**2)**0.5 - cos_c = 1/(1 + dycdxc**2)**0.5 + yt = (5._wp*ta)*(0.2969_wp*xa**0.5_wp - 0.126_wp*xa - 0.3516_wp*xa**2._wp + 0.2843_wp*xa**3 - 0.1015_wp*xa**4) + sin_c = dycdxc/(1 + dycdxc**2)**0.5_wp + cos_c = 1/(1 + dycdxc**2)**0.5_wp xu = xa - yt*sin_c yu = yc + yt*cos_c @@ -1288,7 +1288,7 @@ contains ! state in the cells that this patch covers. eta = 1._wp l = 1._wp - U0 = 0.1 + U0 = 0.1_wp ! Checking whether the patch covers a particular cell in the ! domain and verifying whether the current patch has the ! permission to write to that cell. If both queries check out, diff --git a/src/pre_process/m_perturbation.fpp b/src/pre_process/m_perturbation.fpp index cda101ee46..2240bb894d 100644 --- a/src/pre_process/m_perturbation.fpp +++ b/src/pre_process/m_perturbation.fpp @@ -128,29 +128,29 @@ contains wave2 = 0._wp ! Compute 2D waves - call s_instability_wave(2*pi*4.0/Ldomain, 0._wp, wave_tmp, 0._wp) + call s_instability_wave(2*pi*4.0_wp/Ldomain, 0._wp, wave_tmp, 0._wp) wave1 = wave1 + wave_tmp - call s_instability_wave(2*pi*2.0/Ldomain, 0._wp, wave_tmp, 0._wp) + call s_instability_wave(2*pi*2.0_wp/Ldomain, 0._wp, wave_tmp, 0._wp) wave1 = wave1 + wave_tmp - call s_instability_wave(2*pi*1.0/Ldomain, 0._wp, wave_tmp, 0._wp) + call s_instability_wave(2*pi*1.0_wp/Ldomain, 0._wp, wave_tmp, 0._wp) wave1 = wave1 + wave_tmp - wave = wave1*0.05 + wave = wave1*0.05_wp if (p > 0) then ! Compute 3D waves with phase shifts. - call s_instability_wave(2*pi*4.0/Ldomain, 2*pi*4.0/Ldomain, wave_tmp, 2*pi*11._wp/31._wp) + call s_instability_wave(2*pi*4.0/Ldomain, 2*pi*4.0_wp/Ldomain, wave_tmp, 2*pi*11._wp/31._wp) wave2 = wave2 + wave_tmp - call s_instability_wave(2*pi*2.0/Ldomain, 2*pi*2.0/Ldomain, wave_tmp, 2*pi*13._wp/31._wp) + call s_instability_wave(2*pi*2.0/Ldomain, 2*pi*2.0_wp/Ldomain, wave_tmp, 2*pi*13._wp/31._wp) wave2 = wave2 + wave_tmp - call s_instability_wave(2*pi*1.0/Ldomain, 2*pi*1.0/Ldomain, wave_tmp, 2*pi*17._wp/31._wp) + call s_instability_wave(2*pi*1.0/Ldomain, 2*pi*1.0_wp/Ldomain, wave_tmp, 2*pi*17._wp/31._wp) wave2 = wave2 + wave_tmp - call s_instability_wave(2*pi*4.0/Ldomain, -2*pi*4.0/Ldomain, wave_tmp, 2*pi*19._wp/31._wp) + call s_instability_wave(2*pi*4.0/Ldomain, -2*pi*4.0_wp/Ldomain, wave_tmp, 2*pi*19._wp/31._wp) wave2 = wave2 + wave_tmp - call s_instability_wave(2*pi*2.0/Ldomain, -2*pi*2.0/Ldomain, wave_tmp, 2*pi*23._wp/31._wp) + call s_instability_wave(2*pi*2.0/Ldomain, -2*pi*2.0_wp/Ldomain, wave_tmp, 2*pi*23._wp/31._wp) wave2 = wave2 + wave_tmp - call s_instability_wave(2*pi*1.0/Ldomain, -2*pi*1.0/Ldomain, wave_tmp, 2*pi*29._wp/31._wp) + call s_instability_wave(2*pi*1.0/Ldomain, -2*pi*1.0_wp/Ldomain, wave_tmp, 2*pi*29._wp/31._wp) wave2 = wave2 + wave_tmp - wave = wave + 0.15*wave2 + wave = wave + 0.15_wp*wave2 end if ! Superpose velocity perturbuations (instability waves) to the velocity field From a4dfc4c66d5cb7b04fc66472fdb46410b6709700 Mon Sep 17 00:00:00 2001 From: Archith Iyer Date: Thu, 28 Nov 2024 12:47:29 -0800 Subject: [PATCH 40/68] nevermind, small fix --- src/pre_process/m_perturbation.fpp | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/pre_process/m_perturbation.fpp b/src/pre_process/m_perturbation.fpp index 2240bb894d..8137365d2c 100644 --- a/src/pre_process/m_perturbation.fpp +++ b/src/pre_process/m_perturbation.fpp @@ -138,17 +138,17 @@ contains if (p > 0) then ! Compute 3D waves with phase shifts. - call s_instability_wave(2*pi*4.0/Ldomain, 2*pi*4.0_wp/Ldomain, wave_tmp, 2*pi*11._wp/31._wp) + call s_instability_wave(2*pi*4.0_wp/Ldomain, 2*pi*4.0_wp/Ldomain, wave_tmp, 2*pi*11._wp/31._wp) wave2 = wave2 + wave_tmp - call s_instability_wave(2*pi*2.0/Ldomain, 2*pi*2.0_wp/Ldomain, wave_tmp, 2*pi*13._wp/31._wp) + call s_instability_wave(2*pi*2.0_wp/Ldomain, 2*pi*2.0_wp/Ldomain, wave_tmp, 2*pi*13._wp/31._wp) wave2 = wave2 + wave_tmp - call s_instability_wave(2*pi*1.0/Ldomain, 2*pi*1.0_wp/Ldomain, wave_tmp, 2*pi*17._wp/31._wp) + call s_instability_wave(2*pi*1.0_wp/Ldomain, 2*pi*1.0_wp/Ldomain, wave_tmp, 2*pi*17._wp/31._wp) wave2 = wave2 + wave_tmp - call s_instability_wave(2*pi*4.0/Ldomain, -2*pi*4.0_wp/Ldomain, wave_tmp, 2*pi*19._wp/31._wp) + call s_instability_wave(2*pi*4.0_wp/Ldomain, -2*pi*4.0_wp/Ldomain, wave_tmp, 2*pi*19._wp/31._wp) wave2 = wave2 + wave_tmp - call s_instability_wave(2*pi*2.0/Ldomain, -2*pi*2.0_wp/Ldomain, wave_tmp, 2*pi*23._wp/31._wp) + call s_instability_wave(2*pi*2.0_wp/Ldomain, -2*pi*2.0_wp/Ldomain, wave_tmp, 2*pi*23._wp/31._wp) wave2 = wave2 + wave_tmp - call s_instability_wave(2*pi*1.0/Ldomain, -2*pi*1.0_wp/Ldomain, wave_tmp, 2*pi*29._wp/31._wp) + call s_instability_wave(2*pi*1.0_wp/Ldomain, -2*pi*1.0_wp/Ldomain, wave_tmp, 2*pi*29._wp/31._wp) wave2 = wave2 + wave_tmp wave = wave + 0.15_wp*wave2 end if From 0651ec63f5ecbcbd3b9e8bf5d5ec28e8cc59e347 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Thu, 28 Nov 2024 15:56:04 -0500 Subject: [PATCH 41/68] Update lint-source.yml --- .github/workflows/lint-source.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.github/workflows/lint-source.yml b/.github/workflows/lint-source.yml index d425d449b8..126a8d71be 100644 --- a/.github/workflows/lint-source.yml +++ b/.github/workflows/lint-source.yml @@ -30,3 +30,6 @@ jobs: - name: Lint the source code run: fortitude check --ignore=E001,S001,S101,M011,F001,S041,T001 ./src/*/* || true + + - name: Ensure kind is specified + run: fortitude check --select=P001 ./src/*/* From 12588c3e40c4e79a1b6bb5d1cd57ec17dc63dc36 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Thu, 28 Nov 2024 16:01:11 -0500 Subject: [PATCH 42/68] Update lint-source.yml --- .github/workflows/lint-source.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/lint-source.yml b/.github/workflows/lint-source.yml index 126a8d71be..d7672712a1 100644 --- a/.github/workflows/lint-source.yml +++ b/.github/workflows/lint-source.yml @@ -29,7 +29,7 @@ jobs: run: pip install fortitude-lint ansi2txt - name: Lint the source code - run: fortitude check --ignore=E001,S001,S101,M011,F001,S041,T001 ./src/*/* || true + run: fortitude check --file-extensions=f90,fpp,fypp --ignore=E001,S001,S101,M011,F001,S041,T001 ./src/*/* || true - name: Ensure kind is specified - run: fortitude check --select=P001 ./src/*/* + run: fortitude check --file-extensions=f90,fpp,fypp --select=P001 ./src/*/* From dec61ba22892aef28d69213aacbbd7f6d7bc1894 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Thu, 28 Nov 2024 16:07:32 -0500 Subject: [PATCH 43/68] Update lint-source.yml --- .github/workflows/lint-source.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/lint-source.yml b/.github/workflows/lint-source.yml index d7672712a1..1ee7d621a3 100644 --- a/.github/workflows/lint-source.yml +++ b/.github/workflows/lint-source.yml @@ -29,7 +29,7 @@ jobs: run: pip install fortitude-lint ansi2txt - name: Lint the source code - run: fortitude check --file-extensions=f90,fpp,fypp --ignore=E001,S001,S101,M011,F001,S041,T001 ./src/*/* || true + run: fortitude check --file-extensions=f90,fpp,fypp --ignore=E001,S001,S101,M011,F001,S041,T001 ./src/** || true - name: Ensure kind is specified - run: fortitude check --file-extensions=f90,fpp,fypp --select=P001 ./src/*/* + run: fortitude check --file-extensions=f90,fpp,fypp --select=P001 ./src/** From 30fab57ba1d511de75f2882d0e0458117d52e69e Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Sun, 1 Dec 2024 15:35:10 -0500 Subject: [PATCH 44/68] fix missing precision, satiate linter --- src/pre_process/include/2dHardcodedIC.fpp | 48 +++++++++++------------ src/pre_process/include/3dHardcodedIC.fpp | 34 ++++++++-------- 2 files changed, 41 insertions(+), 41 deletions(-) diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp index 5afa899717..1149cd6106 100644 --- a/src/pre_process/include/2dHardcodedIC.fpp +++ b/src/pre_process/include/2dHardcodedIC.fpp @@ -25,7 +25,7 @@ end if case (202) ! Gresho vortex (Gouasmi et al 2022 JCP) r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp - rmax = 0.2 + rmax = 0.2_wp gam = 1._wp + 1._wp/fluid_pp(1)%gamma umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2) @@ -42,11 +42,11 @@ else q_prim_vf(momxb)%sf(i, j, 0) = 0._wp q_prim_vf(momxe)%sf(i, j, 0) = 0._wp - q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2.)) + q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp)) end if case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction - r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp - rmax = 0.2 + r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp + rmax = 0.2_wp gam = 1._wp + 1._wp/fluid_pp(1)%gamma umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2) @@ -55,49 +55,49 @@ if (r < rmax) then q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax - q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp) + q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp) else if (r < 2*rmax) then q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax) q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax) - q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax))) + q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax))) else q_prim_vf(momxb)%sf(i, j, 0) = 0._wp q_prim_vf(momxe)%sf(i, j, 0) = 0._wp - q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2.)) + q_prim_vf(E_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp)) end if q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(E_idx)%sf(i, j, 0)**(1._wp/gam) case (204) ! Rayleigh-Taylor instability - rhoH = 3 - rhoL = 1 - pRef = 1e5_wp + rhoH = 3._wp + rhoL = 1._wp + pRef = 1.e5_wp pInt = pRef - h = 0.7 - lam = 0.2 - wl = 2*pi/lam - amp = 0.05/wl + h = 0.7_wp + lam = 0.2_wp + wl = 2._wp*pi/lam + amp = 0.05_wp/wl - intH = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h + intH = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h - alph = 5e-1_wp*(1 + tanh((y_cc(j) - intH)/2.5e-3_wp)) + alph = 0.5_wp*(1._wp + tanh((y_cc(j) - intH)/2.5e-3_wp)) if (alph < eps) alph = eps - if (alph > 1 - eps) alph = 1 - eps + if (alph > 1._wp - eps) alph = 1._wp - eps if (y_cc(j) > intH) then q_prim_vf(advxb)%sf(i, j, 0) = alph - q_prim_vf(advxe)%sf(i, j, 0) = 1 - alph + q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoH - q_prim_vf(contxe)%sf(i, j, 0) = (1 - alph)*rhoL - q_prim_vf(E_idx)%sf(i, j, 0) = pref + rhoH*9.81*(1.2 - y_cc(j)) + q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhoL + q_prim_vf(E_idx)%sf(i, j, 0) = pref + rhoH*9.81_wp*(1.2_wp - y_cc(j)) else q_prim_vf(advxb)%sf(i, j, 0) = alph - q_prim_vf(advxe)%sf(i, j, 0) = 1 - alph + q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoH - q_prim_vf(contxe)%sf(i, j, 0) = (1 - alph)*rhoL - pInt = pref + rhoH*9.81*(1.2 - intH) - q_prim_vf(E_idx)%sf(i, j, 0) = pInt + rhoL*9.81*(intH - y_cc(j)) + q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhoL + pInt = pref + rhoH*9.81_wp*(1.2_wp - intH) + q_prim_vf(E_idx)%sf(i, j, 0) = pInt + rhoL*9.81_wp*(intH - y_cc(j)) end if case default diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp index a6fa0b91a9..852ec538f5 100644 --- a/src/pre_process/include/3dHardcodedIC.fpp +++ b/src/pre_process/include/3dHardcodedIC.fpp @@ -12,35 +12,35 @@ select case (patch_icpp(patch_id)%hcid) case (300) ! Rayleigh-Taylor instability - rhoH = 3 - rhoL = 1 - pRef = 1e5_wp + rhoH = 3._wp + rhoL = 1._wp + pRef = 1.e5_wp pInt = pRef - h = 0.7 - lam = 0.2 - wl = 2*pi/lam - amp = 0.025/wl + h = 0.7_wp + lam = 0.2_wp + wl = 2._wp*pi/lam + amp = 0.025_wp/wl - intH = amp*(sin(2*pi*x_cc(i)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h + intH = amp*(sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + sin(2._wp*pi*z_cc(k)/lam - pi/2._wp)) + h - alph = 5e-1_wp*(1 + tanh((y_cc(j) - intH)/2.5e-3_wp)) + alph = 5e-1_wp*(1._wp + tanh((y_cc(j) - intH)/2.5e-3_wp)) if (alph < eps) alph = eps - if (alph > 1 - eps) alph = 1 - eps + if (alph > 1._wp - eps) alph = 1._wp - eps if (y_cc(j) > intH) then q_prim_vf(advxb)%sf(i, j, k) = alph - q_prim_vf(advxe)%sf(i, j, k) = 1 - alph + q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph q_prim_vf(contxb)%sf(i, j, k) = alph*rhoH - q_prim_vf(contxe)%sf(i, j, k) = (1 - alph)*rhoL - q_prim_vf(E_idx)%sf(i, j, k) = pref + rhoH*9.81*(1.2 - y_cc(j)) + q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhoL + q_prim_vf(E_idx)%sf(i, j, k) = pref + rhoH*9.81_wp*(1.2_wp - y_cc(j)) else q_prim_vf(advxb)%sf(i, j, k) = alph - q_prim_vf(advxe)%sf(i, j, k) = 1 - alph + q_prim_vf(advxe)%sf(i, j, k) = 1._wp- alph q_prim_vf(contxb)%sf(i, j, k) = alph*rhoH - q_prim_vf(contxe)%sf(i, j, k) = (1 - alph)*rhoL - pInt = pref + rhoH*9.81*(1.2 - intH) - q_prim_vf(E_idx)%sf(i, j, k) = pInt + rhoL*9.81*(intH - y_cc(j)) + q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhoL + pInt = pref + rhoH*9.81_wp*(1.2_wp - intH) + q_prim_vf(E_idx)%sf(i, j, k) = pInt + rhoL*9.81_wp*(intH - y_cc(j)) end if ! Put your variable assignments here From 650ae57dba1f9ca0fb43426ff4476b1c2fe535f5 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Sun, 1 Dec 2024 15:43:17 -0500 Subject: [PATCH 45/68] satiate --- src/post_process/m_data_output.fpp | 2 +- src/pre_process/include/3dHardcodedIC.fpp | 2 +- toolchain/mfc/bench.py | 1 - toolchain/mfc/test/test.py | 2 +- 4 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 3d4a8e3388..5e0a1111e1 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -168,7 +168,7 @@ contains ! The size of the ghost zone layer in each of the active coordinate ! directions was set in the module m_mpi_proxy.f90. The results are - ! now transfered to the local variables of this module when they are + ! now transferred to the local variables of this module when they are ! required by the Silo-HDF5 format, for multidimensional data sets. ! With the same, latter, requirements, the variables bookkeeping the ! number of cell-boundaries in each active coordinate direction are diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp index 852ec538f5..a75476c372 100644 --- a/src/pre_process/include/3dHardcodedIC.fpp +++ b/src/pre_process/include/3dHardcodedIC.fpp @@ -36,7 +36,7 @@ q_prim_vf(E_idx)%sf(i, j, k) = pref + rhoH*9.81_wp*(1.2_wp - y_cc(j)) else q_prim_vf(advxb)%sf(i, j, k) = alph - q_prim_vf(advxe)%sf(i, j, k) = 1._wp- alph + q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph q_prim_vf(contxb)%sf(i, j, k) = alph*rhoH q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhoL pInt = pref + rhoH*9.81_wp*(1.2_wp - intH) diff --git a/toolchain/mfc/bench.py b/toolchain/mfc/bench.py index bc7e68f75b..93f719c4b2 100644 --- a/toolchain/mfc/bench.py +++ b/toolchain/mfc/bench.py @@ -168,4 +168,3 @@ def _lock_to_str(lock): if err != 0: raise MFCException("Benchmarking failed") - \ No newline at end of file diff --git a/toolchain/mfc/test/test.py b/toolchain/mfc/test/test.py index cf8a024364..2e2ec936b4 100644 --- a/toolchain/mfc/test/test.py +++ b/toolchain/mfc/test/test.py @@ -260,7 +260,7 @@ def handle_case(case: TestCase, devices: typing.Set[int]): _handle_case(case, devices) nPASS += 1 except Exception as exc: - if nAttempts < ARG("max_attempts"): + if nAttempts < max_attempts: cons.print(f"[bold yellow] Attempt {nAttempts}: Failed test {case.get_uuid()}. Retrying...[/bold yellow]") errors.append(f"[bold yellow] Attempt {nAttempts}: Failed test {case.get_uuid()}. Retrying...[/bold yellow]") continue From 0c970ca2b4bc3edd9e3a649d1040095ca221187e Mon Sep 17 00:00:00 2001 From: archithiyer Date: Mon, 2 Dec 2024 12:55:59 -0500 Subject: [PATCH 46/68] hack mixlayer_perturb issue, just so i can test CI --- .github/workflows/test.yml | 4 +++- toolchain/mfc/test/case.py | 2 ++ toolchain/mfc/test/test.py | 2 +- 3 files changed, 6 insertions(+), 2 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 1be80f5c79..03a8f060b3 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -26,6 +26,7 @@ jobs: matrix: os: ['ubuntu', 'macos'] mpi: ['mpi'] + precision: [''] debug: ['debug', 'no-debug'] intel: [true, false] exclude: @@ -35,6 +36,7 @@ jobs: include: - os: ubuntu mpi: no-mpi + precision: single debug: no-debug intel: false @@ -84,7 +86,7 @@ jobs: - name: Build run: | if [ '${{ matrix.intel }}' == 'true' ]; then . /opt/intel/oneapi/setvars.sh; fi - /bin/bash mfc.sh build -j $(nproc) --${{ matrix.debug }} --${{ matrix.mpi }} + /bin/bash mfc.sh build -j $(nproc) --${{ matrix.debug }} --${{ matrix.mpi }} --${{ matrix.precision }} - name: Test run: | diff --git a/toolchain/mfc/test/case.py b/toolchain/mfc/test/case.py index a09f586797..4967ef2a60 100644 --- a/toolchain/mfc/test/case.py +++ b/toolchain/mfc/test/case.py @@ -231,6 +231,8 @@ def compute_tolerance(self) -> float: if self.params.get("hypoelasticity", 'F') == 'T': tolerance = 1e-7 + elif self.params.get("mixlayer_perturb", 'F') == 'T': + tolerance = 1e-5 elif any(self.params.get(key, 'F') == 'T' for key in ['relax', 'ib', 'qbmm', 'bubbles']): tolerance = 1e-10 elif self.params.get("low_Mach", 'F') in [1, 2]: diff --git a/toolchain/mfc/test/test.py b/toolchain/mfc/test/test.py index 2e2ec936b4..9f621333bc 100644 --- a/toolchain/mfc/test/test.py +++ b/toolchain/mfc/test/test.py @@ -59,7 +59,7 @@ def __filter(cases_) -> typing.List[TestCase]: for case in cases[:]: if ARG("single"): - skip = ['low_Mach', 'Hypoelasticity', 'teno', 'Chemistry'] + skip = ['low_Mach', 'Hypoelasticity', 'teno', 'Chemistry', 'mixlayer_perturb'] if any(label in case.trace for label in skip): cases.remove(case) From 26026283a554f855e0c6de10c64981b42b1e6504 Mon Sep 17 00:00:00 2001 From: archithiyer Date: Mon, 2 Dec 2024 16:54:08 -0500 Subject: [PATCH 47/68] add ci to gpu --- .github/workflows/phoenix/submit.sh | 21 ++++++++++++++------- .github/workflows/phoenix/test.sh | 8 ++++++-- .github/workflows/test.yml | 22 +++++++++++++++++----- 3 files changed, 37 insertions(+), 14 deletions(-) diff --git a/.github/workflows/phoenix/submit.sh b/.github/workflows/phoenix/submit.sh index 9e894abd07..cca4e4aca9 100644 --- a/.github/workflows/phoenix/submit.sh +++ b/.github/workflows/phoenix/submit.sh @@ -6,13 +6,15 @@ usage() { echo "Usage: $0 [script.sh] [cpu|gpu]" } -if [ ! -z "$1" ]; then - sbatch_script_contents=`cat $1` -else +if [ -z "$1" ] || [ -z "$2" ]; then usage exit 1 fi +sbatch_script_contents=`cat $1` + +precision="${3:-}" + sbatch_cpu_opts="\ #SBATCH -p cpu-small # partition #SBATCH --ntasks-per-node=24 # Number of cores per node required @@ -20,7 +22,7 @@ sbatch_cpu_opts="\ " sbatch_gpu_opts="\ -#SBATCH -CV100-16GB +#SBATCH -C V100-16GB #SBATCH -G2\ " @@ -35,25 +37,30 @@ fi job_slug="`basename "$1" | sed 's/\.sh$//' | sed 's/[^a-zA-Z0-9]/-/g'`-$2" +if [ -n "$precision" ]; then + job_slug="$job_slug-$precision" +fi + sbatch < Date: Mon, 2 Dec 2024 17:03:58 -0500 Subject: [PATCH 48/68] small CI fix --- .github/workflows/test.yml | 60 +++++++++++++++++++++----------------- 1 file changed, 34 insertions(+), 26 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 53870ba9f3..3abfac5d49 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -23,6 +23,7 @@ jobs: if: needs.file-changes.outputs.checkall == 'true' needs: file-changes strategy: + fail-fast: false matrix: os: ['ubuntu', 'macos'] mpi: ['mpi'] @@ -39,15 +40,12 @@ jobs: precision: debug: no-debug intel: false - - include: - os: ubuntu mpi: mpi precision: single debug: no-debug intel: false - fail-fast: false continue-on-error: true runs-on: ${{ matrix.os }}-latest @@ -56,30 +54,32 @@ jobs: uses: actions/checkout@v4 - name: Setup MacOS - if: matrix.os == 'macos' - run: | + if: matrix.os == 'macos' + run: | brew install coreutils python cmake fftw hdf5 gcc@14 boost open-mpi echo "FC=gfortran-14" >> $GITHUB_ENV echo "BOOST_INCLUDE=/opt/homebrew/include/" >> $GITHUB_ENV - name: Setup Ubuntu - if: matrix.os == 'ubuntu' && matrix.intel == false + if: matrix.os == 'ubuntu' && matrix.intel == false run: | - sudo apt update -y - sudo apt install -y cmake gcc g++ python3 python3-dev hdf5-tools \ - libfftw3-dev libhdf5-dev openmpi-bin libopenmpi-dev + sudo apt update -y + sudo apt install -y cmake gcc g++ python3 python3-dev hdf5-tools \ + libfftw3-dev libhdf5-dev openmpi-bin libopenmpi-dev - name: Setup Ubuntu (Intel) - if: matrix.os == 'ubuntu' && matrix.intel == true + if: matrix.os == 'ubuntu' && matrix.intel == true run: | sudo apt update -y sudo apt install -y tar wget make cmake python3 python3-dev wget https://apt.repos.intel.com/intel-gpg-keys/GPG-PUB-KEY-INTEL-SW-PRODUCTS.PUB sudo apt-key add GPG-PUB-KEY-INTEL-SW-PRODUCTS.PUB rm GPG-PUB-KEY-INTEL-SW-PRODUCTS.PUB - sudo echo "deb https://apt.repos.intel.com/oneapi all main" | sudo tee /etc/apt/sources.list.d/oneAPI.list + echo "deb https://apt.repos.intel.com/oneapi all main" | sudo tee /etc/apt/sources.list.d/oneAPI.list sudo apt-get update - sudo apt-get install -y intel-oneapi-common-vars intel-oneapi-compiler-fortran-2022.1.0 intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic-2022.1.0 intel-oneapi-mkl-2021.4.0 intel-oneapi-mpi-2021.7.1 intel-oneapi-mpi-devel-2021.7.1 + sudo apt-get install -y intel-oneapi-common-vars intel-oneapi-compiler-fortran-2022.1.0 \ + intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic-2022.1.0 intel-oneapi-mkl-2021.4.0 \ + intel-oneapi-mpi-2021.7.1 intel-oneapi-mpi-devel-2021.7.1 source /opt/intel/oneapi/setvars.sh echo "CXX=$(which icpc)" >> $GITHUB_ENV echo "CC=$(which icc)" >> $GITHUB_ENV @@ -91,14 +91,22 @@ jobs: echo "I_MPI_ROOT=/opt/intel/oneapi/mpi/2021.7.1/" >> $GITHUB_ENV - name: Build - run: | + run: | if [ '${{ matrix.intel }}' == 'true' ]; then . /opt/intel/oneapi/setvars.sh; fi - /bin/bash mfc.sh build -j $(nproc) --${{ matrix.debug }} --${{ matrix.mpi }} --${{ matrix.precision }} + precision_flag="" + if [ "${{ matrix.precision }}" == "single" ]; then + precision_flag="--single" + fi + /bin/bash mfc.sh build -j $(nproc) --${{ matrix.debug }} --${{ matrix.mpi }} $precision_flag - name: Test - run: | + run: | if [ '${{ matrix.intel }}' == 'true' ]; then . /opt/intel/oneapi/setvars.sh; fi - /bin/bash mfc.sh test --max-attempts 3 -j $(nproc) $OPT1 $OPT2 + precision_flag="" + if [ "${{ matrix.precision }}" == "single" ]; then + precision_flag="--single" + fi + /bin/bash mfc.sh test --max-attempts 3 -j $(nproc) $OPT1 $OPT2 $precision_flag env: OPT1: ${{ matrix.mpi == 'mpi' && '--test-all' || '' }} OPT2: ${{ matrix.debug == 'debug' && '-% 20' || '' }} @@ -122,7 +130,7 @@ jobs: lbl: gt precision: single runs-on: - group: phoenix + group: phoenix labels: ${{ matrix.lbl }} env: ACTIONS_RUNNER_FORCE_ACTIONS_NODE_VERSION: node16 @@ -132,24 +140,24 @@ jobs: uses: actions/checkout@v4 - name: Build & Test - if: matrix.lbl == 'gt' - run: bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/test.sh ${{ matrix.device }} ${{ matrix.precision }} + if: matrix.lbl == 'gt' + run: bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/test.sh ${{ matrix.device }} ${{ matrix.precision }} - name: Build - if: matrix.lbl == 'frontier' - run: bash .github/workflows/frontier/build.sh + if: matrix.lbl == 'frontier' + run: bash .github/workflows/frontier/build.sh - name: Test - if: matrix.lbl == 'frontier' - run: bash .github/workflows/frontier/submit.sh .github/workflows/frontier/test.sh ${{matrix.device}} ${{ matrix.precision }} + if: matrix.lbl == 'frontier' + run: bash .github/workflows/frontier/submit.sh .github/workflows/frontier/test.sh ${{ matrix.device }} ${{ matrix.precision }} - name: Print Logs - if: always() - run: cat test-${{ matrix.device }}-${{ matrix.precision }}.out + if: always() + run: cat test-${{ matrix.device }}-${{ matrix.precision }}.out - name: Archive Logs uses: actions/upload-artifact@v4 - if: always() + if: always() with: name: logs-${{ strategy.job-index }}-${{ matrix.device }}-${{ matrix.precision }} path: test-${{ matrix.device }}-${{ matrix.precision }}.out From f83219136f175f115f37cecf35b53ebf716e82e1 Mon Sep 17 00:00:00 2001 From: archithiyer Date: Mon, 2 Dec 2024 17:27:29 -0500 Subject: [PATCH 49/68] CI fix --- .github/workflows/test.yml | 12 +++++++----- toolchain/mfc/test/case.py | 2 +- toolchain/mfc/test/test.py | 4 +--- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 3abfac5d49..92abe6086b 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -1,7 +1,7 @@ name: 'Test Suite' on: [push, pull_request, workflow_dispatch] - + jobs: file-changes: name: Detect File Changes @@ -40,7 +40,7 @@ jobs: precision: debug: no-debug intel: false - - os: ubuntu + - os: macos mpi: mpi precision: single debug: no-debug @@ -153,11 +153,13 @@ jobs: - name: Print Logs if: always() - run: cat test-${{ matrix.device }}-${{ matrix.precision }}.out + run: | + PRECISION=${{ matrix.precision || 'default' }} + cat test-${{ matrix.device }}.out - name: Archive Logs uses: actions/upload-artifact@v4 if: always() with: - name: logs-${{ strategy.job-index }}-${{ matrix.device }}-${{ matrix.precision }} - path: test-${{ matrix.device }}-${{ matrix.precision }}.out + name: logs-${{ strategy.job-index }}-${{ matrix.device }} + path: test-${{ matrix.device }}.out diff --git a/toolchain/mfc/test/case.py b/toolchain/mfc/test/case.py index 4967ef2a60..292b9557a8 100644 --- a/toolchain/mfc/test/case.py +++ b/toolchain/mfc/test/case.py @@ -232,7 +232,7 @@ def compute_tolerance(self) -> float: if self.params.get("hypoelasticity", 'F') == 'T': tolerance = 1e-7 elif self.params.get("mixlayer_perturb", 'F') == 'T': - tolerance = 1e-5 + tolerance = 1e-9 elif any(self.params.get(key, 'F') == 'T' for key in ['relax', 'ib', 'qbmm', 'bubbles']): tolerance = 1e-10 elif self.params.get("low_Mach", 'F') in [1, 2]: diff --git a/toolchain/mfc/test/test.py b/toolchain/mfc/test/test.py index 9f621333bc..8b24d9859f 100644 --- a/toolchain/mfc/test/test.py +++ b/toolchain/mfc/test/test.py @@ -249,7 +249,7 @@ def handle_case(case: TestCase, devices: typing.Set[int]): nAttempts = 0 if ARG('single'): - max_attempts = max(ARG('max_attempts'), 20) + max_attempts = max(ARG('max_attempts'), 3) else: max_attempts = ARG('max_attempts') @@ -261,8 +261,6 @@ def handle_case(case: TestCase, devices: typing.Set[int]): nPASS += 1 except Exception as exc: if nAttempts < max_attempts: - cons.print(f"[bold yellow] Attempt {nAttempts}: Failed test {case.get_uuid()}. Retrying...[/bold yellow]") - errors.append(f"[bold yellow] Attempt {nAttempts}: Failed test {case.get_uuid()}. Retrying...[/bold yellow]") continue nFAIL += 1 cons.print(f"[bold red]Failed test {case} after {nAttempts} attempt(s).[/bold red]") From 36cc17f3977214e0af463e39f583b4f088b2d539 Mon Sep 17 00:00:00 2001 From: archithiyer Date: Mon, 2 Dec 2024 19:46:58 -0500 Subject: [PATCH 50/68] hopefully last commit --- .github/workflows/phoenix/submit.sh | 21 +++----- .github/workflows/phoenix/test.sh | 9 +--- .github/workflows/test.yml | 74 ++++++++++------------------- toolchain/mfc/test/case.py | 2 +- toolchain/mfc/test/test.py | 6 +-- 5 files changed, 39 insertions(+), 73 deletions(-) diff --git a/.github/workflows/phoenix/submit.sh b/.github/workflows/phoenix/submit.sh index cca4e4aca9..9e894abd07 100644 --- a/.github/workflows/phoenix/submit.sh +++ b/.github/workflows/phoenix/submit.sh @@ -6,15 +6,13 @@ usage() { echo "Usage: $0 [script.sh] [cpu|gpu]" } -if [ -z "$1" ] || [ -z "$2" ]; then +if [ ! -z "$1" ]; then + sbatch_script_contents=`cat $1` +else usage exit 1 fi -sbatch_script_contents=`cat $1` - -precision="${3:-}" - sbatch_cpu_opts="\ #SBATCH -p cpu-small # partition #SBATCH --ntasks-per-node=24 # Number of cores per node required @@ -22,7 +20,7 @@ sbatch_cpu_opts="\ " sbatch_gpu_opts="\ -#SBATCH -C V100-16GB +#SBATCH -CV100-16GB #SBATCH -G2\ " @@ -37,30 +35,25 @@ fi job_slug="`basename "$1" | sed 's/\.sh$//' | sed 's/[^a-zA-Z0-9]/-/g'`-$2" -if [ -n "$precision" ]; then - job_slug="$job_slug-$precision" -fi - sbatch <> $GITHUB_ENV echo "BOOST_INCLUDE=/opt/homebrew/include/" >> $GITHUB_ENV - name: Setup Ubuntu - if: matrix.os == 'ubuntu' && matrix.intel == false + if: matrix.os == 'ubuntu' && matrix.intel == false run: | - sudo apt update -y - sudo apt install -y cmake gcc g++ python3 python3-dev hdf5-tools \ - libfftw3-dev libhdf5-dev openmpi-bin libopenmpi-dev + sudo apt update -y + sudo apt install -y cmake gcc g++ python3 python3-dev hdf5-tools \ + libfftw3-dev libhdf5-dev openmpi-bin libopenmpi-dev - name: Setup Ubuntu (Intel) - if: matrix.os == 'ubuntu' && matrix.intel == true + if: matrix.os == 'ubuntu' && matrix.intel == true run: | sudo apt update -y sudo apt install -y tar wget make cmake python3 python3-dev wget https://apt.repos.intel.com/intel-gpg-keys/GPG-PUB-KEY-INTEL-SW-PRODUCTS.PUB sudo apt-key add GPG-PUB-KEY-INTEL-SW-PRODUCTS.PUB rm GPG-PUB-KEY-INTEL-SW-PRODUCTS.PUB - echo "deb https://apt.repos.intel.com/oneapi all main" | sudo tee /etc/apt/sources.list.d/oneAPI.list + sudo echo "deb https://apt.repos.intel.com/oneapi all main" | sudo tee /etc/apt/sources.list.d/oneAPI.list sudo apt-get update - sudo apt-get install -y intel-oneapi-common-vars intel-oneapi-compiler-fortran-2022.1.0 \ - intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic-2022.1.0 intel-oneapi-mkl-2021.4.0 \ - intel-oneapi-mpi-2021.7.1 intel-oneapi-mpi-devel-2021.7.1 + sudo apt-get install -y intel-oneapi-common-vars intel-oneapi-compiler-fortran-2022.1.0 intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic-2022.1.0 intel-oneapi-mkl-2021.4.0 intel-oneapi-mpi-2021.7.1 intel-oneapi-mpi-devel-2021.7.1 source /opt/intel/oneapi/setvars.sh echo "CXX=$(which icpc)" >> $GITHUB_ENV echo "CC=$(which icc)" >> $GITHUB_ENV @@ -91,22 +84,14 @@ jobs: echo "I_MPI_ROOT=/opt/intel/oneapi/mpi/2021.7.1/" >> $GITHUB_ENV - name: Build - run: | + run: | if [ '${{ matrix.intel }}' == 'true' ]; then . /opt/intel/oneapi/setvars.sh; fi - precision_flag="" - if [ "${{ matrix.precision }}" == "single" ]; then - precision_flag="--single" - fi - /bin/bash mfc.sh build -j $(nproc) --${{ matrix.debug }} --${{ matrix.mpi }} $precision_flag + /bin/bash mfc.sh build -j $(nproc) --${{ matrix.debug }} --${{ matrix.mpi }} --${{ matrix.precision }} - name: Test - run: | + run: | if [ '${{ matrix.intel }}' == 'true' ]; then . /opt/intel/oneapi/setvars.sh; fi - precision_flag="" - if [ "${{ matrix.precision }}" == "single" ]; then - precision_flag="--single" - fi - /bin/bash mfc.sh test --max-attempts 3 -j $(nproc) $OPT1 $OPT2 $precision_flag + /bin/bash mfc.sh test --max-attempts 3 -j $(nproc) $OPT1 $OPT2 env: OPT1: ${{ matrix.mpi == 'mpi' && '--test-all' || '' }} OPT2: ${{ matrix.debug == 'debug' && '-% 20' || '' }} @@ -121,16 +106,11 @@ jobs: matrix: device: ['cpu', 'gpu'] lbl: ['gt', 'frontier'] - precision: [''] exclude: - device: cpu lbl: frontier - include: - - device: gpu - lbl: gt - precision: single runs-on: - group: phoenix + group: phoenix labels: ${{ matrix.lbl }} env: ACTIONS_RUNNER_FORCE_ACTIONS_NODE_VERSION: node16 @@ -140,26 +120,24 @@ jobs: uses: actions/checkout@v4 - name: Build & Test - if: matrix.lbl == 'gt' - run: bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/test.sh ${{ matrix.device }} ${{ matrix.precision }} + if: matrix.lbl == 'gt' + run: bash .github/workflows/phoenix/submit.sh .github/workflows/phoenix/test.sh ${{ matrix.device }} - name: Build - if: matrix.lbl == 'frontier' - run: bash .github/workflows/frontier/build.sh + if: matrix.lbl == 'frontier' + run: bash .github/workflows/frontier/build.sh - name: Test - if: matrix.lbl == 'frontier' - run: bash .github/workflows/frontier/submit.sh .github/workflows/frontier/test.sh ${{ matrix.device }} ${{ matrix.precision }} + if: matrix.lbl == 'frontier' + run: bash .github/workflows/frontier/submit.sh .github/workflows/frontier/test.sh ${{matrix.device}} - name: Print Logs - if: always() - run: | - PRECISION=${{ matrix.precision || 'default' }} - cat test-${{ matrix.device }}.out + if: always() + run: cat test-${{ matrix.device }}.out - name: Archive Logs uses: actions/upload-artifact@v4 - if: always() + if: always() with: name: logs-${{ strategy.job-index }}-${{ matrix.device }} - path: test-${{ matrix.device }}.out + path: test-${{ matrix.device }}.out \ No newline at end of file diff --git a/toolchain/mfc/test/case.py b/toolchain/mfc/test/case.py index 292b9557a8..c73714f1e0 100644 --- a/toolchain/mfc/test/case.py +++ b/toolchain/mfc/test/case.py @@ -232,7 +232,7 @@ def compute_tolerance(self) -> float: if self.params.get("hypoelasticity", 'F') == 'T': tolerance = 1e-7 elif self.params.get("mixlayer_perturb", 'F') == 'T': - tolerance = 1e-9 + tolerance = 1e-7 elif any(self.params.get(key, 'F') == 'T' for key in ['relax', 'ib', 'qbmm', 'bubbles']): tolerance = 1e-10 elif self.params.get("low_Mach", 'F') in [1, 2]: diff --git a/toolchain/mfc/test/test.py b/toolchain/mfc/test/test.py index 8b24d9859f..208ae005cb 100644 --- a/toolchain/mfc/test/test.py +++ b/toolchain/mfc/test/test.py @@ -59,8 +59,8 @@ def __filter(cases_) -> typing.List[TestCase]: for case in cases[:]: if ARG("single"): - skip = ['low_Mach', 'Hypoelasticity', 'teno', 'Chemistry', 'mixlayer_perturb'] - if any(label in case.trace for label in skip): + skip = ['low_Mach', 'Hypoelasticity', 'teno', 'Non_polytropic'] + if any(label in case.trace for label in skip) or ('3D' in case.trace and 'QBBM' in case.trace): cases.remove(case) @@ -249,7 +249,7 @@ def handle_case(case: TestCase, devices: typing.Set[int]): nAttempts = 0 if ARG('single'): - max_attempts = max(ARG('max_attempts'), 3) + max_attempts = max(ARG('max_attempts'), 20) else: max_attempts = ARG('max_attempts') From f7c5255162ff659790829574241607734ddf87fa Mon Sep 17 00:00:00 2001 From: archithiyer Date: Mon, 2 Dec 2024 23:27:24 -0500 Subject: [PATCH 51/68] chemistry --- toolchain/mfc/test/test.py | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/toolchain/mfc/test/test.py b/toolchain/mfc/test/test.py index 208ae005cb..36474edff4 100644 --- a/toolchain/mfc/test/test.py +++ b/toolchain/mfc/test/test.py @@ -59,8 +59,8 @@ def __filter(cases_) -> typing.List[TestCase]: for case in cases[:]: if ARG("single"): - skip = ['low_Mach', 'Hypoelasticity', 'teno', 'Non_polytropic'] - if any(label in case.trace for label in skip) or ('3D' in case.trace and 'QBBM' in case.trace): + skip = ['low_Mach', 'Hypoelasticity', 'teno', 'Chemistry', 'Phase Change model 6'] + if any(label in case.trace for label in skip): cases.remove(case) @@ -248,7 +248,7 @@ def handle_case(case: TestCase, devices: typing.Set[int]): global errors nAttempts = 0 - if ARG('single'): + if ARG('single') and ARG('test_all'): max_attempts = max(ARG('max_attempts'), 20) else: max_attempts = ARG('max_attempts') From 0ee745414cc60d0c5550824a9fbd3b220bfb60cf Mon Sep 17 00:00:00 2001 From: archithiyer Date: Wed, 4 Dec 2024 21:55:00 -0500 Subject: [PATCH 52/68] fix minor issues --- examples/3D_performance_test/case.py | 6 ++-- src/common/m_constants.fpp | 10 +++---- src/pre_process/m_check_ib_patches.fpp | 12 ++++---- src/pre_process/m_compute_levelset.fpp | 12 ++++---- src/pre_process/m_global_parameters.fpp | 6 ++-- src/pre_process/m_model.fpp | 36 +++++++++++------------ src/simulation/m_bubbles.fpp | 12 ++++---- src/simulation/m_cbc.fpp | 38 ++++++++++++------------- src/simulation/m_checker.fpp | 10 +++++++ toolchain/mfc/test/test.py | 7 +++-- 10 files changed, 80 insertions(+), 69 deletions(-) diff --git a/examples/3D_performance_test/case.py b/examples/3D_performance_test/case.py index d1fc4c77a2..00a368cc7b 100644 --- a/examples/3D_performance_test/case.py +++ b/examples/3D_performance_test/case.py @@ -28,9 +28,9 @@ 'z_a' : -1.5E-03/1.E-03, 'z_b' : 1.5E-03/1.E-03, 'cyl_coord' : 'F', - 'm' : 200, - 'n' : 200, - 'p' : 200, + 'm' : 100, + 'n' : 100, + 'p' : 100, 'dt' : 0.2E-09/1.E-03, 't_step_start' : 0, 't_step_stop' : 30, diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp index 51895219bc..505ea65410 100644 --- a/src/common/m_constants.fpp +++ b/src/common/m_constants.fpp @@ -35,10 +35,10 @@ module m_constants integer, parameter :: Ifactor_3D = 5 !< Multiple factor of the ratio (edge to cell width) for interpolation along edges for 3D models integer, parameter :: Ifactor_bary_3D = 20 !< Multiple factor of the ratio (triangle area to cell face area) for interpolation on triangle facets for 3D models integer, parameter :: num_ray = 20 !< Default number of rays traced per cell - real(wp), parameter :: ray_tracing_threshold = 0.9d0 !< Threshold above which the cell is marked as the model patch - real(wp), parameter :: threshold_vector_zero = 1d-10 !< Threshold to treat the component of a vector to be zero - real(wp), parameter :: threshold_edge_zero = 1d-10 !< Threshold to treat two edges to be overlapped - real(wp), parameter :: threshold_bary = 1d-1 !< Threshold to interpolate a barycentric facet - real(wp), parameter :: initial_distance_buffer = 1d12 !< Initialized levelset distance for the shortest path pair algorithm + real(wp), parameter :: ray_tracing_threshold = 0.9_wp !< Threshold above which the cell is marked as the model patch + real(wp), parameter :: threshold_vector_zero = 1e-10 !< Threshold to treat the component of a vector to be zero + real(wp), parameter :: threshold_edge_zero = 1e-10 !< Threshold to treat two edges to be overlapped + real(wp), parameter :: threshold_bary = 1e-1 !< Threshold to interpolate a barycentric facet + real(wp), parameter :: initial_distance_buffer = 1e-12 !< Initialized levelset distance for the shortest path pair algorithm end module m_constants diff --git a/src/pre_process/m_check_ib_patches.fpp b/src/pre_process/m_check_ib_patches.fpp index 4267b9dc80..d5ab5c5a72 100644 --- a/src/pre_process/m_check_ib_patches.fpp +++ b/src/pre_process/m_check_ib_patches.fpp @@ -209,11 +209,11 @@ contains .or. & f_is_default(patch_ib(patch_id)%z_centroid) & .or. & - patch_ib(patch_id)%length_x <= 0d0 & + patch_ib(patch_id)%length_x <= 0._wp & .or. & - patch_ib(patch_id)%length_y <= 0d0 & + patch_ib(patch_id)%length_y <= 0._wp & .or. & - patch_ib(patch_id)%length_z <= 0d0, & + patch_ib(patch_id)%length_z <= 0._wp, & 'in cuboid IB patch '//trim(iStr)) end subroutine s_check_cuboid_ib_patch_geometry @@ -272,11 +272,11 @@ contains @:PROHIBIT(patch_ib(patch_id)%model_filepath == dflt_char, & 'Empty model file path for patch '//trim(iStr)) - @:PROHIBIT(patch_ib(patch_id)%model_scale(1) <= 0d0 & + @:PROHIBIT(patch_ib(patch_id)%model_scale(1) <= 0._wp & .or. & - patch_ib(patch_id)%model_scale(2) <= 0d0 & + patch_ib(patch_id)%model_scale(2) <= 0._wp & .or. & - patch_ib(patch_id)%model_scale(3) <= 0d0, & + patch_ib(patch_id)%model_scale(3) <= 0._wp, & 'Negative scale in model IB patch '//trim(iStr)) end subroutine s_check_model_ib_patch_geometry diff --git a/src/pre_process/m_compute_levelset.fpp b/src/pre_process/m_compute_levelset.fpp index 555c513358..a79b26c0fd 100644 --- a/src/pre_process/m_compute_levelset.fpp +++ b/src/pre_process/m_compute_levelset.fpp @@ -407,7 +407,7 @@ contains if (min_dist == abs(side_dists(1))) then levelset%sf(i, j, k, ib_patch_id) = side_dists(1) if (side_dists(1) == 0) then - levelset_norm%sf(i, j, k, ib_patch_id, 1) = 0d0 + levelset_norm%sf(i, j, k, ib_patch_id, 1) = 0._wp else levelset_norm%sf(i, j, k, ib_patch_id, 1) = side_dists(1)/ & abs(side_dists(1)) @@ -416,7 +416,7 @@ contains else if (min_dist == abs(side_dists(2))) then levelset%sf(i, j, k, ib_patch_id) = side_dists(2) if (side_dists(2) == 0) then - levelset_norm%sf(i, j, k, ib_patch_id, 1) = 0d0 + levelset_norm%sf(i, j, k, ib_patch_id, 1) = 0._wp else levelset_norm%sf(i, j, k, ib_patch_id, 1) = -side_dists(2)/ & abs(side_dists(2)) @@ -425,7 +425,7 @@ contains else if (min_dist == abs(side_dists(3))) then levelset%sf(i, j, k, ib_patch_id) = side_dists(3) if (side_dists(3) == 0) then - levelset_norm%sf(i, j, k, ib_patch_id, 2) = 0d0 + levelset_norm%sf(i, j, k, ib_patch_id, 2) = 0._wp else levelset_norm%sf(i, j, k, ib_patch_id, 2) = side_dists(3)/ & abs(side_dists(3)) @@ -434,7 +434,7 @@ contains else if (min_dist == abs(side_dists(4))) then levelset%sf(i, j, k, ib_patch_id) = side_dists(4) if (side_dists(4) == 0) then - levelset_norm%sf(i, j, k, ib_patch_id, 2) = 0d0 + levelset_norm%sf(i, j, k, ib_patch_id, 2) = 0._wp else levelset_norm%sf(i, j, k, ib_patch_id, 2) = -side_dists(4)/ & abs(side_dists(4)) @@ -443,7 +443,7 @@ contains else if (min_dist == abs(side_dists(5))) then levelset%sf(i, j, k, ib_patch_id) = side_dists(5) if (side_dists(5) == 0) then - levelset_norm%sf(i, j, k, ib_patch_id, 3) = 0d0 + levelset_norm%sf(i, j, k, ib_patch_id, 3) = 0._wp else levelset_norm%sf(i, j, k, ib_patch_id, 3) = side_dists(5)/ & abs(side_dists(5)) @@ -452,7 +452,7 @@ contains else if (min_dist == abs(side_dists(6))) then levelset%sf(i, j, k, ib_patch_id) = side_dists(6) if (side_dists(6) == 0) then - levelset_norm%sf(i, j, k, ib_patch_id, 3) = 0d0 + levelset_norm%sf(i, j, k, ib_patch_id, 3) = 0._wp else levelset_norm%sf(i, j, k, ib_patch_id, 3) = -side_dists(6)/ & abs(side_dists(6)) diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index c849799621..215bda6348 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -447,9 +447,9 @@ contains patch_ib(i)%slip = .false. ! Proper default values for translating STL models - patch_ib(i)%model_scale(:) = 1d0 - patch_ib(i)%model_translate(:) = 0d0 - patch_ib(i)%model_rotate(:) = 0d0 + patch_ib(i)%model_scale(:) = 1._wp + patch_ib(i)%model_translate(:) = 0._wp + patch_ib(i)%model_rotate(:) = 0._wp patch_ib(i)%model_filepath(:) = dflt_char patch_ib(i)%model_spc = num_ray patch_ib(i)%model_threshold = ray_tracing_threshold diff --git a/src/pre_process/m_model.fpp b/src/pre_process/m_model.fpp index 7dd78b1578..b820352e59 100644 --- a/src/pre_process/m_model.fpp +++ b/src/pre_process/m_model.fpp @@ -680,12 +680,12 @@ contains edgetan = boundary_edge(1)/boundary_edge(2) if (abs(boundary_edge(2)) < threshold_vector_zero) then - if (edgetan > 0d0) then + if (edgetan > 0._wp) then ynormal = -1 - xnormal = 0d0 + xnormal = 0._wp else ynormal = 1 - xnormal = 0d0 + xnormal = 0._wp end if else initial = boundary_edge(2) @@ -860,13 +860,13 @@ contains edge_del(2) = (edge_y(2) - edge_y(1))/num_segments else num_segments = 1 - edge_del(1) = 0d0 - edge_del(2) = 0d0 + edge_del(1) = 0._wp + edge_del(2) = 0._wp end if interpolated_boundary_v(1, 1) = edge_x(1) interpolated_boundary_v(1, 2) = edge_y(1) - interpolated_boundary_v(1, 3) = 0d0 + interpolated_boundary_v(1, 3) = 0._wp ! Add original and interpolated vertices to the output array do j = 1, num_segments - 1 @@ -987,7 +987,7 @@ contains edge_del(3) = (tri(2, 3) - tri(1, 3))/num_segments else num_segments = 1 - edge_del = 0d0 + edge_del = 0._wp end if ! Add original and interpolated vertices to the output array @@ -1020,11 +1020,11 @@ contains call random_number(bary_coord(1)) call random_number(bary_coord(2)) - if ((bary_coord(1) + bary_coord(2)) >= 1.0d0) then - bary_coord(1) = 1d0 - bary_coord(1) - bary_coord(2) = 1d0 - bary_coord(2) + if ((bary_coord(1) + bary_coord(2)) >= 1._wp) then + bary_coord(1) = 1._wp - bary_coord(1) + bary_coord(2) = 1._wp - bary_coord(2) end if - bary_coord(3) = 1d0 - bary_coord(1) - bary_coord(2) + bary_coord(3) = 1._wp - bary_coord(1) - bary_coord(2) total_vertices = total_vertices + 1 interpolated_boundary_v(total_vertices, 1) = dot_product(bary_coord, tri(1:3, 1)) @@ -1055,9 +1055,9 @@ contains t_vec3 :: dist_buffer !< Distance between the cell center and the vertices integer :: i, j, tri_idx !< Iterator - dist_min = 1d12 - dist_min_normal = 1d12 - distance = 0d0 + dist_min = 1e-12 + dist_min_normal = 1e-12 + distance = 0._wp tri_idx = 0 do i = 1, model%ntrs @@ -1115,7 +1115,7 @@ contains real(wp), dimension(1:boundary_edge_count) :: dist_buffer real(wp) :: distance - distance = 0d0 + distance = 0._wp do i = 1, boundary_edge_count dist_buffer1 = sqrt((point(1) - boundary_v(i, 1, 1))**2 + & & (point(2) - boundary_v(i, 1, 2))**2) @@ -1148,14 +1148,14 @@ contains real(wp) :: dist_min, dist_buffer real(wp) :: midp(1:3) - dist_buffer = 0d0 + dist_buffer = 0._wp dist_min = initial_distance_buffer idx_buffer = 0 do i = 1, boundary_edge_count midp(1) = (boundary_v(i, 2, 1) + boundary_v(i, 1, 1))/2 midp(2) = (boundary_v(i, 2, 2) + boundary_v(i, 1, 2))/2 - midp(3) = 0d0 + midp(3) = 0._wp dist_buffer = sqrt((point(1) - midp(1))**2 + & & (point(2) - midp(2))**2) @@ -1168,7 +1168,7 @@ contains normals(1) = boundary_v(idx_buffer, 3, 1) normals(2) = boundary_v(idx_buffer, 3, 2) - normals(3) = 0d0 + normals(3) = 0._wp end subroutine f_normals diff --git a/src/simulation/m_bubbles.fpp b/src/simulation/m_bubbles.fpp index 4a85490f2c..4beb033520 100644 --- a/src/simulation/m_bubbles.fpp +++ b/src/simulation/m_bubbles.fpp @@ -21,9 +21,9 @@ module m_bubbles implicit none - real(kind(0._wp)) :: chi_vw !< Bubble wall properties (Ando 2010) - real(kind(0._wp)) :: k_mw !< Bubble wall properties (Ando 2010) - real(kind(0._wp)) :: rho_mw !< Bubble wall properties (Ando 2010) + real(wp) :: chi_vw !< Bubble wall properties (Ando 2010) + real(wp) :: k_mw !< Bubble wall properties (Ando 2010) + real(wp) :: rho_mw !< Bubble wall properties (Ando 2010) !$acc declare create(chi_vw, k_mw, rho_mw) real(wp), allocatable, dimension(:, :, :) :: bub_adv_src @@ -887,9 +887,9 @@ contains real(wp), intent(in) :: fmass_v integer, intent(in) :: iR0 - real(kind(0._wp)) :: T_bar - real(kind(0._wp)) :: grad_T - real(kind(0._wp)) :: f_bpres_dot + real(wp) :: T_bar + real(wp) :: grad_T + real(wp) :: f_bpres_dot if (thermal == 3) then T_bar = Tw*(fpb/pb0(iR0))*(fR/R0(iR0))**3 & diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index 85efd61686..d888a3f915 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -883,7 +883,7 @@ contains if (bc_${XYZ}$%grcbc_in) then !$acc loop seq do i = 2, momxb - L(2) = c**3d0*Ma*(alpha_rho(i - 1) - alpha_rho_in(i - 1, ${CBC_DIR}$))/Del_in(${CBC_DIR}$) - c*Ma*(pres - pres_in(${CBC_DIR}$))/Del_in(${CBC_DIR}$) + L(2) = c**3._wp*Ma*(alpha_rho(i - 1) - alpha_rho_in(i - 1, ${CBC_DIR}$))/Del_in(${CBC_DIR}$) - c*Ma*(pres - pres_in(${CBC_DIR}$))/Del_in(${CBC_DIR}$) end do if (n > 0) then L(momxb + 1) = c*Ma*(vel(dir_idx(2)) - vel_in(${CBC_DIR}$, dir_idx(2)))/Del_in(${CBC_DIR}$) @@ -895,17 +895,17 @@ contains do i = E_idx, advxe - 1 L(i) = c*Ma*(adv(i + 1 - E_idx) - alpha_in(i + 1 - E_idx, ${CBC_DIR}$))/Del_in(${CBC_DIR}$) end do - L(advxe) = rho*c**2d0*(1d0 + Ma)*(vel(dir_idx(1)) + vel_in(${CBC_DIR}$, dir_idx(1))*sign(1, cbc_loc))/Del_in(${CBC_DIR}$) + c*(1d0 + Ma)*(pres - pres_in(${CBC_DIR}$))/Del_in(${CBC_DIR}$) + L(advxe) = rho*c**2._wp*(1._wp + Ma)*(vel(dir_idx(1)) + vel_in(${CBC_DIR}$, dir_idx(1))*sign(1, cbc_loc))/Del_in(${CBC_DIR}$) + c*(1._wp + Ma)*(pres - pres_in(${CBC_DIR}$))/Del_in(${CBC_DIR}$) end if else if ((cbc_loc == -1 .and. bc${XYZ}$b == -8) .or. (cbc_loc == 1 .and. bc${XYZ}$e == -8)) then call s_compute_nonreflecting_subsonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) ! Add GRCBC for Subsonic Outflow (Pressure) if (bc_${XYZ}$%grcbc_out) then - L(advxe) = c*(1d0 - Ma)*(pres - pres_out(${CBC_DIR}$))/Del_out(${CBC_DIR}$) + L(advxe) = c*(1._wp - Ma)*(pres - pres_out(${CBC_DIR}$))/Del_out(${CBC_DIR}$) ! Add GRCBC for Subsonic Outflow (Normal Velocity) if (bc_${XYZ}$%grcbc_vel_out) then - L(advxe) = L(advxe) + rho*c**2d0*(1d0 - Ma)*(vel(dir_idx(1)) + vel_out(${CBC_DIR}$, dir_idx(1))*sign(1, cbc_loc))/Del_out(${CBC_DIR}$) + L(advxe) = L(advxe) + rho*c**2._wp*(1._wp - Ma)*(vel(dir_idx(1)) + vel_out(${CBC_DIR}$, dir_idx(1))*sign(1, cbc_loc))/Del_out(${CBC_DIR}$) end if end if else if ((cbc_loc == -1 .and. bc${XYZ}$b == -9) .or. (cbc_loc == 1 .and. bc${XYZ}$e == -9)) then @@ -1112,7 +1112,7 @@ contains do j = 0, buff_size q_prim_rsx_vf(j, k, r, momxb) = & q_prim_vf(momxb)%sf(dj*(m - 2*j) + j, k, r)* & - sign(1._wp, -real(cbc_loc, kind(0._wp))) + sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1124,7 +1124,7 @@ contains do j = -1, buff_size flux_rsx_vf_l(j, k, r, i) = & flux_vf(i)%sf(dj*((m - 1) - 2*j) + j, k, r)* & - sign(1._wp, -real(cbc_loc, kind(0._wp))) + sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1159,7 +1159,7 @@ contains do j = -1, buff_size flux_src_rsx_vf_l(j, k, r, advxb) = & flux_src_vf(advxb)%sf(dj*((m - 1) - 2*j) + j, k, r)* & - sign(1._wp, -real(cbc_loc, kind(0._wp))) + sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1188,7 +1188,7 @@ contains do j = 0, buff_size q_prim_rsy_vf(j, k, r, momxb + 1) = & q_prim_vf(momxb + 1)%sf(k, dj*(n - 2*j) + j, r)* & - sign(1._wp, -real(cbc_loc, kind(0._wp))) + sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1200,7 +1200,7 @@ contains do j = -1, buff_size flux_rsy_vf_l(j, k, r, i) = & flux_vf(i)%sf(k, dj*((n - 1) - 2*j) + j, r)* & - sign(1._wp, -real(cbc_loc, kind(0._wp))) + sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1235,7 +1235,7 @@ contains do j = -1, buff_size flux_src_rsy_vf_l(j, k, r, advxb) = & flux_src_vf(advxb)%sf(k, dj*((n - 1) - 2*j) + j, r)* & - sign(1._wp, -real(cbc_loc, kind(0._wp))) + sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1264,7 +1264,7 @@ contains do j = 0, buff_size q_prim_rsz_vf(j, k, r, momxe) = & q_prim_vf(momxe)%sf(r, k, dj*(p - 2*j) + j)* & - sign(1._wp, -real(cbc_loc, kind(0._wp))) + sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1276,7 +1276,7 @@ contains do j = -1, buff_size flux_rsz_vf_l(j, k, r, i) = & flux_vf(i)%sf(r, k, dj*((p - 1) - 2*j) + j)* & - sign(1._wp, -real(cbc_loc, kind(0._wp))) + sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1311,7 +1311,7 @@ contains do j = -1, buff_size flux_src_rsz_vf_l(j, k, r, advxb) = & flux_src_vf(advxb)%sf(r, k, dj*((p - 1) - 2*j) + j)* & - sign(1._wp, -real(cbc_loc, kind(0._wp))) + sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1361,7 +1361,7 @@ contains do j = -1, buff_size flux_vf(i)%sf(dj*((m - 1) - 2*j) + j, k, r) = & flux_rsx_vf_l(j, k, r, i)* & - sign(1._wp, -real(cbc_loc, kind(0._wp))) + sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1395,7 +1395,7 @@ contains do j = -1, buff_size flux_src_vf(advxb)%sf(dj*((m - 1) - 2*j) + j, k, r) = & flux_src_rsx_vf_l(j, k, r, advxb)* & - sign(1._wp, -real(cbc_loc, kind(0._wp))) + sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1412,7 +1412,7 @@ contains do j = -1, buff_size flux_vf(i)%sf(k, dj*((n - 1) - 2*j) + j, r) = & flux_rsy_vf_l(j, k, r, i)* & - sign(1._wp, -real(cbc_loc, kind(0._wp))) + sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1447,7 +1447,7 @@ contains do j = -1, buff_size flux_src_vf(advxb)%sf(k, dj*((n - 1) - 2*j) + j, r) = & flux_src_rsy_vf_l(j, k, r, advxb)* & - sign(1._wp, -real(cbc_loc, kind(0._wp))) + sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1465,7 +1465,7 @@ contains do j = -1, buff_size flux_vf(i)%sf(r, k, dj*((p - 1) - 2*j) + j) = & flux_rsz_vf_l(j, k, r, i)* & - sign(1._wp, -real(cbc_loc, kind(0._wp))) + sign(1._wp, -1._wp*cbc_loc) end do end do end do @@ -1500,7 +1500,7 @@ contains do j = -1, buff_size flux_src_vf(advxb)%sf(r, k, dj*((p - 1) - 2*j) + j) = & flux_src_rsz_vf_l(j, k, r, advxb)* & - sign(1._wp, -real(cbc_loc, kind(0._wp))) + sign(1._wp, -1._wp*cbc_loc) end do end do end do diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index 79098e1cc5..933f4e9954 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -39,6 +39,7 @@ contains call s_check_inputs_body_forces call s_check_inputs_misc call s_check_inputs_grcbc + call s_check_inputs_geometry_precision end subroutine s_check_inputs @@ -51,6 +52,7 @@ contains #ifndef MFC_cuTENSOR @:PROHIBIT(cu_tensor, "MFC was not built with the NVIDIA cuTENSOR library") #endif + end subroutine s_check_inputs_compilers !> Checks constraints on WENO scheme parameters @@ -97,6 +99,14 @@ contains @:PROHIBIT(low_Mach /= 0 .and. model_eqns /= 2, "low_Mach = 1 or 2 requires model_eqns = 2") end subroutine s_check_inputs_riemann_solver + !> Checks constraints on geometry and precision + subroutine s_check_inputs_geometry_precision + ! Prevent spherical geometry in single precision +#ifdef MFC_SINGLE_PRECISION + @:PROHIBIT(.not. (cyl_coord .neqv. .true. .or. (cyl_coord .and. p == 0)), "Fully 3D cylindrical grid (geometry = 3) is not supported in single precision.") +#endif + end subroutine s_check_inputs_geometry_precision + !> Checks constraints on time stepping parameters subroutine s_check_inputs_time_stepping if (.not. cfl_dt) then diff --git a/toolchain/mfc/test/test.py b/toolchain/mfc/test/test.py index 36474edff4..d40a079ff1 100644 --- a/toolchain/mfc/test/test.py +++ b/toolchain/mfc/test/test.py @@ -53,13 +53,14 @@ def __filter(cases_) -> typing.List[TestCase]: cases.remove(case) for case in cases[:]: - if case.ppn > 1 and not ARG("mpi"): + if case.ppn > 1 and not ARG("mpi") or 'IBM' in case.trace: cases.remove(case) skipped_cases.append(case) - + for case in cases[:]: if ARG("single"): - skip = ['low_Mach', 'Hypoelasticity', 'teno', 'Chemistry', 'Phase Change model 6'] + skip = ['low_Mach', 'Hypoelasticity', 'teno', 'Chemistry', 'Phase Change model 6' + ,'Axisymmetric', 'Transducer', 'Transducer Array', 'Cylindrical'] if any(label in case.trace for label in skip): cases.remove(case) From e794af476f62ae1d81de7c58a70c594ecee5f63e Mon Sep 17 00:00:00 2001 From: archithiyer Date: Thu, 5 Dec 2024 15:35:50 -0500 Subject: [PATCH 53/68] fix issue with IBM --- src/common/m_constants.fpp | 4 ++-- src/pre_process/m_model.fpp | 8 ++++---- toolchain/mfc/test/test.py | 8 ++++---- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp index 505ea65410..4f5b703030 100644 --- a/src/common/m_constants.fpp +++ b/src/common/m_constants.fpp @@ -39,6 +39,6 @@ module m_constants real(wp), parameter :: threshold_vector_zero = 1e-10 !< Threshold to treat the component of a vector to be zero real(wp), parameter :: threshold_edge_zero = 1e-10 !< Threshold to treat two edges to be overlapped real(wp), parameter :: threshold_bary = 1e-1 !< Threshold to interpolate a barycentric facet - real(wp), parameter :: initial_distance_buffer = 1e-12 !< Initialized levelset distance for the shortest path pair algorithm + real(wp), parameter :: initial_distance_buffer = 1e12 !< Initialized levelset distance for the shortest path pair algorithm -end module m_constants +end module m_constants \ No newline at end of file diff --git a/src/pre_process/m_model.fpp b/src/pre_process/m_model.fpp index b820352e59..529cb3ca47 100644 --- a/src/pre_process/m_model.fpp +++ b/src/pre_process/m_model.fpp @@ -1055,8 +1055,8 @@ contains t_vec3 :: dist_buffer !< Distance between the cell center and the vertices integer :: i, j, tri_idx !< Iterator - dist_min = 1e-12 - dist_min_normal = 1e-12 + dist_min = 1e12 + dist_min_normal = 1e12 distance = 0._wp tri_idx = 0 @@ -1221,8 +1221,8 @@ contains cross(1) = AB(2)*AC(3) - AB(3)*AC(2) cross(2) = AB(3)*AC(1) - AB(1)*AC(3) cross(3) = AB(1)*AC(2) - AB(2)*AC(1) - tri_area = 0.5d0*sqrt(cross(1)**2 + cross(2)**2 + cross(3)**2) + tri_area = 0.5_wp*sqrt(cross(1)**2 + cross(2)**2 + cross(3)**2) end function f_tri_area -end module m_model +end module m_model \ No newline at end of file diff --git a/toolchain/mfc/test/test.py b/toolchain/mfc/test/test.py index 303f4354d6..7165690795 100644 --- a/toolchain/mfc/test/test.py +++ b/toolchain/mfc/test/test.py @@ -53,14 +53,14 @@ def __filter(cases_) -> typing.List[TestCase]: cases.remove(case) for case in cases[:]: - if case.ppn > 1 and not ARG("mpi") or 'IBM' in case.trace: + if case.ppn > 1 and not ARG("mpi"): cases.remove(case) skipped_cases.append(case) for case in cases[:]: if ARG("single"): skip = ['low_Mach', 'Hypoelasticity', 'teno', 'Chemistry', 'Phase Change model 6' - ,'Axisymmetric', 'Transducer', 'Transducer Array', 'Cylindrical'] + ,'Axisymmetric', 'Transducer', 'Transducer Array', 'Cylindrical', 'Example'] if any(label in case.trace for label in skip): cases.remove(case) @@ -248,8 +248,8 @@ def handle_case(case: TestCase, devices: typing.Set[int]): global errors nAttempts = 0 - if ARG('single') and ARG('test_all'): - max_attempts = max(ARG('max_attempts'), 20) + if ARG('single'): + max_attempts = max(ARG('max_attempts'), 3) else: max_attempts = ARG('max_attempts') From bc53b9bfc4b15ce634ca6a59efc2455c8c5314ec Mon Sep 17 00:00:00 2001 From: archithiyer Date: Thu, 5 Dec 2024 16:56:55 -0500 Subject: [PATCH 54/68] format --- src/common/m_constants.fpp | 2 +- src/pre_process/m_model.fpp | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp index 4f5b703030..511261fab7 100644 --- a/src/common/m_constants.fpp +++ b/src/common/m_constants.fpp @@ -41,4 +41,4 @@ module m_constants real(wp), parameter :: threshold_bary = 1e-1 !< Threshold to interpolate a barycentric facet real(wp), parameter :: initial_distance_buffer = 1e12 !< Initialized levelset distance for the shortest path pair algorithm -end module m_constants \ No newline at end of file +end module m_constants diff --git a/src/pre_process/m_model.fpp b/src/pre_process/m_model.fpp index 529cb3ca47..68f675f776 100644 --- a/src/pre_process/m_model.fpp +++ b/src/pre_process/m_model.fpp @@ -1225,4 +1225,4 @@ contains end function f_tri_area -end module m_model \ No newline at end of file +end module m_model From 2e6a1cedd684b235a7c0ef0b7a2f6ff15a2dbcb8 Mon Sep 17 00:00:00 2001 From: aricer123 <107273558+aricer123@users.noreply.github.com> Date: Thu, 5 Dec 2024 17:27:03 -0500 Subject: [PATCH 55/68] Update m_model.fpp --- src/pre_process/m_model.fpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/pre_process/m_model.fpp b/src/pre_process/m_model.fpp index 68f675f776..1e8df1621d 100644 --- a/src/pre_process/m_model.fpp +++ b/src/pre_process/m_model.fpp @@ -1055,8 +1055,8 @@ contains t_vec3 :: dist_buffer !< Distance between the cell center and the vertices integer :: i, j, tri_idx !< Iterator - dist_min = 1e12 - dist_min_normal = 1e12 + dist_min = 1e12_wp + dist_min_normal = 1e12_wp distance = 0._wp tri_idx = 0 From c39586806edb14d094971f7797e0594b0ac4bd93 Mon Sep 17 00:00:00 2001 From: aricer123 <107273558+aricer123@users.noreply.github.com> Date: Thu, 5 Dec 2024 17:28:42 -0500 Subject: [PATCH 56/68] satiate linter --- src/common/m_constants.fpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/common/m_constants.fpp b/src/common/m_constants.fpp index 511261fab7..2705df922b 100644 --- a/src/common/m_constants.fpp +++ b/src/common/m_constants.fpp @@ -39,6 +39,6 @@ module m_constants real(wp), parameter :: threshold_vector_zero = 1e-10 !< Threshold to treat the component of a vector to be zero real(wp), parameter :: threshold_edge_zero = 1e-10 !< Threshold to treat two edges to be overlapped real(wp), parameter :: threshold_bary = 1e-1 !< Threshold to interpolate a barycentric facet - real(wp), parameter :: initial_distance_buffer = 1e12 !< Initialized levelset distance for the shortest path pair algorithm + real(wp), parameter :: initial_distance_buffer = 1e12_wp !< Initialized levelset distance for the shortest path pair algorithm end module m_constants From b0fee458879d56d4d51f51966c92ec035c45dd0b Mon Sep 17 00:00:00 2001 From: archithiyer Date: Fri, 13 Dec 2024 15:56:44 -0800 Subject: [PATCH 57/68] add documentation --- README.md | 4 ++++ docs/documentation/getting-started.md | 1 + 2 files changed, 5 insertions(+) diff --git a/README.md b/README.md index 6f89bbb731..3389102491 100644 --- a/README.md +++ b/README.md @@ -85,6 +85,10 @@ then you can build MFC and run the test suite! ``` And... you're done! +If you want to build MFC in single precision to ensure calculations are done in fp32 instead of fp64 +then build with the --single flag +./mfc.sh build -j $(nproc) --single + You can learn more about MFC's capabilities [via its documentation](https://mflowcode.github.io/documentation/index.html) or play with the examples located in the `examples/` directory (some are [shown here](https://mflowcode.github.io/documentation/md_examples.html))! The shock-droplet interaction case above was run via diff --git a/docs/documentation/getting-started.md b/docs/documentation/getting-started.md index 5227ec77e2..3245df892d 100644 --- a/docs/documentation/getting-started.md +++ b/docs/documentation/getting-started.md @@ -126,6 +126,7 @@ MFC can be built with support for various (compile-time) features: | **Debug** | `--debug` | `--no-debug` | Off | Requests the compiler build MFC in debug mode. | | **GCov** | `--gcov` | `--no-gcov` | Off | Builds MFC with coverage flags on. | | **Unified Memory** | `--unified` | `--no-unified` | Off | Builds MFC with unified CPU/GPU memory (GH-200 superchip only) | +| **Single** | `--single` | `--no-single` | Off | Builds MFC in single precision _⚠️ The `--gpu` option requires that your compiler supports OpenACC for Fortran for your target GPU architecture._ From 56932241696828036aedf79ba9a65f98df432cc8 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Sat, 14 Dec 2024 18:51:58 -0500 Subject: [PATCH 58/68] fix some missing ones --- src/common/m_derived_types.fpp | 2 +- src/common/m_helper.fpp | 8 ++++---- src/common/m_precision_select.f90 | 2 +- src/simulation/m_fftw.fpp | 26 +++++++++++++------------- src/simulation/m_rhs.fpp | 2 +- src/syscheck/syscheck.fpp | 2 +- 6 files changed, 21 insertions(+), 21 deletions(-) diff --git a/src/common/m_derived_types.fpp b/src/common/m_derived_types.fpp index f9381af013..7a021bdaae 100644 --- a/src/common/m_derived_types.fpp +++ b/src/common/m_derived_types.fpp @@ -188,7 +188,7 @@ module m_derived_types !! Identity (id) of the patch with which current patch is to get smoothed real(wp) :: smooth_coeff !< - !! Smoothing coefficient (coeff) adminstrating the size of the stencil of + !! Smoothing coefficient (coeff) for the size of the stencil of !! cells across which boundaries of the current patch will be smeared out real(wp), dimension(num_fluids_max) :: alpha_rho diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp index e08a0938aa..e7939bedf3 100644 --- a/src/common/m_helper.fpp +++ b/src/common/m_helper.fpp @@ -229,8 +229,8 @@ contains real(wp), intent(in) :: omega, peclet real(wp), intent(out) :: Re_trans, Im_trans - complex :: trans, c1, c2, c3 - complex :: imag = (0._wp, 1._wp) + complex(wp) :: trans, c1, c2, c3 + complex(wp) :: imag = (0._wp, 1._wp) real(wp) :: f_transcoeff c1 = imag*omega*peclet @@ -238,7 +238,7 @@ contains c3 = (CEXP(c2) - CEXP(-c2))/(CEXP(c2) + CEXP(-c2)) ! TANH(c2) trans = ((c2/c3 - 1._wp)**(-1) - 3._wp/c1)**(-1) ! transfer function - Re_trans = dble(trans) + Re_trans = trans Im_trans = aimag(trans) end subroutine s_transcoeff @@ -279,7 +279,7 @@ contains ! phi = ln( R0 ) & return R0 do ir = 1, nb phi(ir) = log(R0mn) & - + dble(ir - 1)*log(R0mx/R0mn)/dble(nb - 1) + + (ir - 1._wp)*log(R0mx/R0mn)/(nb - 1._wp) R0(ir) = exp(phi(ir)) end do dphi = phi(2) - phi(1) diff --git a/src/common/m_precision_select.f90 b/src/common/m_precision_select.f90 index 0b0e3d3633..3d3fa03838 100644 --- a/src/common/m_precision_select.f90 +++ b/src/common/m_precision_select.f90 @@ -19,7 +19,7 @@ module m_precision_select integer, parameter :: sp = single_precision integer, parameter :: dp = double_precision - ! Set the working precision (wp) to single or double precision + ! Set the working precision (wp) to single or double #ifdef MFC_SINGLE_PRECISION integer, parameter :: wp = single_precision ! Change to single_precision if needed #else diff --git a/src/simulation/m_fftw.fpp b/src/simulation/m_fftw.fpp index c647f593ec..9ab5c0c5f3 100644 --- a/src/simulation/m_fftw.fpp +++ b/src/simulation/m_fftw.fpp @@ -51,9 +51,9 @@ module m_fftw #if defined(MFC_OpenACC) !$acc declare create(real_size, cmplx_size, x_size, batch_size, Nfq) - real(kind(0d0)), allocatable, target :: data_real_gpu(:) - complex(kind(0d0)), allocatable, target :: data_cmplx_gpu(:) - complex(kind(0d0)), allocatable, target :: data_fltr_cmplx_gpu(:) + real(dp), allocatable, target :: data_real_gpu(:) + complex(dp), allocatable, target :: data_cmplx_gpu(:) + complex(dp), allocatable, target :: data_fltr_cmplx_gpu(:) !$acc declare create(data_real_gpu, data_cmplx_gpu, data_fltr_cmplx_gpu) #if defined(__PGI) @@ -146,7 +146,7 @@ contains do k = 1, sys_size do j = 0, m do l = 1, cmplx_size - data_fltr_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) = (0d0, 0d0) + data_fltr_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) = (0_dp, 0_dp) end do end do end do @@ -198,7 +198,7 @@ contains do k = 1, sys_size do j = 0, m do l = 0, p - data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size)/real(real_size, kind(0d0)) + data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size)/real(real_size, dp) q_cons_vf(k)%sf(j, 0, l) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) end do end do @@ -210,7 +210,7 @@ contains do k = 1, sys_size do j = 0, m do l = 1, cmplx_size - data_fltr_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) = (0d0, 0d0) + data_fltr_cmplx_gpu(l + j*cmplx_size + (k - 1)*cmplx_size*x_size) = (0_dp, 0_dp) end do end do end do @@ -233,7 +233,7 @@ contains #endif !$acc end host_data - Nfq = min(floor(2d0*real(i, kind(0d0))*pi), cmplx_size) + Nfq = min(floor(2_dp*real(i, dp)*pi), cmplx_size) !$acc update device(Nfq) !$acc parallel loop collapse(3) gang vector default(present) @@ -258,7 +258,7 @@ contains do k = 1, sys_size do j = 0, m do l = 0, p - data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size)/real(real_size, kind(0d0)) + data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size)/real(real_size, dp) q_cons_vf(k)%sf(j, i, l) = data_real_gpu(l + j*real_size + 1 + (k - 1)*real_size*x_size) end do end do @@ -270,27 +270,27 @@ contains Nfq = 3 do j = 0, m do k = 1, sys_size - data_fltr_cmplx(:) = (0d0, 0d0) + data_fltr_cmplx(:) = (0_dp, 0_dp) data_real(1:p + 1) = q_cons_vf(k)%sf(j, 0, 0:p) call fftw_execute_dft_r2c(fwd_plan, data_real, data_cmplx) data_fltr_cmplx(1:Nfq) = data_cmplx(1:Nfq) call fftw_execute_dft_c2r(bwd_plan, data_fltr_cmplx, data_real) - data_real(:) = data_real(:)/real(real_size, kind(0d0)) + data_real(:) = data_real(:)/real(real_size, dp) q_cons_vf(k)%sf(j, 0, 0:p) = data_real(1:p + 1) end do end do ! Apply Fourier filter to additional rings do i = 1, fourier_rings - Nfq = min(floor(2d0*real(i, kind(0d0))*pi), cmplx_size) + Nfq = min(floor(2_dp*real(i, dp)*pi), cmplx_size) do j = 0, m do k = 1, sys_size - data_fltr_cmplx(:) = (0d0, 0d0) + data_fltr_cmplx(:) = (0_dp, 0_dp) data_real(1:p + 1) = q_cons_vf(k)%sf(j, i, 0:p) call fftw_execute_dft_r2c(fwd_plan, data_real, data_cmplx) data_fltr_cmplx(1:Nfq) = data_cmplx(1:Nfq) call fftw_execute_dft_c2r(bwd_plan, data_fltr_cmplx, data_real) - data_real(:) = data_real(:)/real(real_size, kind(0d0)) + data_real(:) = data_real(:)/real(real_size, dp) q_cons_vf(k)%sf(j, i, 0:p) = data_real(1:p + 1) end do end do diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 78f470fcb8..2f89dc3ebf 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -899,7 +899,7 @@ contains if (chemistry) then !$acc kernels - rhs_vf(T_idx)%sf(:, :, :) = 0d0 + rhs_vf(T_idx)%sf(:, :, :) = 0.0_wp !$acc end kernels if (chem_params%reactions) then diff --git a/src/syscheck/syscheck.fpp b/src/syscheck/syscheck.fpp index de613a6f8d..ca2641057e 100644 --- a/src/syscheck/syscheck.fpp +++ b/src/syscheck/syscheck.fpp @@ -53,7 +53,7 @@ program syscheck @:ACC(integer(acc_device_kind) :: devtype) @:ACC(integer :: i, num_devices) - @:ACC(real(kind(0d0)), allocatable, dimension(:) :: arr) + @:ACC(real(8), allocatable, dimension(:) :: arr) @:ACC(integer, parameter :: N = 100) @:MPIC(call mpi_init(ierr)) From f770a43af9de5b4f9ae52be4b74cb4712016b760 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Sat, 14 Dec 2024 19:07:58 -0500 Subject: [PATCH 59/68] add grep check --- .github/workflows/lint-source.yml | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/.github/workflows/lint-source.yml b/.github/workflows/lint-source.yml index 1ee7d621a3..da29e99070 100644 --- a/.github/workflows/lint-source.yml +++ b/.github/workflows/lint-source.yml @@ -33,3 +33,16 @@ jobs: - name: Ensure kind is specified run: fortitude check --file-extensions=f90,fpp,fypp --select=P001 ./src/** + + double-check: + name: Look for double intrinsics + runs-on: 'ubuntu-latest' + + steps: + - uses: actions/checkout@v4 + + - name: Check for doubles via grep + run: | + cd src | + grep -iR 'dexp\|dlog\|dble\|dabs\|double\ precision\|real(8)\|real(4)\|dprod\|dmin\|dmax\|dfloat\|dreal\|dcos\|dsin\|dtan\|dsign\|dtanh\|dsinh\|dcosh\|\.d0\|\dd0' --exclude-dir=syscheck ./* || true | + grep -qiR 'dexp\|dlog\|dble\|dabs\|double\ precision\|real(8)\|real(4)\|dprod\|dmin\|dmax\|dfloat\|dreal\|dcos\|dsin\|dtan\|dsign\|dtanh\|dsinh\|dcosh\|\.d0\|\dd0' --exclude-dir=syscheck ./* From c1a9e6b864f8d3c44f7bae322d6806ffe362b76b Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Sat, 14 Dec 2024 20:25:29 -0500 Subject: [PATCH 60/68] fix blunder --- src/common/m_helper.fpp | 21 ++++----------------- 1 file changed, 4 insertions(+), 17 deletions(-) diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp index e7939bedf3..feaae3f340 100644 --- a/src/common/m_helper.fpp +++ b/src/common/m_helper.fpp @@ -229,13 +229,13 @@ contains real(wp), intent(in) :: omega, peclet real(wp), intent(out) :: Re_trans, Im_trans - complex(wp) :: trans, c1, c2, c3 - complex(wp) :: imag = (0._wp, 1._wp) + complex :: trans, c1, c2, c3 + complex :: imag = (0._wp, 1._wp) real(wp) :: f_transcoeff c1 = imag*omega*peclet - c2 = CSQRT(c1) - c3 = (CEXP(c2) - CEXP(-c2))/(CEXP(c2) + CEXP(-c2)) ! TANH(c2) + c2 = csqrt(c1) + c3 = (cexp(c2) - cexp(-c2))/(cexp(c2) + cexp(-c2)) ! TANH(c2) trans = ((c2/c3 - 1._wp)**(-1) - 3._wp/c1)**(-1) ! transfer function Re_trans = trans @@ -259,19 +259,6 @@ contains real(wp) :: R0mn, R0mx, dphi, tmp, sd real(wp), dimension(nb) :: phi - ! nondiml. min. & max. initial radii for numerical quadrature - !sd = 0.05e0_wp - !R0mn = 0.75e0_wp - !R0mx = 1.3e0_wp - - !sd = 0.3e0_wp - !R0mn = 0.3e0_wp - !R0mx = 6.e0_wp - - !sd = 0.7e0_wp - !R0mn = 0.12e0_wp - !R0mx = 150.e0_wp - sd = poly_sigma R0mn = 0.8_wp*exp(-2.8_wp*sd) R0mx = 0.2_wp*exp(9.5_wp*sd) + 1._wp From a77a39536c9db82dfe872134685256a7e42ecd55 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Sun, 15 Dec 2024 08:39:05 -0500 Subject: [PATCH 61/68] cleanup --- .github/workflows/lint-source.yml | 13 ++----------- src/common/m_helper.fpp | 7 ++----- src/simulation/m_mpi_proxy.fpp | 4 ---- 3 files changed, 4 insertions(+), 20 deletions(-) diff --git a/.github/workflows/lint-source.yml b/.github/workflows/lint-source.yml index da29e99070..ee95096e3c 100644 --- a/.github/workflows/lint-source.yml +++ b/.github/workflows/lint-source.yml @@ -34,15 +34,6 @@ jobs: - name: Ensure kind is specified run: fortitude check --file-extensions=f90,fpp,fypp --select=P001 ./src/** - double-check: - name: Look for double intrinsics - runs-on: 'ubuntu-latest' - - steps: - - uses: actions/checkout@v4 - - - name: Check for doubles via grep + - name: No double precision intrinsics run: | - cd src | - grep -iR 'dexp\|dlog\|dble\|dabs\|double\ precision\|real(8)\|real(4)\|dprod\|dmin\|dmax\|dfloat\|dreal\|dcos\|dsin\|dtan\|dsign\|dtanh\|dsinh\|dcosh\|\.d0\|\dd0' --exclude-dir=syscheck ./* || true | - grep -qiR 'dexp\|dlog\|dble\|dabs\|double\ precision\|real(8)\|real(4)\|dprod\|dmin\|dmax\|dfloat\|dreal\|dcos\|dsin\|dtan\|dsign\|dtanh\|dsinh\|dcosh\|\.d0\|\dd0' --exclude-dir=syscheck ./* + ! grep -iR 'dexp\|dlog\|dble\|dabs\|double\ precision\|real(8)\|real(4)\|dprod\|dmin\|dmax\|dfloat\|dreal\|dcos\|dsin\|dtan\|dsign\|dtanh\|dsinh\|dcosh\|\.d0\|\dd0' --exclude-dir=syscheck ./src/* diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp index feaae3f340..a65efeae75 100644 --- a/src/common/m_helper.fpp +++ b/src/common/m_helper.fpp @@ -69,9 +69,6 @@ contains nR3 = dot_product(weights, nRtmp**3._wp) ntmp = sqrt((4._wp*pi/3._wp)*nR3/vftmp) - !ntmp = (3._wp/(4._wp*pi))*0.00001 - - !print *, "nbub", ntmp end subroutine s_comp_n_from_cons @@ -82,7 +79,7 @@ contains integer :: i, j integer :: m, n - real :: c + real(wp) :: c m = size(A, 1) n = size(A, 2) @@ -90,7 +87,7 @@ contains if (present(div)) then c = div else - c = 1 + c = 1._wp end if print *, m, n diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index 9281ea0aeb..b57701cd7f 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -74,10 +74,6 @@ module m_mpi_proxy !> @} !$acc declare create(v_size) - !real :: s_time, e_time - !real :: compress_time, mpi_time, decompress_time - !integer :: nCalls_time = 0 - integer :: nVars !< nVars for surface tension communication !$acc declare create(nVars) From b084b1ce65d03d0fa216d91934f1528325a15fb6 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Sun, 15 Dec 2024 22:02:35 -0500 Subject: [PATCH 62/68] fix linter a bit --- .github/workflows/lint-source.yml | 2 +- src/common/m_helper.fpp | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/lint-source.yml b/.github/workflows/lint-source.yml index ee95096e3c..4d519ae593 100644 --- a/.github/workflows/lint-source.yml +++ b/.github/workflows/lint-source.yml @@ -29,7 +29,7 @@ jobs: run: pip install fortitude-lint ansi2txt - name: Lint the source code - run: fortitude check --file-extensions=f90,fpp,fypp --ignore=E001,S001,S101,M011,F001,S041,T001 ./src/** || true + run: fortitude check --file-extensions=f90,fpp,fypp --ignore=E001,S001,S101,M011,F001,S041,T001,S101 ./src/** || true - name: Ensure kind is specified run: fortitude check --file-extensions=f90,fpp,fypp --select=P001 ./src/** diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp index a65efeae75..7daf79310e 100644 --- a/src/common/m_helper.fpp +++ b/src/common/m_helper.fpp @@ -75,7 +75,7 @@ contains subroutine s_print_2D_array(A, div) real(wp), dimension(:, :), intent(in) :: A - real, optional, intent(in) :: div + real(wp), optional, intent(in) :: div integer :: i, j integer :: m, n From c2641f3ecd53fe2eccb6133fd1a2bba583eeb8e8 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Mon, 16 Dec 2024 08:05:56 -0500 Subject: [PATCH 63/68] Update README.md --- README.md | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/README.md b/README.md index 3389102491..867dfe307f 100644 --- a/README.md +++ b/README.md @@ -85,10 +85,6 @@ then you can build MFC and run the test suite! ``` And... you're done! -If you want to build MFC in single precision to ensure calculations are done in fp32 instead of fp64 -then build with the --single flag -./mfc.sh build -j $(nproc) --single - You can learn more about MFC's capabilities [via its documentation](https://mflowcode.github.io/documentation/index.html) or play with the examples located in the `examples/` directory (some are [shown here](https://mflowcode.github.io/documentation/md_examples.html))! The shock-droplet interaction case above was run via @@ -165,6 +161,7 @@ They are organized below. Just click the drop-downs! * \>66K AMD GPUs on the first exascale computer, [OLCF Frontier](https://www.olcf.ornl.gov/frontier/) (AMD MI250X-based) * Near compute roofline behavior * RDMA (remote data memory access; GPU-GPU direct communication) via GPU-aware MPI on NVIDIA (CUDA-aware MPI) and AMD GPU systems +* Optional single-precision computation and storage
From 790e645075f4e1aa43be5dc42bd94eeffcf4d543 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Mon, 16 Dec 2024 08:06:19 -0500 Subject: [PATCH 64/68] Discard changes to examples/3D_performance_test/case.py --- examples/3D_performance_test/case.py | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/examples/3D_performance_test/case.py b/examples/3D_performance_test/case.py index 00a368cc7b..d1fc4c77a2 100644 --- a/examples/3D_performance_test/case.py +++ b/examples/3D_performance_test/case.py @@ -28,9 +28,9 @@ 'z_a' : -1.5E-03/1.E-03, 'z_b' : 1.5E-03/1.E-03, 'cyl_coord' : 'F', - 'm' : 100, - 'n' : 100, - 'p' : 100, + 'm' : 200, + 'n' : 200, + 'p' : 200, 'dt' : 0.2E-09/1.E-03, 't_step_start' : 0, 't_step_stop' : 30, From 6c3c55e6643ab84d571b2d8342ce5e9be466f314 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Mon, 16 Dec 2024 08:08:05 -0500 Subject: [PATCH 65/68] Discard changes to .github/workflows/phoenix/bench.sh --- .github/workflows/phoenix/bench.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/phoenix/bench.sh b/.github/workflows/phoenix/bench.sh index 8b8499eb0c..4fc99cc1fa 100644 --- a/.github/workflows/phoenix/bench.sh +++ b/.github/workflows/phoenix/bench.sh @@ -12,4 +12,4 @@ if ["$job_device" == "gpu"]; then ./mfc.sh bench --mem 12 -j $(nproc) -o "$job_slug.yaml" -- -c phoenix $device_opts -n $n_ranks else ./mfc.sh bench --mem 1 -j $(nproc) -o "$job_slug.yaml" -- -c phoenix $device_opts -n $n_ranks -fi \ No newline at end of file +fi From e08440e0ce8870380d3f3b84724542c0bc8fa2d1 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Mon, 16 Dec 2024 08:08:18 -0500 Subject: [PATCH 66/68] Discard changes to .github/workflows/phoenix/submit.sh --- .github/workflows/phoenix/submit.sh | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/phoenix/submit.sh b/.github/workflows/phoenix/submit.sh index 9e894abd07..ce0cdaeac1 100644 --- a/.github/workflows/phoenix/submit.sh +++ b/.github/workflows/phoenix/submit.sh @@ -60,3 +60,4 @@ job_device="$2" $sbatch_script_contents EOT + From 58c934531874a8d38b023710f8684843129d2bc6 Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Mon, 16 Dec 2024 08:08:35 -0500 Subject: [PATCH 67/68] Discard changes to .github/workflows/phoenix/test.sh --- .github/workflows/phoenix/test.sh | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/phoenix/test.sh b/.github/workflows/phoenix/test.sh index 6a267576bc..5cdc57e78c 100644 --- a/.github/workflows/phoenix/test.sh +++ b/.github/workflows/phoenix/test.sh @@ -18,3 +18,4 @@ fi ./mfc.sh test --max-attempts 3 -a -j $n_test_threads $device_opts -- -c phoenix + From ad1c092bd3c635fba44efaf81b71564f32a2574c Mon Sep 17 00:00:00 2001 From: Spencer Bryngelson Date: Mon, 16 Dec 2024 08:09:05 -0500 Subject: [PATCH 68/68] Discard changes to .github/workflows/bench.yml --- .github/workflows/bench.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index 227ff26d12..a22901e632 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -65,4 +65,4 @@ jobs: pr/bench-${{ matrix.device }}.* pr/build/benchmarks/* master/bench-${{ matrix.device }}.* - master/build/benchmarks/* \ No newline at end of file + master/build/benchmarks/*