diff --git a/src/common/m_boundary_common.fpp b/src/common/m_boundary_common.fpp index 4087a0045..e9cce4f52 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 1c3a23894..6642da052 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 @:PROHIBIT(surface_tension .and. sigma < 0._wp, & "sigma must be greater than or equal to zero") @@ -339,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 2eb792042..8a48c5710 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,10 +90,15 @@ 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) - 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 74cb61f2a..911207a5b 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 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 + else if (wp == selected_real_kind(6, 37)) then + tol = 1.e-6_wp + 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 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 + else if (wp == selected_real_kind(6, 37)) then + tol = 1.e-6_wp + 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 b92015148..fd4ed4c9e 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 ce3273751..69e1528a6 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 949eac92c..d837dfca3 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,22 +486,27 @@ 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 - + integer :: i #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 :: 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 + 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 + ! 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 alpha_rho_K(i) = max(0._wp, alpha_rho_K(i)) @@ -519,8 +538,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 +566,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 +605,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 +618,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 +625,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 +648,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 +1184,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 +1212,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 +1462,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 +1479,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 b733f43dd..97a1b7ffa 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 264b227f2..7725833d1 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 17f66f8d6..30c2711cd 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 b3f6b48fe..45339ad84 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 022a06175..7a174dca4 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 552e52995..53bd1abef 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 4e53547a9..3e379b923 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 3c18a8c1f..35cd3f84e 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 0aed395e8..adfbc762f 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 059b5746d..98f6c281b 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 3c9b0db53..a8ce75595 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 f5730b513..de94c2396 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 93d864c5e..ce8246ffc 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 8aceb2dfb..172a0c9a3 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 8b9d0cf04..49727ba54 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -313,7 +313,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 @@ -362,7 +362,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, & @@ -3662,7 +3661,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 02b734553..789a8e56f 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 b1c338b5c..587c987d7 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 fb13b45ab..33c3bf3d2 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), &