From 73ad673f5e5a83b313f360177d07f2e43d0d9024 Mon Sep 17 00:00:00 2001 From: XuzhengTian Date: Sat, 28 Jun 2025 17:39:44 -0400 Subject: [PATCH 1/6] Code Tidying --- src/common/m_boundary_common.fpp | 20 ++- src/common/m_checker_common.fpp | 3 +- src/common/m_finite_differences.fpp | 13 +- src/common/m_helper_basic.f90 | 16 ++- src/common/m_mpi_common.fpp | 14 ++- src/common/m_nvtx.f90 | 19 +-- src/common/m_variables_conversion.fpp | 116 ++++++++++-------- src/post_process/m_start_up.f90 | 6 +- .../include/ExtrusionHardcodedIC.fpp | 12 +- src/pre_process/m_compute_levelset.fpp | 2 - src/pre_process/m_patches.fpp | 14 +-- src/simulation/m_compute_cbc.fpp | 1 - src/simulation/m_data_output.fpp | 10 +- src/simulation/m_derived_variables.f90 | 6 +- src/simulation/m_fftw.fpp | 5 +- src/simulation/m_hyperelastic.fpp | 6 +- src/simulation/m_hypoelastic.fpp | 6 +- src/simulation/m_ibm.fpp | 2 - src/simulation/m_mhd.fpp | 12 +- src/simulation/m_mpi_proxy.fpp | 4 +- src/simulation/m_rhs.fpp | 4 +- src/simulation/m_riemann_solvers.fpp | 4 +- src/simulation/m_start_up.fpp | 5 +- src/simulation/m_time_steppers.fpp | 4 +- src/simulation/m_weno.fpp | 11 +- 25 files changed, 175 insertions(+), 140 deletions(-) diff --git a/src/common/m_boundary_common.fpp b/src/common/m_boundary_common.fpp index 4087a0045e..e9cce4f529 100644 --- a/src/common/m_boundary_common.fpp +++ b/src/common/m_boundary_common.fpp @@ -1028,9 +1028,9 @@ contains integer, intent(in) :: bc_dir, bc_loc integer, intent(in) :: k, l +#ifdef MFC_SIMULATION integer :: j, i -#ifdef MFC_SIMULATION if (bc_dir == 1) then !< x-direction if (bc_loc == -1) then !bc_x%beg do i = 1, sys_size @@ -1520,7 +1520,7 @@ contains character(LEN=*), intent(in) :: step_dirpath - integer :: dir, loc, i + integer :: dir, loc character(len=path_len) :: file_path character(len=10) :: status @@ -1561,12 +1561,10 @@ contains integer :: dir, loc character(len=path_len) :: file_loc, file_path - character(len=10) :: status - #ifdef MFC_MPI integer :: ierr integer :: file_id - integer :: offset + integer(KIND=MPI_ADDRESS_KIND) :: offset character(len=7) :: proc_rank_str logical :: dir_check @@ -1625,8 +1623,6 @@ contains logical :: file_exist character(len=path_len) :: file_path - character(len=10) :: status - ! Read bc_types file_path = trim(step_dirpath)//'/bc_type.dat' inquire (FILE=trim(file_path), EXIST=file_exist) @@ -1668,12 +1664,10 @@ contains integer :: dir, loc character(len=path_len) :: file_loc, file_path - character(len=10) :: status - #ifdef MFC_MPI integer :: ierr integer :: file_id - integer :: offset + integer(KIND=MPI_ADDRESS_KIND) :: offset character(len=7) :: proc_rank_str logical :: dir_check @@ -1696,7 +1690,7 @@ contains file_path = trim(file_loc)//'/bc_'//trim(proc_rank_str)//'.dat' call MPI_File_open(MPI_COMM_SELF, trim(file_path), MPI_MODE_RDONLY, MPI_INFO_NULL, file_id, ierr) - offset = 0 + offset = int(0, KIND=MPI_ADDRESS_KIND) ! Read bc_types do dir = 1, num_dims @@ -1788,9 +1782,9 @@ contains !! boundary locations and cell-width distributions, based on !! the boundary conditions. subroutine s_populate_grid_variables_buffers - +#ifndef MFC_PRE_PROCESS integer :: i !< Generic loop iterator - +#endif #ifdef MFC_SIMULATION ! Required for compatibility between codes type(int_bounds_info) :: offset_x, offset_y, offset_z diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index 1c3a238941..1d175d1ed3 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -316,8 +316,9 @@ contains !> Checks constraints on the surface tension parameters. !! Called by s_check_inputs_common for all three stages impure subroutine s_check_inputs_surface_tension - +#ifdef MFC_PRE_PROCESS integer :: i +#endif MFC_PRE_PROCESS @:PROHIBIT(surface_tension .and. sigma < 0._wp, & "sigma must be greater than or equal to zero") diff --git a/src/common/m_finite_differences.fpp b/src/common/m_finite_differences.fpp index 2eb7920422..174b0cc1af 100644 --- a/src/common/m_finite_differences.fpp +++ b/src/common/m_finite_differences.fpp @@ -67,18 +67,20 @@ contains !! @param s_cc Locations of the cell-centers in the s-coordinate direction !! @param fd_coeff_s Finite-diff. coefficients in the s-coordinate direction pure subroutine s_compute_finite_difference_coefficients(q, s_cc, fd_coeff_s, buff_size, & - fd_number_in, fd_order_in, offset_s) + fd_order_in, fd_number_in, offset_s) integer :: lB, lE !< loop bounds integer, intent(IN) :: q - integer, intent(IN) :: buff_size, fd_number_in, fd_order_in + integer, intent(IN) :: buff_size, fd_order_in + integer, optional, intent(IN) :: fd_number_in + type(int_bounds_info), optional, intent(IN) :: offset_s real(wp), allocatable, dimension(:, :), intent(INOUT) :: fd_coeff_s real(wp), & dimension(-buff_size:q + buff_size), & intent(IN) :: s_cc - + integer :: fd_number integer :: i !< Generic loop iterator if (present(offset_s)) then @@ -88,6 +90,11 @@ contains lB = 0 lE = q end if + if (present(fd_number_in)) then + fd_number = fd_number_in + else + fd_number = 2 + end if #ifdef MFC_POST_PROCESS if (allocated(fd_coeff_s)) deallocate (fd_coeff_s) diff --git a/src/common/m_helper_basic.f90 b/src/common/m_helper_basic.f90 index 74cb61f2ab..b605d2e120 100644 --- a/src/common/m_helper_basic.f90 +++ b/src/common/m_helper_basic.f90 @@ -21,7 +21,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 = 1.e-10_wp). + !! @param tol_input Relative error (default = 1.e-10_wp for double precision and 1e-6 for single). !! @return Result of the comparison. logical pure elemental function f_approx_equal(a, b, tol_input) result(res) !$acc routine seq @@ -32,7 +32,11 @@ logical pure elemental function f_approx_equal(a, b, tol_input) result(res) if (present(tol_input)) then tol = tol_input else - tol = 1.e-10_wp + if (wp == selected_real_kind(15, 307)) then + tol = 1.e-10_wp ! Double Precision + else if (wp == selected_real_kind(6, 37)) then + tol = 1.e-6_wp ! Single Precision + end if end if if (a == b) then @@ -47,7 +51,7 @@ end function f_approx_equal !> This procedure checks if the point numbers of wp belongs to another array are within tolerance. !! @param a First number. !! @param b Array that contains several point numbers. - !! @param tol_input Relative error (default = 1e-10_wp). + !! @param tol_input Relative error (default = 1.e-10_wp for double precision and 1e-6 for single). !! @return Result of the comparison. logical pure function f_approx_in_array(a, b, tol_input) result(res) !$acc routine seq @@ -62,7 +66,11 @@ logical pure function f_approx_in_array(a, b, tol_input) result(res) if (present(tol_input)) then tol = tol_input else - tol = 1e-10_wp + if (wp == selected_real_kind(15, 307)) then + tol = 1.e-10_wp ! Double Precision + else if (wp == selected_real_kind(6, 37)) then + tol = 1.e-6_wp ! Single Precision + end if end if do i = 1, size(b) diff --git a/src/common/m_mpi_common.fpp b/src/common/m_mpi_common.fpp index b920151488..fd4ed4c9e2 100644 --- a/src/common/m_mpi_common.fpp +++ b/src/common/m_mpi_common.fpp @@ -130,12 +130,17 @@ contains type(scalar_field), intent(in), optional :: beta integer, dimension(num_dims) :: sizes_glb, sizes_loc - integer, dimension(1) :: airfoil_glb, airfoil_loc, airfoil_start +#ifndef MFC_POST_PROCESS + integer, dimension(1) :: airfoil_glb, airfoil_loc, airfoil_start +#endif #ifdef MFC_MPI ! Generic loop iterator - integer :: i, j + integer :: i +#ifndef MFC_POST_PROCESS + integer :: j +#endif !Altered system size for the lagrangian subgrid bubble model integer :: alt_sys @@ -363,6 +368,11 @@ contains real(wp), intent(out) :: vcfl_max_glb real(wp), intent(out) :: Rc_min_glb + ! Initiate the global variables to the local values to avoid warnings + icfl_max_glb = icfl_max_loc + vcfl_max_glb = vcfl_max_loc + Rc_min_glb = Rc_min_loc + #ifdef MFC_SIMULATION #ifdef MFC_MPI diff --git a/src/common/m_nvtx.f90 b/src/common/m_nvtx.f90 index ce3273751a..69e1528a66 100644 --- a/src/common/m_nvtx.f90 +++ b/src/common/m_nvtx.f90 @@ -55,19 +55,24 @@ end subroutine nvtxRangePop subroutine nvtxStartRange(name, id) character(kind=c_char, len=*), intent(IN) :: name - integer, intent(IN), optional :: id + integer, intent(in), optional :: id + integer :: id_color +#if defined(MFC_OpenACC) && defined(__PGI) type(nvtxEventAttributes) :: event +#endif + if (present(id)) then + id_color = col(mod(id, 7) + 1) + end if + tempName = trim(name)//c_null_char #if defined(MFC_OpenACC) && defined(__PGI) - tempName = trim(name)//c_null_char - - if (.not. present(id)) then - call nvtxRangePush(tempName) - else - event%color = col(mod(id, 7) + 1) + if (present(id)) then + event%color = id_color event%message = c_loc(tempName) call nvtxRangePushEx(event) + else + call nvtxRangePush(tempName) end if #endif diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 949eac92cb..e9466c1999 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -55,9 +55,12 @@ module m_variables_conversion real(wp), allocatable, dimension(:) :: Gs integer, allocatable, dimension(:) :: bubrs - real(wp), allocatable, dimension(:, :) :: Res - !$acc declare create(bubrs, Gs, Res) +!$acc declare create(bubrs, Gs) +#ifdef MFC_SIMULATION + real(wp), allocatable, dimension(:, :) :: Res + !$acc declare create(Res) +#endif integer :: is1b, is2b, is3b, is1e, is2e, is3e !$acc declare create(is1b, is2b, is3b, is1e, is2e, is3e) @@ -136,9 +139,17 @@ contains real(wp) :: e_Per_Kg, Pdyn_Per_Kg real(wp) :: T_guess real(wp), dimension(1:num_species) :: Y_rs + #:if not chemistry + integer :: s !< Generic loop iterator + #:endif - integer :: s !< Generic loop iterator + ! Initiate the variables to avoid compiler warnings + Y_rs(:) = rhoYks(:)/rho + e_Per_Kg = energy/rho + Pdyn_Per_Kg = dyn_p/rho + E_e = 0._wp + T_guess = T #:if not chemistry ! Depending on model_eqns and bubbles_euler, the appropriate procedure ! for computing pressure is targeted by the procedure pointer @@ -158,7 +169,6 @@ contains if (hypoelasticity .and. present(G)) then ! calculate elastic contribution to Energy - E_e = 0._wp do s = stress_idx%beg, stress_idx%end if (G > 0) then E_e = E_e + ((stress/rho)**2._wp)/(4._wp*G) @@ -179,12 +189,6 @@ contains #:else - Y_rs(:) = rhoYks(:)/rho - e_Per_Kg = energy/rho - Pdyn_Per_Kg = dyn_p/rho - - T_guess = T - call get_temperature(e_Per_Kg - Pdyn_Per_Kg, T_guess, Y_rs, .true., T) call get_pressure(rho, T, Y_rs, pres) @@ -261,7 +265,10 @@ contains real(wp), optional, dimension(2), intent(out) :: Re_K - integer :: i, q + integer :: i +#ifdef MFC_SIMULATION + integer :: q +#endif real(wp), dimension(num_fluids) :: alpha_rho_K, alpha_K ! Constraining the partial densities and the volume fractions within @@ -325,14 +332,16 @@ contains qv = fluid_pp(1)%qv end if end if - + if (present(Re_K)) then + Re_K(:) = dflt_real + end if #ifdef MFC_SIMULATION ! Computing the shear and bulk Reynolds numbers from species analogs if (viscous) then 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) = 0._wp + 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) & @@ -388,8 +397,10 @@ contains real(wp), dimension(num_fluids) :: alpha_rho_K, alpha_K !< - integer :: i, j !< Generic loop iterator - + integer :: i !< Generic loop iterator +#ifdef MFC_SIMULATION + integer :: j !< Generic loop iterator +#endif ! Computing the density, the specific heat ratio function and the ! liquid stiffness function, respectively @@ -420,11 +431,14 @@ contains pi_inf = pi_inf + alpha_K(i)*pi_infs(i) qv = qv + alpha_rho_K(i)*qvs(i) end do + if (present(Re_K)) then + Re_K(:) = dflt_real + end if #ifdef MFC_SIMULATION ! 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) = 0._wp + 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) & @@ -472,21 +486,24 @@ contains real(wp), optional, intent(out) :: G_K real(wp), optional, dimension(num_fluids), intent(in) :: G - - integer :: i, j !< Generic loop iterators real(wp) :: alpha_K_sum #ifdef MFC_SIMULATION - ! Constraining the partial densities and the volume fractions within - ! 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 + integer :: i, j !< Generic loop iterators +#endif + ! Initiate the variables to avoid compiler warnings rho_K = 0._wp gamma_K = 0._wp pi_inf_K = 0._wp qv_K = 0._wp - alpha_K_sum = 0._wp + if (present(G_K) .and. present(G)) G_K = 0._wp + Re_K(:) = dflt_real +#ifdef MFC_SIMULATION + ! Constraining the partial densities and the volume fractions within + ! 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 if (mpp_lim) then do i = 1, num_fluids @@ -507,7 +524,6 @@ contains end do if (present(G_K)) then - G_K = 0._wp do i = 1, num_fluids !TODO: change to use Gs directly here? !TODO: Make this changes as well for GPUs @@ -519,8 +535,6 @@ contains if (viscous) then do i = 1, 2 - Re_K(i) = dflt_real - if (Re_size(i) > 0) Re_K(i) = 0._wp do j = 1, Re_size(i) @@ -549,33 +563,36 @@ contains real(wp), dimension(num_fluids), intent(in) :: alpha_K, alpha_rho_K !< !! Partial densities and volume fractions - + real(wp), dimension(num_fluids) :: alpha_K_local, alpha_rho_K_local !< real(wp), dimension(2), intent(out) :: Re_K - - integer :: i, j !< Generic loop iterators - #ifdef MFC_SIMULATION + integer :: i, j !< Generic loop iterators +#endif + ! Initiate the variables to avoid compiler warnings rho_K = 0._wp gamma_K = 0._wp pi_inf_K = 0._wp qv_K = 0._wp - + Re_K(:) = dflt_real + alpha_K_local(:) = alpha_K(:) + alpha_rho_K_local(:) = alpha_rho_K(:) +#ifdef MFC_SIMULATION if (mpp_lim .and. (model_eqns == 2) .and. (num_fluids > 2)) then do i = 1, num_fluids - rho_K = rho_K + alpha_rho_K(i) - gamma_K = gamma_K + alpha_K(i)*gammas(i) - pi_inf_K = pi_inf_K + alpha_K(i)*pi_infs(i) - qv_K = qv_K + alpha_rho_K(i)*qvs(i) + rho_K = rho_K + alpha_rho_K_local(i) + gamma_K = gamma_K + alpha_K_local(i)*gammas(i) + pi_inf_K = pi_inf_K + alpha_K_local(i)*pi_infs(i) + qv_K = qv_K + alpha_rho_K_local(i)*qvs(i) end do else if ((model_eqns == 2) .and. (num_fluids > 2)) then do i = 1, num_fluids - 1 - rho_K = rho_K + alpha_rho_K(i) - gamma_K = gamma_K + alpha_K(i)*gammas(i) - pi_inf_K = pi_inf_K + alpha_K(i)*pi_infs(i) - qv_K = qv_K + alpha_rho_K(i)*qvs(i) + rho_K = rho_K + alpha_rho_K_local(i) + gamma_K = gamma_K + alpha_K_local(i)*gammas(i) + pi_inf_K = pi_inf_K + alpha_K_local(i)*pi_infs(i) + qv_K = qv_K + alpha_rho_K_local(i)*qvs(i) end do else - rho_K = alpha_rho_K(1) + rho_K = alpha_rho_K_local(1) gamma_K = gammas(1) pi_inf_K = pi_infs(1) qv_K = qvs(1) @@ -585,12 +602,10 @@ 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) = 0._wp do j = 1, Re_size(i) - Re_K(i) = (1._wp - alpha_K(Re_idx(i, j)))/Res(i, j) & + Re_K(i) = (1._wp - alpha_K_local(Re_idx(i, j)))/Res(i, j) & + Re_K(i) end do @@ -600,7 +615,6 @@ contains end if end if #endif - end subroutine s_convert_species_to_mixture_variables_bubbles_acc !> The computation of parameters, the allocation of memory, @@ -608,11 +622,11 @@ contains !! other procedures that are necessary to setup the module. impure subroutine s_initialize_variables_conversion_module - integer :: i, j - -!$acc enter data copyin(is1b, is1e, is2b, is2e, is3b, is3e) + integer :: i #ifdef MFC_SIMULATION + integer :: j + @:ALLOCATE(gammas (1:num_fluids)) @:ALLOCATE(gs_min (1:num_fluids)) @:ALLOCATE(pi_infs(1:num_fluids)) @@ -631,6 +645,7 @@ contains @:ALLOCATE(qvps (1:num_fluids)) @:ALLOCATE(Gs (1:num_fluids)) #endif + !$acc enter data copyin(is1b, is1e, is2b, is2e, is3b, is3e) do i = 1, num_fluids gammas(i) = fluid_pp(i)%gamma @@ -1166,6 +1181,8 @@ contains ! Density, specific heat ratio function, liquid stiffness function ! and dynamic pressure, as defined in the incompressible flow sense, ! respectively + +#ifndef MFC_SIMULATION real(wp) :: rho real(wp) :: gamma real(wp) :: pi_inf @@ -1192,8 +1209,6 @@ contains pres_mag = 0._wp G = 0._wp - -#ifndef MFC_SIMULATION ! Converting the primitive variables to the conservative variables do l = 0, p do k = 0, n @@ -1444,6 +1459,7 @@ contains ! 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 +#ifdef MFC_SIMULATION real(wp), dimension(num_fluids) :: alpha_rho_K real(wp), dimension(num_fluids) :: alpha_K real(wp) :: rho_K @@ -1460,7 +1476,7 @@ contains real(wp) :: T_K, mix_mol_weight, R_gas integer :: i, j, k, l !< Generic loop iterators - +#endif is1b = is1%beg; is1e = is1%end is2b = is2%beg; is2e = is2%end is3b = is3%beg; is3e = is3%end diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index b733f43dd9..97a1b7ffac 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -241,21 +241,21 @@ impure subroutine s_save_data(t_step, varname, pres, c, H) if (omega_wrt(2) .or. omega_wrt(3) .or. qm_wrt .or. schlieren_wrt) then call s_compute_finite_difference_coefficients(m, x_cc, & fd_coeff_x, buff_size, & - fd_number, fd_order, offset_x) + fd_order, fd_number, offset_x) end if ! Computing centered finite-difference coefficients in y-direction if (omega_wrt(1) .or. omega_wrt(3) .or. qm_wrt .or. (n > 0 .and. schlieren_wrt)) then call s_compute_finite_difference_coefficients(n, y_cc, & fd_coeff_y, buff_size, & - fd_number, fd_order, offset_y) + fd_order, fd_number, offset_y) end if ! Computing centered finite-difference coefficients in z-direction if (omega_wrt(1) .or. omega_wrt(2) .or. qm_wrt .or. (p > 0 .and. schlieren_wrt)) then call s_compute_finite_difference_coefficients(p, z_cc, & fd_coeff_z, buff_size, & - fd_number, fd_order, offset_z) + fd_order, fd_number, offset_z) end if ! Adding the partial densities to the formatted database file diff --git a/src/pre_process/include/ExtrusionHardcodedIC.fpp b/src/pre_process/include/ExtrusionHardcodedIC.fpp index 264b227f21..7725833d11 100644 --- a/src/pre_process/include/ExtrusionHardcodedIC.fpp +++ b/src/pre_process/include/ExtrusionHardcodedIC.fpp @@ -37,20 +37,20 @@ #:def HardcodedDimensionsExtrusion() integer :: xRows, yRows, nRows, iix, iiy, max_files - integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount - real(wp) :: x_len, x_step, y_len, y_step + integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count !, ycount + real(wp) :: x_step, y_step !, x_len, y_len real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0 integer :: global_offset_x, global_offset_y ! MPI subdomain offset real(wp) :: delta_x, delta_y character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files - character(len=200) :: errmsg + !character(len=200) :: errmsg real(wp), allocatable :: stored_values(:, :, :) real(wp), allocatable :: x_coords(:), y_coords(:) logical :: files_loaded = .false. - real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend + real(wp) :: domain_xstart !, domain_xend, domain_ystart, domain_yend character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/ character(len=20) :: file_num_str ! For storing the file number as a string - character(len=20) :: zeros_part ! For the trailing zeros part + !character(len=20) :: zeros_part ! For the trailing zeros part character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed) #:enddef @@ -112,7 +112,7 @@ do read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z if (ios2 /= 0) exit - if (dummy_x == x0 .and. dummy_y /= y0) then + if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then yRows = yRows + 1 else exit diff --git a/src/pre_process/m_compute_levelset.fpp b/src/pre_process/m_compute_levelset.fpp index 17f66f8d68..30c2711cd2 100644 --- a/src/pre_process/m_compute_levelset.fpp +++ b/src/pre_process/m_compute_levelset.fpp @@ -157,8 +157,6 @@ contains real(wp) :: x_centroid, y_centroid, z_centroid, lz, z_max, z_min, x_act, y_act, theta real(wp), dimension(3) :: dist_vec - real(wp) :: length_z - integer :: i, j, k, l !< Loop index variables x_centroid = patch_ib(ib_patch_id)%x_centroid diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index b3f6b48feb..45339ad848 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -49,7 +49,7 @@ module m_patches !! is to act as a pseudo volume fraction to indicate the contribution of each !! patch toward the composition of a cell's fluid state. - real(wp) :: cart_x, cart_y, cart_z + real(wp) :: cart_y, cart_z !,cart_x real(wp) :: sph_phi !< !! Variables to be used to hold cell locations in Cartesian coordinates if !! 3D simulation is using cylindrical coordinates @@ -133,7 +133,7 @@ contains call s_cylinder(i, ib_markers_sf, q_prim_vf, ib) call s_cylinder_levelset(levelset, levelset_norm, i) elseif (patch_ib(i)%geometry == 11) then - call s_3D_airfoil(i, ib_markers_sf, q_prim_vf, ib) + call s_3D_airfoil(i, ib_markers_sf, ib) call s_3D_airfoil_levelset(levelset, levelset_norm, i) ! STL+IBM patch elseif (patch_ib(i)%geometry == 12) then @@ -204,7 +204,7 @@ contains call s_rectangle(i, ib_markers_sf, q_prim_vf, ib) call s_rectangle_levelset(levelset, levelset_norm, i) elseif (patch_ib(i)%geometry == 4) then - call s_airfoil(i, ib_markers_sf, q_prim_vf, ib) + call s_airfoil(i, ib_markers_sf, ib) call s_airfoil_levelset(levelset, levelset_norm, i) ! STL+IBM patch elseif (patch_ib(i)%geometry == 5) then @@ -448,11 +448,11 @@ contains !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_airfoil(patch_id, patch_id_fp, q_prim_vf, ib) + subroutine s_airfoil(patch_id, patch_id_fp, ib) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + !type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf logical, optional, intent(in) :: ib real(wp) :: x0, y0, f, x_act, y_act, ca, pa, ma, ta, theta, xa, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c @@ -610,11 +610,11 @@ contains !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables !! @param ib True if this patch is an immersed boundary - subroutine s_3D_airfoil(patch_id, patch_id_fp, q_prim_vf, ib) + subroutine s_3D_airfoil(patch_id, patch_id_fp, ib) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp - type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf + !type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf logical, optional, intent(in) :: ib real(wp) :: x0, y0, z0, lz, z_max, z_min, f, x_act, y_act, ca, pa, ma, ta, theta, xa, yt, xu, yu, xl, yl, xc, yc, dycdxc, sin_c, cos_c diff --git a/src/simulation/m_compute_cbc.fpp b/src/simulation/m_compute_cbc.fpp index 022a06175d..7a174dca42 100644 --- a/src/simulation/m_compute_cbc.fpp +++ b/src/simulation/m_compute_cbc.fpp @@ -92,7 +92,6 @@ contains real(wp), dimension(sys_size), intent(inout) :: L real(wp), intent(in) :: rho, c, dpres_ds real(wp), dimension(num_dims), intent(in) :: dvel_ds - integer :: i L(1) = f_base_L1(lambda, rho, c, dpres_ds, dvel_ds) L(2:advxe - 1) = 0._wp diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 552e52995b..53bd1abef3 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -53,22 +53,22 @@ module m_data_output 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(:, :, :) :: ccfl_sf !< CCFL stability criterion real(wp), allocatable, dimension(:, :, :) :: Rc_sf !< Rc stability criterion real(wp), public, allocatable, dimension(:, :) :: c_mass - !$acc declare create(icfl_sf, vcfl_sf, ccfl_sf, Rc_sf, c_mass) + !$acc declare create(icfl_sf, vcfl_sf, Rc_sf, c_mass) 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) :: 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) + !$acc declare create(icfl_max_loc, icfl_max_glb, vcfl_max_loc, vcfl_max_glb, Rc_min_loc, Rc_min_glb) !> @name ICFL, VCFL, CCFL and Rc stability criteria extrema over all the time-steps !> @{ real(wp) :: icfl_max !< ICFL criterion maximum real(wp) :: vcfl_max !< VCFL criterion maximum - real(wp) :: ccfl_max !< CCFL criterion maximum + !real(wp) :: ccfl_max !< CCFL criterion maximum real(wp) :: Rc_min !< Rc criterion maximum !> @} diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index 4e53547a9a..3e379b923d 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -96,15 +96,15 @@ impure subroutine s_initialize_derived_variables end if ! Computing centered finite difference coefficients call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & - fd_number, fd_order) + fd_order, fd_number) if (n > 0) then call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & - fd_number, fd_order) + fd_order, fd_number) end if if (p > 0) then call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & - fd_number, fd_order) + fd_order, fd_number) end if end if diff --git a/src/simulation/m_fftw.fpp b/src/simulation/m_fftw.fpp index 3c18a8c1fe..35cd3f84e5 100644 --- a/src/simulation/m_fftw.fpp +++ b/src/simulation/m_fftw.fpp @@ -131,9 +131,12 @@ contains impure subroutine s_apply_fourier_filter(q_cons_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf +#if defined(MFC_OpenACC) real(c_double), pointer :: p_real(:) complex(c_double_complex), pointer :: p_cmplx(:), p_fltr_cmplx(:) - integer :: i, j, k, l !< Generic loop iterators + integer :: l !< Generic loop iterators +#endif + integer :: i, j, k !< Generic loop iterators ! Restrict filter to processors that have cells adjacent to axis if (bc_y%beg >= 0) return diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 0aed395e8e..adfbc762f6 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -71,16 +71,16 @@ contains ! Computing centered finite difference coefficients call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x, buff_size, & - fd_number, fd_order) + fd_order, fd_number) !$acc update device(fd_coeff_x) if (n > 0) then call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y, buff_size, & - fd_number, fd_order) + fd_order, fd_number) !$acc update device(fd_coeff_y) end if if (p > 0) then call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z, buff_size, & - fd_number, fd_order) + fd_order, fd_number) !$acc update device(fd_coeff_z) end if diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index 059b5746d5..98f6c281b1 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -67,16 +67,16 @@ contains ! Computing centered finite difference coefficients call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x_h, buff_size, & - fd_number, fd_order) + fd_order, fd_number) !$acc update device(fd_coeff_x_h) if (n > 0) then call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y_h, buff_size, & - fd_number, fd_order) + fd_order, fd_number) !$acc update device(fd_coeff_y_h) end if if (p > 0) then call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z_h, buff_size, & - fd_number, fd_order) + fd_order, fd_number) !$acc update device(fd_coeff_z_h) end if diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 3c9b0db535..a8ce75595c 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -80,8 +80,6 @@ contains !! image points. impure subroutine s_ibm_setup() - integer :: i, j, k - !$acc update device(ib_markers%sf) !$acc update device(levelset%sf) !$acc update device(levelset_norm%sf) diff --git a/src/simulation/m_mhd.fpp b/src/simulation/m_mhd.fpp index f5730b513f..de94c23967 100644 --- a/src/simulation/m_mhd.fpp +++ b/src/simulation/m_mhd.fpp @@ -21,10 +21,10 @@ module m_mhd s_finalize_mhd_powell_module, & s_compute_mhd_powell_rhs - real(wp), allocatable, dimension(:, :, :) :: du_dx, du_dy, du_dz - real(wp), allocatable, dimension(:, :, :) :: dv_dx, dv_dy, dv_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) + !$acc declare create(du_dx,du_dy,dv_dx,dv_dy,dw_dx,dw_dy,dw_dz) real(wp), allocatable, dimension(:, :) :: fd_coeff_x_h real(wp), allocatable, dimension(:, :) :: fd_coeff_y_h @@ -51,12 +51,12 @@ contains end if ! Computing centered finite difference coefficients - call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x_h, buff_size, fd_number, fd_order) + call s_compute_finite_difference_coefficients(m, x_cc, fd_coeff_x_h, buff_size, fd_order, fd_number) !$acc update device(fd_coeff_x_h) - call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y_h, buff_size, fd_number, fd_order) + call s_compute_finite_difference_coefficients(n, y_cc, fd_coeff_y_h, buff_size, fd_order, fd_number) !$acc update device(fd_coeff_y_h) if (p > 0) then - call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z_h, buff_size, fd_number, fd_order) + call s_compute_finite_difference_coefficients(p, z_cc, fd_coeff_z_h, buff_size, fd_order, fd_number) !$acc update device(fd_coeff_z_h) end if diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index 93d864c5e8..ce8246ffc5 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -241,7 +241,7 @@ contains integer, intent(in) :: mpi_dir, pbc_loc - integer :: i, j, k, l, r, q !< Generic loop iterators + integer :: j, k, l, r !< Generic loop iterators integer :: buffer_counts(1:3), buffer_count @@ -249,7 +249,7 @@ contains integer :: beg_end(1:2), grid_dims(1:3) integer :: dst_proc, src_proc, recv_tag, send_tag - logical :: beg_end_geq_0, qbmm_comm + logical :: beg_end_geq_0 integer :: pack_offset, unpack_offset diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 8aceb2dfb4..172a0c9a32 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -107,12 +107,12 @@ module m_rhs type(scalar_field), allocatable, dimension(:) :: tau_Re_vf !$acc declare create(tau_Re_vf) - type(vector_field) :: gm_alpha_qp !< + !type(vector_field) :: gm_alpha_qp !< !! The gradient magnitude of the volume fractions at cell-interior Gaussian !! quadrature points. gm_alpha_qp is calculated from individual first-order !! spatial derivatives located in dq_prim_ds_qp. - !$acc declare create(gm_alpha_qp) + !!$acc declare create(gm_alpha_qp) !> @name The left and right WENO-reconstructed cell-boundary values of the cell- !! average gradient magnitude of volume fractions, located in gm_alpha_qp. diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 9c65e51e29..55cf2c5e57 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -312,7 +312,7 @@ contains 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), dimension(3) :: xi_field_L, xi_field_R + !real(wp), dimension(3) :: xi_field_L, xi_field_R real(wp) :: rho_avg real(wp) :: H_avg @@ -361,7 +361,6 @@ contains !$acc private(alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, & !$acc alpha_R, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, & !$acc rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, Ys_L, Ys_R, & - !$acc xi_field_L, xi_field_R, & !$acc Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, & !$acc Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, & !$acc c_fast, pres_mag, B, Ga, vdotB, B2, b4, cm, & @@ -3816,7 +3815,6 @@ contains !! @param ix Index bounds in the x-dir !! @param iy Index bounds in the y-dir !! @param iz Index bounds in the z-dir - !! @param q_prim_vf Cell-averaged primitive variables subroutine s_initialize_riemann_solver( & flux_src_vf, & norm_dir) diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 02b7345530..789a8e56fb 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -1223,7 +1223,7 @@ contains call nvtxEndRange call cpu_time(finish) if (cfl_dt) then - nt = mytime/t_save + nt = int(mytime/t_save) else nt = int((t_step - t_step_start)/(t_step_save)) end if @@ -1336,8 +1336,9 @@ contains end subroutine s_initialize_modules impure subroutine s_initialize_mpi_domain - integer :: ierr #ifdef MFC_OpenACC + integer :: ierr + real(wp) :: starttime, endtime integer :: num_devices, local_size, num_nodes, ppn, my_device_num integer :: dev, devNum, local_rank diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index b1c338b5c9..587c987d7a 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -924,7 +924,7 @@ contains integer, intent(in) :: stage - type(vector_field) :: gm_alpha_qp + !type(vector_field) :: gm_alpha_qp call s_convert_conservative_to_primitive_variables( & q_cons_ts(1)%vf, & @@ -968,7 +968,7 @@ contains 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 + !type(vector_field) :: gm_alpha_qp real(wp) :: dt_local integer :: j, k, l !< Generic loop iterators diff --git a/src/simulation/m_weno.fpp b/src/simulation/m_weno.fpp index fb13b45aba..33c3bf3d2a 100644 --- a/src/simulation/m_weno.fpp +++ b/src/simulation/m_weno.fpp @@ -1261,9 +1261,6 @@ contains !! 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 = 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 do k = is2_weno%beg, is2_weno%end @@ -1296,7 +1293,7 @@ contains vL_UL = v_rs_ws(j, k, l, i) & - (v_rs_ws(j + 1, k, l, i) & - - v_rs_ws(j, k, l, i))*alpha_mp + - v_rs_ws(j, k, l, i))*alpha vL_MD = (v_rs_ws(j, k, l, i) & + v_rs_ws(j - 1, k, l, i) & @@ -1304,7 +1301,7 @@ contains vL_LC = v_rs_ws(j, k, l, i) & - (v_rs_ws(j + 1, k, l, i) & - - v_rs_ws(j, k, l, i))*5.e-1_wp + beta_mp*d_LC + - v_rs_ws(j, k, l, i))*5.e-1_wp + beta*d_LC vL_min = max(min(v_rs_ws(j, k, l, i), & v_rs_ws(j - 1, k, l, i), & @@ -1355,7 +1352,7 @@ contains vR_UL = v_rs_ws(j, k, l, i) & + (v_rs_ws(j, k, l, i) & - - v_rs_ws(j - 1, k, l, i))*alpha_mp + - v_rs_ws(j - 1, k, l, i))*alpha vR_MD = (v_rs_ws(j, k, l, i) & + v_rs_ws(j + 1, k, l, i) & @@ -1363,7 +1360,7 @@ contains vR_LC = v_rs_ws(j, k, l, i) & + (v_rs_ws(j, k, l, i) & - - v_rs_ws(j - 1, k, l, i))*5.e-1_wp + beta_mp*d_LC + - v_rs_ws(j - 1, k, l, i))*5.e-1_wp + beta*d_LC vR_min = max(min(v_rs_ws(j, k, l, i), & v_rs_ws(j + 1, k, l, i), & From 95474cf8a41e19cc6af9ea069e6050767bd161b6 Mon Sep 17 00:00:00 2001 From: XuzhengTian Date: Sat, 28 Jun 2025 20:45:35 -0400 Subject: [PATCH 2/6] Fixed for No double precision intrinsics warning --- src/common/m_checker_common.fpp | 4 ++-- src/common/m_finite_differences.fpp | 2 +- src/common/m_helper_basic.f90 | 6 +++--- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index 1d175d1ed3..6642da052a 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -318,7 +318,7 @@ contains impure subroutine s_check_inputs_surface_tension #ifdef MFC_PRE_PROCESS integer :: i -#endif MFC_PRE_PROCESS +#endif @:PROHIBIT(surface_tension .and. sigma < 0._wp, & "sigma must be greater than or equal to zero") @@ -340,7 +340,7 @@ contains @:PROHIBIT(surface_tension .and. f_is_default(patch_icpp(i)%cf_val), & "patch_icpp(i)%cf_val must be set if surface_tension is enabled") end do -#endif MFC_PRE_PROCESS +#endif end subroutine s_check_inputs_surface_tension diff --git a/src/common/m_finite_differences.fpp b/src/common/m_finite_differences.fpp index 174b0cc1af..8a48c57103 100644 --- a/src/common/m_finite_differences.fpp +++ b/src/common/m_finite_differences.fpp @@ -98,7 +98,7 @@ contains #ifdef MFC_POST_PROCESS if (allocated(fd_coeff_s)) deallocate (fd_coeff_s) - allocate (fd_coeff_s(-fd_number_in:fd_number_in, lb:lE)) + allocate (fd_coeff_s(-fd_number:fd_number, lb:lE)) #endif ! Computing the 1st order finite-difference coefficients diff --git a/src/common/m_helper_basic.f90 b/src/common/m_helper_basic.f90 index b605d2e120..3419ff76b4 100644 --- a/src/common/m_helper_basic.f90 +++ b/src/common/m_helper_basic.f90 @@ -21,7 +21,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 = 1.e-10_wp for double precision and 1e-6 for single). + !! @param tol_input Relative error (default = 1.e-10_wp for double and 1e-6 for single). !! @return Result of the comparison. logical pure elemental function f_approx_equal(a, b, tol_input) result(res) !$acc routine seq @@ -33,9 +33,9 @@ logical pure elemental function f_approx_equal(a, b, tol_input) result(res) tol = tol_input else if (wp == selected_real_kind(15, 307)) then - tol = 1.e-10_wp ! Double Precision + tol = 1.e-10_wp ! Double else if (wp == selected_real_kind(6, 37)) then - tol = 1.e-6_wp ! Single Precision + tol = 1.e-6_wp ! Single end if end if From e3d0040fe8d57adbb1f4816d09ff88cdddc145e8 Mon Sep 17 00:00:00 2001 From: XuzhengTian Date: Sat, 28 Jun 2025 20:52:01 -0400 Subject: [PATCH 3/6] Another fix --- src/common/m_helper_basic.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/common/m_helper_basic.f90 b/src/common/m_helper_basic.f90 index 3419ff76b4..9ee0543603 100644 --- a/src/common/m_helper_basic.f90 +++ b/src/common/m_helper_basic.f90 @@ -33,9 +33,9 @@ logical pure elemental function f_approx_equal(a, b, tol_input) result(res) tol = tol_input else if (wp == selected_real_kind(15, 307)) then - tol = 1.e-10_wp ! Double + tol = 1.e-10_wp else if (wp == selected_real_kind(6, 37)) then - tol = 1.e-6_wp ! Single + tol = 1.e-6_wp end if end if @@ -51,7 +51,7 @@ end function f_approx_equal !> This procedure checks if the point numbers of wp belongs to another array are within tolerance. !! @param a First number. !! @param b Array that contains several point numbers. - !! @param tol_input Relative error (default = 1.e-10_wp for double precision and 1e-6 for single). + !! @param tol_input Relative error (default = 1.e-10_wp for double and 1e-6 for single). !! @return Result of the comparison. logical pure function f_approx_in_array(a, b, tol_input) result(res) !$acc routine seq @@ -67,9 +67,9 @@ logical pure function f_approx_in_array(a, b, tol_input) result(res) tol = tol_input else if (wp == selected_real_kind(15, 307)) then - tol = 1.e-10_wp ! Double Precision + tol = 1.e-10_wp else if (wp == selected_real_kind(6, 37)) then - tol = 1.e-6_wp ! Single Precision + tol = 1.e-6_wp end if end if From 082b2bac9959a9c24f7fb68de5c43a7c5ec4f1d2 Mon Sep 17 00:00:00 2001 From: XuzhengTian Date: Sat, 28 Jun 2025 20:55:35 -0400 Subject: [PATCH 4/6] Format --- 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 9ee0543603..911207a5b8 100644 --- a/src/common/m_helper_basic.f90 +++ b/src/common/m_helper_basic.f90 @@ -35,7 +35,7 @@ logical pure elemental function f_approx_equal(a, b, tol_input) result(res) if (wp == selected_real_kind(15, 307)) then tol = 1.e-10_wp else if (wp == selected_real_kind(6, 37)) then - tol = 1.e-6_wp + tol = 1.e-6_wp end if end if From 7a287ce5a81f21f3c75f7d2fa3f1aae664a3391c Mon Sep 17 00:00:00 2001 From: XuzhengTian Date: Tue, 1 Jul 2025 00:21:38 -0400 Subject: [PATCH 5/6] Possible fix for Cray --- src/common/m_variables_conversion.fpp | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index e9466c1999..e6553b2bd1 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -487,9 +487,9 @@ contains real(wp), optional, intent(out) :: G_K real(wp), optional, dimension(num_fluids), intent(in) :: G real(wp) :: alpha_K_sum - + integer :: i #ifdef MFC_SIMULATION - integer :: i, j !< Generic loop iterators + integer :: j !< Generic loop iterators #endif ! Initiate the variables to avoid compiler warnings rho_K = 0._wp @@ -498,7 +498,9 @@ contains qv_K = 0._wp alpha_K_sum = 0._wp if (present(G_K) .and. present(G)) G_K = 0._wp - Re_K(:) = dflt_real + do i = 1, 2 + Re_K(i) = dflt_real + end do #ifdef MFC_SIMULATION ! Constraining the partial densities and the volume fractions within ! their physical bounds to make sure that any mixture variables that From 249fd15032e9e61e468bbb4b992476087537d75b Mon Sep 17 00:00:00 2001 From: XuzhengTian Date: Tue, 1 Jul 2025 12:59:12 -0400 Subject: [PATCH 6/6] Possible fix 2 --- src/common/m_variables_conversion.fpp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index e6553b2bd1..d837dfca3c 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -497,7 +497,7 @@ contains pi_inf_K = 0._wp qv_K = 0._wp alpha_K_sum = 0._wp - if (present(G_K) .and. present(G)) G_K = 0._wp + do i = 1, 2 Re_K(i) = dflt_real end do @@ -526,6 +526,7 @@ contains end do if (present(G_K)) then + G_K = 0._wp do i = 1, num_fluids !TODO: change to use Gs directly here? !TODO: Make this changes as well for GPUs