diff --git a/misc/m_silo_proxy.f90 b/misc/m_silo_proxy.f90 index bb3055e717..2288076dcb 100755 --- a/misc/m_silo_proxy.f90 +++ b/misc/m_silo_proxy.f90 @@ -44,7 +44,7 @@ module m_silo_proxy !> @brief Refer to page 28 of Silo's user guide (10/2007, v4.6) for !! information about this subroutine - function DBCREATE(pathname, lpathname, mode, target, & + impure function DBCREATE(pathname, lpathname, mode, target, & fileinfo, lfileinfo, filetype, status) integer :: DBCREATE @@ -66,7 +66,7 @@ end function DBCREATE !> @brief Refer to page 235 of Silo's user guide (10/2007, v4.6) !! for information about this subroutine - function DBGET2DSTRLEN() + impure function DBGET2DSTRLEN() integer :: DBGET2DSTRLEN @@ -79,7 +79,7 @@ end function DBGET2DSTRLEN !> @brief Refer to page 234 of Silo's user guide (10/2007, v4.6) !! for information about this subroutine - function DBSET2DSTRLEN(len) + impure function DBSET2DSTRLEN(len) integer :: DBSET2DSTRLEN integer, intent(IN) :: len @@ -93,7 +93,7 @@ end function DBSET2DSTRLEN !> @brief Refer to page 185 of Silo's user guide (10/2007, v4.6) !! for information about this subroutine - function DBMKOPTLIST(maxopts, optlist_id) + impure function DBMKOPTLIST(maxopts, optlist_id) integer :: DBMKOPTLIST integer, intent(IN) :: maxopts @@ -107,7 +107,7 @@ end function DBMKOPTLIST !> @brief Refer to page 186 of Silo's user guide (10/2007, v4.6) !! for information about this subroutine - function DBADDIOPT(optlist_id, option, ivalue) + impure function DBADDIOPT(optlist_id, option, ivalue) integer :: DBADDIOPT integer, intent(IN) :: optlist_id @@ -123,7 +123,7 @@ end function DBADDIOPT !> @brief Refer to page 186 of Silo's user guide (10/2007, v4.6) !! for information about this subroutine - function DBADDDOPT(optlist_id, option, dvalue) + impure function DBADDDOPT(optlist_id, option, dvalue) integer :: DBADDDOPT integer, intent(IN) :: optlist_id @@ -139,7 +139,7 @@ end function DBADDDOPT !> @brief Refer to page 121 of Silo's user guide (10/2007, v4.6) !! for information about this subroutine - function DBPUTMMESH(dbid, name, lname, nmesh, meshnames, & + impure function DBPUTMMESH(dbid, name, lname, nmesh, meshnames, & lmeshnames, meshtypes, optlist_id, status) integer :: DBPUTMMESH @@ -162,7 +162,7 @@ end function DBPUTMMESH !> @brief Refer to page 189 of Silo's user guide (10/2007, v4.6) !! for information about this subroutine - function DBFREEOPTLIST(optlist_id) + impure function DBFREEOPTLIST(optlist_id) integer :: DBFREEOPTLIST integer, intent(IN) :: optlist_id @@ -175,7 +175,7 @@ end function DBFREEOPTLIST !> @brief Refer to page 57 of Silo's user guide (10/2007, v4.6) for !! information about this subroutine - function DBPUTQM(dbid, name, lname, xname, lxname, yname, lyname, & + impure function DBPUTQM(dbid, name, lname, xname, lxname, yname, lyname, & zname, lzname, x, y, z, dims, ndims, datatype, & coordtype, optlist_id, status) @@ -208,7 +208,7 @@ end function DBPUTQM !> @brief Refer to page 46 of Silo's user guide (10/2007, v4.6) for !! information about this subroutine - function DBPUTCURVE(dbid, curvename, lcurvename, xvals, yvals, & + impure function DBPUTCURVE(dbid, curvename, lcurvename, xvals, yvals, & datatype, npoints, optlist_id, status) integer :: DBPUTCURVE @@ -231,7 +231,7 @@ end function DBPUTCURVE !> @brief Refer to page 130 of Silo's user guide (10/2007, v4.6) !! for information about this subroutine - function DBPUTMVAR(dbid, name, lname, nvar, varnames, lvarnames, & + impure function DBPUTMVAR(dbid, name, lname, nvar, varnames, lvarnames, & vartypes, optlist_id, status) integer :: DBPUTMVAR @@ -254,7 +254,7 @@ end function DBPUTMVAR !> @brief Refer to page 64 of Silo's user guide (10/2007, v4.6) for !! information about this subroutine - function DBPUTQV1(dbid, name, lname, meshname, lmeshname, var, & + impure function DBPUTQV1(dbid, name, lname, meshname, lmeshname, var, & dims, ndims, mixvar, mixlen, datatype, & centering, optlist_id, status) @@ -283,7 +283,7 @@ end function DBPUTQV1 !> @brief Refer to page 31 of Silo's user guide (10/2007, v4.6) for !! information about this subroutine - function DBCLOSE(dbid) + impure function DBCLOSE(dbid) integer :: DBCLOSE integer, intent(IN) :: dbid diff --git a/src/common/m_boundary_common.fpp b/src/common/m_boundary_common.fpp index a242316f15..ea72026dfc 100644 --- a/src/common/m_boundary_common.fpp +++ b/src/common/m_boundary_common.fpp @@ -42,7 +42,7 @@ module m_boundary_common contains - subroutine s_initialize_boundary_common_module() + impure subroutine s_initialize_boundary_common_module() bcxb = bc_x%beg; bcxe = bc_x%end; bcyb = bc_y%beg; bcye = bc_y%end; bczb = bc_z%beg; bcze = bc_z%end @@ -71,7 +71,7 @@ contains !> The purpose of this procedure is to populate the buffers !! of the primitive variables, depending on the selected !! boundary conditions. - subroutine s_populate_variables_buffers(q_prim_vf, pb, mv, bc_type) + impure subroutine s_populate_variables_buffers(q_prim_vf, pb, mv, bc_type) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:, 1:), intent(inout) :: pb, mv @@ -237,7 +237,7 @@ contains end subroutine s_populate_variables_buffers - subroutine s_ghost_cell_extrapolation(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l) + pure subroutine s_ghost_cell_extrapolation(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_ghost_cell_extrapolation #else @@ -306,7 +306,7 @@ contains end subroutine s_ghost_cell_extrapolation - subroutine s_symmetry(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l) + pure subroutine s_symmetry(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_symmetry #else @@ -570,7 +570,7 @@ contains end subroutine s_symmetry - subroutine s_periodic(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l) + pure subroutine s_periodic(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_periodic #else @@ -713,7 +713,7 @@ contains end subroutine s_periodic - subroutine s_axis(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l) + pure subroutine s_axis(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_axis #else @@ -777,7 +777,7 @@ contains end subroutine s_axis - subroutine s_slip_wall(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l) + pure subroutine s_slip_wall(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_slip_wall #else @@ -876,7 +876,7 @@ contains end subroutine s_slip_wall - subroutine s_no_slip_wall(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l) + pure subroutine s_no_slip_wall(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_no_slip_wall #else @@ -1011,7 +1011,7 @@ contains end subroutine s_no_slip_wall - subroutine s_dirichlet(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l) + pure subroutine s_dirichlet(q_prim_vf, pb, mv, bc_dir, bc_loc, k, l) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_dirichlet #else @@ -1080,7 +1080,7 @@ contains end subroutine s_dirichlet - subroutine s_qbmm_extrapolation(pb, mv, bc_dir, bc_loc, k, l) + pure subroutine s_qbmm_extrapolation(pb, mv, bc_dir, bc_loc, k, l) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_qbmm_extrapolation #else @@ -1156,7 +1156,7 @@ contains end subroutine s_qbmm_extrapolation - subroutine s_populate_capillary_buffers(c_divs, bc_type) + impure subroutine s_populate_capillary_buffers(c_divs, bc_type) type(scalar_field), dimension(num_dims + 1), intent(inout) :: c_divs type(integer_field), dimension(1:num_dims, -1:1), intent(in) :: bc_type @@ -1279,7 +1279,7 @@ contains end if end subroutine s_populate_capillary_buffers - subroutine s_color_function_periodic(c_divs, bc_dir, bc_loc, k, l) + pure subroutine s_color_function_periodic(c_divs, bc_dir, bc_loc, k, l) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_color_function_periodic #else @@ -1337,7 +1337,7 @@ contains end subroutine s_color_function_periodic - subroutine s_color_function_reflective(c_divs, bc_dir, bc_loc, k, l) + pure subroutine s_color_function_reflective(c_divs, bc_dir, bc_loc, k, l) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_color_function_reflective #else @@ -1419,7 +1419,7 @@ contains end subroutine s_color_function_reflective - subroutine s_color_function_ghost_cell_extrapolation(c_divs, bc_dir, bc_loc, k, l) + pure subroutine s_color_function_ghost_cell_extrapolation(c_divs, bc_dir, bc_loc, k, l) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_color_function_ghost_cell_extrapolation #else @@ -1477,7 +1477,7 @@ contains end subroutine s_color_function_ghost_cell_extrapolation - subroutine s_create_mpi_types(bc_type) + impure subroutine s_create_mpi_types(bc_type) type(integer_field), dimension(1:num_dims, -1:1) :: bc_type @@ -1510,7 +1510,7 @@ contains #endif end subroutine s_create_mpi_types - subroutine s_finalize_boundary_common_module() + impure subroutine s_finalize_boundary_common_module() #ifndef MFC_POST_PROCESS if (bc_io) then diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index 3971552120..5ec438a7dd 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -24,7 +24,7 @@ contains !> Checks compatibility of parameters in the input file. !! Used by all three stages - subroutine s_check_inputs_common + impure subroutine s_check_inputs_common #ifndef MFC_PRE_PROCESS call s_check_inputs_time_stepping @@ -60,7 +60,7 @@ contains !> Checks constraints on the time-stepping parameters. !! Called by s_check_inputs_common for simulation and post-processing - subroutine s_check_inputs_time_stepping + impure subroutine s_check_inputs_time_stepping if (cfl_dt) then @:PROHIBIT(cfl_target < 0 .or. cfl_target > 1._wp) @:PROHIBIT(t_stop <= 0) @@ -76,7 +76,7 @@ contains !> Checks constraints on the finite difference parameters. !! Called by s_check_inputs_common for simulation and post-processing - subroutine s_check_inputs_finite_difference + impure subroutine s_check_inputs_finite_difference @:PROHIBIT(all(fd_order /= (/dflt_int, 1, 2, 4/)), "fd_order must be 1, 2, or 4") end subroutine s_check_inputs_finite_difference @@ -85,7 +85,7 @@ contains #ifndef MFC_SIMULATION ! Checks constraints on the total number of cells - subroutine s_check_total_cells + impure subroutine s_check_total_cells character(len=5) :: numStr !< for int to string conversion call s_int_to_str(2**(min(1, m) + min(1, n) + min(1, p))*num_procs, numStr) @@ -100,7 +100,7 @@ contains !> Checks constraints on the bubble parameters. !! Called by s_check_inputs_common for pre-processing and simulation - subroutine s_check_inputs_bubbles_euler + impure subroutine s_check_inputs_bubbles_euler @:PROHIBIT(bubbles_euler .and. nb < 1, "The Ensemble-Averaged Bubble Model requires nb >= 1") @:PROHIBIT(bubbles_euler .and. polydisperse .and. (nb == 1), "Polydisperse bubble dynamics requires nb > 1") @:PROHIBIT(bubbles_euler .and. polydisperse .and. (mod(nb, 2) == 0), "nb must be odd") @@ -117,7 +117,7 @@ contains !> Checks constraints on the QBMM and polydisperse bubble parameters. !! Called by s_check_inputs_common for pre-processing and simulation - subroutine s_check_inputs_qbmm_and_polydisperse + impure subroutine s_check_inputs_qbmm_and_polydisperse @:PROHIBIT(polydisperse .and. (.not. bubbles_euler), "Polydisperse bubble modeling requires the bubbles_euler flag to be set") @:PROHIBIT(polydisperse .and. f_is_default(poly_sigma), "Polydisperse bubble modeling requires poly_sigma to be set") @:PROHIBIT(polydisperse .and. poly_sigma <= 0) @@ -127,7 +127,7 @@ contains !> Checks constraints on the adv_n flag. !! Called by s_check_inputs_common for pre-processing and simulation - subroutine s_check_inputs_adv_n + impure subroutine s_check_inputs_adv_n @:PROHIBIT(adv_n .and. (.not. bubbles_euler)) @:PROHIBIT(adv_n .and. num_fluids /= 1) @:PROHIBIT(adv_n .and. qbmm) @@ -135,7 +135,7 @@ contains !> Checks constraints on the hypoelasticity parameters. !! Called by s_check_inputs_common for pre-processing and simulation - subroutine s_check_inputs_hypoelasticity + impure subroutine s_check_inputs_hypoelasticity @:PROHIBIT(hypoelasticity .and. model_eqns /= 2) #ifdef MFC_SIMULATION @:PROHIBIT(elasticity .and. fd_order /= 4) @@ -144,7 +144,7 @@ contains !> Checks constraints on the hyperelasticity parameters. !! Called by s_check_inputs_common for pre-processing and simulation - subroutine s_check_inputs_hyperelasticity + impure subroutine s_check_inputs_hyperelasticity @:PROHIBIT(hyperelasticity .and. model_eqns == 1) @:PROHIBIT(hyperelasticity .and. model_eqns > 3) #ifdef MFC_SIMULATION @@ -154,7 +154,7 @@ contains !> Checks constraints on the phase change parameters. !! Called by s_check_inputs_common for pre-processing and simulation - subroutine s_check_inputs_phase_change + impure subroutine s_check_inputs_phase_change @: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") @@ -170,7 +170,7 @@ contains !> Checks constraints on the Immersed Boundaries parameters. !! Called by s_check_inputs_common for pre-processing and simulation - subroutine s_check_inputs_ibm + impure subroutine s_check_inputs_ibm @:PROHIBIT(ib .and. n <= 0, "Immersed Boundaries do not work in 1D") @:PROHIBIT(ib .and. (num_ibs <= 0 .or. num_ibs > num_patches_max), "num_ibs must be between 1 and num_patches_max") @:PROHIBIT((.not. ib) .and. num_ibs > 0, "num_ibs is set, but ib is not enabled") @@ -180,7 +180,7 @@ contains !> Checks constraints on dimensionality and the number of cells for the grid. !! Called by s_check_inputs_common for all three stages - subroutine s_check_inputs_simulation_domain + impure subroutine s_check_inputs_simulation_domain @:PROHIBIT(m == dflt_int, "m must be set") @:PROHIBIT(n == dflt_int, "n must be set") @:PROHIBIT(p == dflt_int, "p must be set") @@ -193,7 +193,7 @@ contains !> Checks constraints on model equations and number of fluids in the flow. !! Called by s_check_inputs_common for all three stages - subroutine s_check_inputs_model_eqns_and_num_fluids + impure subroutine s_check_inputs_model_eqns_and_num_fluids @:PROHIBIT(all(model_eqns /= (/1, 2, 3, 4/)), "model_eqns must be 1, 2, 3, or 4") @:PROHIBIT(num_fluids /= dflt_int .and. num_fluids < 1, "num_fluids must be positive") @:PROHIBIT(model_eqns == 1 .and. num_fluids /= dflt_int, "num_fluids is not supported for model_eqns = 1") @@ -207,7 +207,7 @@ contains !> Checks constraints regarding WENO order. !! Called by s_check_inputs_common for all three stages - subroutine s_check_inputs_weno + impure subroutine s_check_inputs_weno @:PROHIBIT(all(weno_order /= (/1, 3, 5, 7/)), "weno_order must be 1, 3, 5, or 7") @:PROHIBIT(m + 1 < weno_order, "m must be at least weno_order - 1") @:PROHIBIT(n > 0 .and. n + 1 < weno_order, "n must be at least weno_order - 1") @@ -216,7 +216,7 @@ contains !> Checks constraints on the boundary conditions in the x-direction. !! Called by s_check_inputs_common for all three stages - subroutine s_check_inputs_bc + impure subroutine s_check_inputs_bc logical :: skip_check !< Flag to skip the check when iterating over !! x, y, and z directions, for special treatment of cylindrical coordinates @@ -278,7 +278,7 @@ contains !> Checks constraints on the stiffened equation of state fluids parameters. !! Called by s_check_inputs_common for all three stages - subroutine s_check_inputs_stiffened_eos + impure subroutine s_check_inputs_stiffened_eos character(len=5) :: iStr !< for int to string conversion integer :: bub_fac !< For allowing an extra fluid_pp if there are subgrid bubbles_euler integer :: i @@ -315,7 +315,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 + impure subroutine s_check_inputs_surface_tension integer :: i @@ -345,7 +345,7 @@ contains !> Checks constraints on the inputs for moving boundaries. !! Called by s_check_inputs_common for all three stages - subroutine s_check_inputs_moving_bc + impure 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/) /= 0._wp)) then if (bc_${X}$%beg == BC_SLIP_WALL) then @@ -377,7 +377,7 @@ contains #:endfor end subroutine s_check_inputs_moving_bc - subroutine s_check_inputs_mhd + impure subroutine s_check_inputs_mhd @:PROHIBIT(mhd .and. num_fluids /= 1, "MHD is only available for single-component flows") @:PROHIBIT(mhd .and. model_eqns /= 2, "MHD is only available for the 5-equation model") diff --git a/src/common/m_compile_specific.f90 b/src/common/m_compile_specific.f90 index fabc347a29..8479755961 100644 --- a/src/common/m_compile_specific.f90 +++ b/src/common/m_compile_specific.f90 @@ -14,7 +14,7 @@ module m_compile_specific !> Creates a directory and all its parents if it does not exist !! @param dir_name Directory path - subroutine s_create_directory(dir_name) + impure subroutine s_create_directory(dir_name) character(LEN=*), intent(in) :: dir_name #ifdef _WIN32 @@ -25,7 +25,7 @@ subroutine s_create_directory(dir_name) end subroutine s_create_directory - subroutine s_delete_file(filepath) + impure subroutine s_delete_file(filepath) character(LEN=*), intent(in) :: filepath #ifdef _WIN32 @@ -36,7 +36,7 @@ subroutine s_delete_file(filepath) end subroutine s_delete_file - subroutine s_delete_directory(dir_name) + impure subroutine s_delete_directory(dir_name) character(LEN=*), intent(in) :: dir_name #ifdef _WIN32 @@ -50,7 +50,7 @@ end subroutine s_delete_directory !> Inquires on the existence of a directory !! @param fileloc File directory location !! @param dircheck Switch that indicates if directory exists - subroutine my_inquire(fileloc, dircheck) + impure subroutine my_inquire(fileloc, dircheck) character(LEN=*), intent(in) :: fileloc logical, intent(inout) :: dircheck @@ -62,13 +62,13 @@ subroutine my_inquire(fileloc, dircheck) end subroutine my_inquire - subroutine s_get_cwd(cwd) + impure subroutine s_get_cwd(cwd) character(LEN=*), intent(out) :: cwd call GETCWD(cwd) end subroutine s_get_cwd - subroutine s_get_basename(dirpath, basename) + impure subroutine s_get_basename(dirpath, basename) character(LEN=*), intent(in) :: dirpath character(LEN=*), intent(out) :: basename diff --git a/src/common/m_delay_file_access.f90 b/src/common/m_delay_file_access.f90 index 48fbb9aaea..09ec5008a5 100644 --- a/src/common/m_delay_file_access.f90 +++ b/src/common/m_delay_file_access.f90 @@ -11,7 +11,7 @@ module m_delay_file_access contains - subroutine DelayFileAccess(ProcessRank) + impure subroutine DelayFileAccess(ProcessRank) integer, intent(in) :: ProcessRank integer :: iDelay, nFileAccessDelayIterations diff --git a/src/common/m_eigen_solver.f90 b/src/common/m_eigen_solver.f90 index 4bbf6aa97e..292ba1f730 100644 --- a/src/common/m_eigen_solver.f90 +++ b/src/common/m_eigen_solver.f90 @@ -33,7 +33,7 @@ module m_eigen_solver !! @param fv2 temporary storage array !! @param fv3 temporary storage array !! @param ierr an error completion code - subroutine cg(nm, nl, ar, ai, wr, wi, zr, zi, fv1, fv2, fv3, ierr) + pure subroutine cg(nm, nl, ar, ai, wr, wi, zr, zi, fv1, fv2, fv3, ierr) integer, intent(in) :: nm, nl real(wp), dimension(nm, nl), intent(inout) :: ar, ai real(wp), dimension(nl), intent(out) :: wr, wi @@ -76,7 +76,7 @@ end subroutine cg !! (2) j=1, ,low-1 or i=igh+1, ,nl. !! @param scale the information determining the permutations and scaling !! factors used. - subroutine cbal(nm, nl, ar, ai, low, igh, scale) + pure subroutine cbal(nm, nl, ar, ai, low, igh, scale) integer, intent(in) :: nm, nl real(wp), dimension(nm, nl), intent(inout) :: ar, ai integer, intent(out) :: low, igh @@ -219,7 +219,7 @@ end subroutine cbal !! if cbal has not been used, set igh=nl. !! @param ortr further information about the transformations !! @param orti further information about the transformations - subroutine corth(nm, nl, low, igh, ar, ai, ortr, orti) + pure subroutine corth(nm, nl, low, igh, ar, ai, ortr, orti) integer, intent(in) :: nm, nl, low, igh real(wp), dimension(nm, nl), intent(inout) :: ar, ai real(wp), dimension(igh), intent(out) :: ortr, orti @@ -343,7 +343,7 @@ end subroutine corth !! @param zr the real part of the eigenvectors !! @param zi the imaginary part of the eigenvectors !! @param ierr an error completion code - subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) + pure subroutine comqr2(nm, nl, low, igh, ortr, orti, hr, hi, wr, wi, zr, zi, ierr) integer, intent(in) :: nm, nl, low, igh real(wp), dimension(nm, nl), intent(inout) :: hr, hi real(wp), dimension(nl), intent(out) :: wr, wi @@ -706,7 +706,7 @@ end subroutine comqr2 !! their first ml columns !! @param zi the imaginary part of the eigenvectors to be back !! transformed in their first ml columns - subroutine cbabk2(nm, nl, low, igh, scale, ml, zr, zi) + pure subroutine cbabk2(nm, nl, low, igh, scale, ml, zr, zi) integer, intent(in) :: nm, nl, low, igh real(wp), intent(in) :: scale(nl) integer, intent(in) :: ml @@ -752,7 +752,7 @@ subroutine cbabk2(nm, nl, low, igh, scale, ml, zr, zi) 200 return end subroutine cbabk2 - subroutine csroot(xr, xi, yr, yi) + pure elemental subroutine csroot(xr, xi, yr, yi) real(wp), intent(in) :: xr, xi real(wp), intent(out) :: yr, yi @@ -772,7 +772,7 @@ subroutine csroot(xr, xi, yr, yi) return end subroutine csroot - subroutine cdiv(ar, ai, br, bi, cr, ci) + pure elemental subroutine cdiv(ar, ai, br, bi, cr, ci) real(wp), intent(in) :: ar, ai, br, bi real(wp), intent(out) :: cr, ci real(wp) :: s, ars, ais, brs, bis @@ -788,7 +788,7 @@ subroutine cdiv(ar, ai, br, bi, cr, ci) return end subroutine cdiv - subroutine pythag(a, b, c) + pure elemental subroutine pythag(a, b, c) real(wp), intent(in) :: a, b real(wp), intent(out) :: c diff --git a/src/common/m_finite_differences.fpp b/src/common/m_finite_differences.fpp index 3deee10b67..d8f3c0f54a 100644 --- a/src/common/m_finite_differences.fpp +++ b/src/common/m_finite_differences.fpp @@ -6,7 +6,7 @@ module m_finite_differences contains - subroutine s_compute_fd_divergence(div, fields, ix_s, iy_s, iz_s) + pure subroutine s_compute_fd_divergence(div, fields, ix_s, iy_s, iz_s) type(scalar_field), intent(INOUT) :: div type(scalar_field), intent(IN) :: fields(1:3) @@ -67,8 +67,8 @@ contains !! @param q Number of cells in the s-coordinate direction !! @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 - subroutine s_compute_finite_difference_coefficients(q, s_cc, fd_coeff_s, buff_size, & - fd_number_in, fd_order_in, offset_s) + pure subroutine s_compute_finite_difference_coefficients(q, s_cc, fd_coeff_s, buff_size, & + fd_number_in, fd_order_in, offset_s) integer :: lB, lE !< loop bounds integer, intent(IN) :: q diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp index 186ff9e2e7..4be5974c2e 100644 --- a/src/common/m_helper.fpp +++ b/src/common/m_helper.fpp @@ -42,7 +42,7 @@ contains !! @param vftmp is the void fraction !! @param Rtmp is the bubble radii !! @param ntmp is the output number bubble density - subroutine s_comp_n_from_prim(vftmp, Rtmp, ntmp, weights) + pure subroutine s_comp_n_from_prim(vftmp, Rtmp, ntmp, weights) !$acc routine seq real(wp), intent(in) :: vftmp real(wp), dimension(nb), intent(in) :: Rtmp @@ -56,7 +56,7 @@ contains end subroutine s_comp_n_from_prim - subroutine s_comp_n_from_cons(vftmp, nRtmp, ntmp, weights) + pure subroutine s_comp_n_from_cons(vftmp, nRtmp, ntmp, weights) !$acc routine seq real(wp), intent(in) :: vftmp real(wp), dimension(nb), intent(in) :: nRtmp @@ -70,7 +70,7 @@ contains end subroutine s_comp_n_from_cons - subroutine s_print_2D_array(A, div) + impure subroutine s_print_2D_array(A, div) real(wp), dimension(:, :), intent(in) :: A real(wp), optional, intent(in) :: div @@ -101,7 +101,7 @@ contains end subroutine s_print_2D_array !> Initializes non-polydisperse bubble modeling - subroutine s_initialize_nonpoly + impure subroutine s_initialize_nonpoly integer :: ir real(wp) :: rhol0, pl0, uu, D_m, temp, omega_ref @@ -219,7 +219,7 @@ contains !! @param peclet Peclet number !! @param Re_trans Real part of the transport coefficients !! @param Im_trans Imaginary part of the transport coefficients - subroutine s_transcoeff(omega, peclet, Re_trans, Im_trans) + pure elemental subroutine s_transcoeff(omega, peclet, Re_trans, Im_trans) real(wp), intent(in) :: omega, peclet real(wp), intent(out) :: Re_trans, Im_trans @@ -238,7 +238,7 @@ contains end subroutine s_transcoeff - subroutine s_int_to_str(i, res) + pure elemental subroutine s_int_to_str(i, res) integer, intent(in) :: i character(len=*), intent(inout) :: res @@ -248,7 +248,10 @@ contains end subroutine s_int_to_str !> Computes the Simpson weights for quadrature - subroutine s_simpson + subroutine s_simpson(weight, R0) + + real(wp), dimension(:), intent(inout) :: weight + real(wp), dimension(:), intent(inout) :: R0 integer :: ir real(wp) :: R0mn, R0mx, dphi, tmp, sd @@ -286,7 +289,7 @@ contains !! @param a First vector. !! @param b Second vector. !! @return The cross product of the two vectors. - function f_cross(a, b) result(c) + pure function f_cross(a, b) result(c) real(wp), dimension(3), intent(in) :: a, b real(wp), dimension(3) :: c @@ -299,7 +302,7 @@ contains !> This procedure swaps two real numbers. !! @param lhs Left-hand side. !! @param rhs Right-hand side. - subroutine s_swap(lhs, rhs) + pure elemental subroutine s_swap(lhs, rhs) real(wp), intent(inout) :: lhs, rhs real(wp) :: ltemp @@ -312,7 +315,7 @@ contains !> This procedure creates a transformation matrix. !! @param p Parameters for the transformation. !! @return Transformation matrix. - function f_create_transform_matrix(p, center) result(out_matrix) + pure function f_create_transform_matrix(p, center) result(out_matrix) type(ic_model_parameters), intent(in) :: p t_vec3, optional, intent(in) :: center @@ -373,7 +376,7 @@ contains !> This procedure transforms a vector by a matrix. !! @param vec Vector to transform. !! @param matrix Transformation matrix. - subroutine s_transform_vec(vec, matrix) + pure subroutine s_transform_vec(vec, matrix) t_vec3, intent(inout) :: vec t_mat4x4, intent(in) :: matrix @@ -388,7 +391,7 @@ contains !> This procedure transforms a triangle by a matrix, one vertex at a time. !! @param triangle Triangle to transform. !! @param matrix Transformation matrix. - subroutine s_transform_triangle(triangle, matrix, matrix_n) + pure subroutine s_transform_triangle(triangle, matrix, matrix_n) type(t_triangle), intent(inout) :: triangle t_mat4x4, intent(in) :: matrix, matrix_n @@ -406,7 +409,7 @@ contains !> This procedure transforms a model by a matrix, one triangle at a time. !! @param model Model to transform. !! @param matrix Transformation matrix. - subroutine s_transform_model(model, matrix, matrix_n) + pure subroutine s_transform_model(model, matrix, matrix_n) type(t_model), intent(inout) :: model t_mat4x4, intent(in) :: matrix, matrix_n @@ -422,7 +425,7 @@ contains !> This procedure creates a bounding box for a model. !! @param model Model to create bounding box for. !! @return Bounding box. - function f_create_bbox(model) result(bbox) + pure function f_create_bbox(model) result(bbox) type(t_model), intent(in) :: model type(t_bbox) :: bbox @@ -447,7 +450,11 @@ contains end function f_create_bbox - function f_xor(lhs, rhs) result(res) + !> This procedure performs xor on lhs and rhs. + !! @param lhs logical input. + !! @param rhs other logical input. + !! @return xored result. + pure elemental function f_xor(lhs, rhs) result(res) logical, intent(in) :: lhs, rhs logical :: res @@ -455,7 +462,10 @@ contains res = (lhs .and. .not. rhs) .or. (.not. lhs .and. rhs) end function f_xor - function f_logical_to_int(predicate) result(int) + !> This procedure converts logical to 1 or 0. + !! @param perdicate A Logical argument. + !! @return 1 if .true., 0 if .false.. + pure elemental function f_logical_to_int(predicate) result(int) logical, intent(in) :: predicate integer :: int @@ -471,7 +481,7 @@ contains !! @param x is the input value !! @param l is the degree !! @return P is the unassociated legendre polynomial evaluated at x - recursive function unassociated_legendre(x, l) result(P) + pure recursive function unassociated_legendre(x, l) result(P) integer, intent(in) :: l real(wp), intent(in) :: x @@ -493,7 +503,7 @@ contains !! @param l is the degree !! @param m is the order !! @return Y is the spherical harmonic function evaluated at x and phi - recursive function spherical_harmonic_func(x, phi, l, m) result(Y) + pure recursive function spherical_harmonic_func(x, phi, l, m) result(Y) integer, intent(in) :: l, m real(wp), intent(in) :: x, phi @@ -515,7 +525,7 @@ contains !! @param l is the degree !! @param m is the order !! @return P is the associated legendre polynomial evaluated at x - recursive function associated_legendre(x, l, m) result(P) + pure recursive function associated_legendre(x, l, m) result(P) integer, intent(in) :: l, m real(wp), intent(in) :: x @@ -540,36 +550,29 @@ contains !> This function calculates the double factorial value of an integer !! @param n is the input integer !! @return R is the double factorial value of n - recursive function double_factorial(n) result(R) + pure elemental function double_factorial(n) result(R) integer, intent(in) :: n integer, parameter :: int64_kind = selected_int_kind(18) ! 18 bytes for 64-bit integer integer(kind=int64_kind) :: R + integer :: i - if (n <= 0) then - R = 1 - else if (n == 1) then - R = 1 - else - R = n*double_factorial(n - 2) - end if + R = product((/(i, i=n, 1, -2)/)) end function double_factorial !> The following function calculates the factorial value of an integer !! @param n is the input integer !! @return R is the factorial value of n - recursive function factorial(n) result(R) + pure elemental function factorial(n) result(R) integer, intent(in) :: n integer, parameter :: int64_kind = selected_int_kind(18) ! 18 bytes for 64-bit integer integer(kind=int64_kind) :: R - if (n == 0) then - R = 1 - else - R = n*factorial(n - 1) - end if + integer :: i + + R = product((/(i, i=n, 1, -1)/)) end function factorial diff --git a/src/common/m_helper_basic.f90 b/src/common/m_helper_basic.f90 index ae3221a318..4205279cd4 100644 --- a/src/common/m_helper_basic.f90 +++ b/src/common/m_helper_basic.f90 @@ -22,7 +22,7 @@ module m_helper_basic !! @param b Second number. !! @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) + logical pure elemental 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 @@ -45,7 +45,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) + logical pure elemental function f_is_default(var) result(res) !$acc routine seq real(wp), intent(in) :: var @@ -54,29 +54,31 @@ end function f_is_default !> 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) + logical pure function f_all_default(var_array) result(res) real(wp), intent(in) :: var_array(:) - logical :: res_array(size(var_array)) - integer :: i + ! logical :: res_array(size(var_array)) + ! integer :: i - do i = 1, size(var_array) - res_array(i) = f_is_default(var_array(i)) - end do + res = all(f_is_default(var_array)) - res = all(res_array) + ! do i = 1, size(var_array) + ! res_array(i) = f_is_default(var_array(i)) + ! end do + + ! res = all(res_array) end function f_all_default !> Checks if a real(wp) variable is an integer. !! @param var Variable to check. - logical function f_is_integer(var) result(res) + logical pure elemental function f_is_integer(var) result(res) !$acc routine seq real(wp), intent(in) :: var res = f_approx_equal(var, real(nint(var), wp)) end function f_is_integer - subroutine s_configure_coordinate_bounds(weno_polyn, buff_size, idwint, idwbuff, & - viscous, bubbles_lagrange, m, n, p, num_dims) + pure subroutine s_configure_coordinate_bounds(weno_polyn, buff_size, idwint, idwbuff, & + viscous, bubbles_lagrange, m, n, p, num_dims) integer, intent(in) :: weno_polyn, m, n, p, num_dims integer, intent(inout) :: buff_size diff --git a/src/common/m_mpi_common.fpp b/src/common/m_mpi_common.fpp index 8450f94710..4c84b6ff8c 100644 --- a/src/common/m_mpi_common.fpp +++ b/src/common/m_mpi_common.fpp @@ -48,7 +48,7 @@ contains !> The computation of parameters, the allocation of memory, !! the association of pointers and/or the execution of any !! other procedures that are necessary to setup the module. - subroutine s_initialize_mpi_common_module + impure subroutine s_initialize_mpi_common_module #ifdef MFC_MPI ! Allocating buff_send/recv and ib_buff_send/recv. Please note that @@ -98,7 +98,7 @@ contains !> The subroutine initializes the MPI execution environment !! and queries both the number of processors which will be !! available for the job and the local processor rank. - subroutine s_mpi_initialize + impure subroutine s_mpi_initialize #ifndef MFC_MPI @@ -133,7 +133,7 @@ contains !! @param levelset closest distance from every cell to the IB !! @param levelset_norm normalized vector from every cell to the closest point to the IB !! @param beta Eulerian void fraction from lagrangian bubbles - subroutine s_initialize_mpi_data(q_cons_vf, ib_markers, levelset, levelset_norm, beta) + impure subroutine s_initialize_mpi_data(q_cons_vf, ib_markers, levelset, levelset_norm, beta) type(scalar_field), & dimension(sys_size), & @@ -302,7 +302,7 @@ contains end subroutine s_initialize_mpi_data - subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root) + impure subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root) integer, intent(in) :: counts ! Array of vector lengths for each process real(wp), intent(in), dimension(counts) :: my_vector ! Input vector on each process @@ -333,7 +333,7 @@ contains #endif end subroutine s_mpi_gather_data - subroutine mpi_bcast_time_step_values(proc_time, time_avg) + impure subroutine mpi_bcast_time_step_values(proc_time, time_avg) real(wp), dimension(0:num_procs - 1), intent(inout) :: proc_time real(wp), intent(inout) :: time_avg @@ -346,7 +346,7 @@ contains end subroutine mpi_bcast_time_step_values - subroutine s_prohibit_abort(condition, message) + impure subroutine s_prohibit_abort(condition, message) character(len=*), intent(in) :: condition, message print *, "" @@ -373,14 +373,14 @@ contains !! @param icfl_max_glb Global maximum ICFL stability criterion !! @param vcfl_max_glb Global maximum VCFL stability criterion !! @param Rc_min_glb Global minimum Rc stability criterion - subroutine s_mpi_reduce_stability_criteria_extrema(icfl_max_loc, & - vcfl_max_loc, & - ccfl_max_loc, & - Rc_min_loc, & - icfl_max_glb, & - vcfl_max_glb, & - ccfl_max_glb, & - Rc_min_glb) + impure subroutine s_mpi_reduce_stability_criteria_extrema(icfl_max_loc, & + vcfl_max_loc, & + ccfl_max_loc, & + Rc_min_loc, & + icfl_max_glb, & + vcfl_max_glb, & + ccfl_max_glb, & + Rc_min_glb) real(wp), intent(in) :: icfl_max_loc real(wp), intent(in) :: vcfl_max_loc @@ -431,7 +431,7 @@ contains !! @param var_loc Some variable containing the local value which should be !! reduced amongst all the processors in the communicator. !! @param var_glb The globally reduced value - subroutine s_mpi_allreduce_sum(var_loc, var_glb) + impure subroutine s_mpi_allreduce_sum(var_loc, var_glb) real(wp), intent(in) :: var_loc real(wp), intent(out) :: var_glb @@ -453,7 +453,7 @@ contains !! @param var_loc Some variable containing the local value which should be !! reduced amongst all the processors in the communicator. !! @param var_glb The globally reduced value - subroutine s_mpi_allreduce_min(var_loc, var_glb) + impure subroutine s_mpi_allreduce_min(var_loc, var_glb) real(wp), intent(in) :: var_loc real(wp), intent(out) :: var_glb @@ -475,7 +475,7 @@ contains !! @param var_loc Some variable containing the local value which should be !! reduced amongst all the processors in the communicator. !! @param var_glb The globally reduced value - subroutine s_mpi_allreduce_max(var_loc, var_glb) + impure subroutine s_mpi_allreduce_max(var_loc, var_glb) real(wp), intent(in) :: var_loc real(wp), intent(out) :: var_glb @@ -496,7 +496,7 @@ contains !! @param var_loc holds the local value to be reduced among !! all the processors in communicator. On output, the variable holds !! the minimum value, reduced amongst all of the local values. - subroutine s_mpi_reduce_min(var_loc) + impure subroutine s_mpi_reduce_min(var_loc) real(wp), intent(inout) :: var_loc @@ -531,7 +531,7 @@ contains !! On output, this variable holds the maximum value, reduced amongst !! all of the local values, and the process rank to which the value !! belongs. - subroutine s_mpi_reduce_maxloc(var_loc) + impure subroutine s_mpi_reduce_maxloc(var_loc) real(wp), dimension(2), intent(inout) :: var_loc @@ -557,7 +557,7 @@ contains !> The subroutine terminates the MPI execution environment. !! @param prnt error message to be printed - subroutine s_mpi_abort(prnt, code) + impure subroutine s_mpi_abort(prnt, code) character(len=*), intent(in), optional :: prnt integer, intent(in), optional :: code @@ -586,7 +586,7 @@ contains end subroutine s_mpi_abort !>Halts all processes until all have reached barrier. - subroutine s_mpi_barrier + impure subroutine s_mpi_barrier #ifdef MFC_MPI @@ -598,7 +598,7 @@ contains end subroutine s_mpi_barrier !> The subroutine finalizes the MPI execution environment. - subroutine s_mpi_finalize + impure subroutine s_mpi_finalize #ifdef MFC_MPI @@ -1295,7 +1295,7 @@ contains end subroutine s_mpi_sendrecv_capilary_variables_buffers !> Module deallocation and/or disassociation procedures - subroutine s_finalize_mpi_common_module + impure subroutine s_finalize_mpi_common_module #ifdef MFC_MPI deallocate (buff_send, buff_recv) diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index 6fbd24ec2d..52565515f1 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -47,7 +47,7 @@ contains !> This subroutine should dispatch to the correct relaxation solver based !! some parameter. It replaces the procedure pointer, which CCE !! is breaking on. - subroutine s_relaxation_solver(q_cons_vf) + impure subroutine s_relaxation_solver(q_cons_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf ! This is empty because in current master the procedure pointer ! was never assigned @@ -58,7 +58,7 @@ contains !! by setting the parameters needed for phase change and !! selecting the phase change module that will be used !! (pT- or pTg-equilibrium) - subroutine s_initialize_phasechange_module + impure 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.0_wp)*cvs(vp)) @@ -78,7 +78,7 @@ contains !! model, also considering mass depletion, depending on the incoming !! state conditions. !! @param q_cons_vf Cell-average conservative variables - subroutine s_infinite_relaxation_k(q_cons_vf) + pure subroutine s_infinite_relaxation_k(q_cons_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf real(wp) :: pS, pSOV, pSSL !< equilibrium pressure for mixture, overheated vapor, and subcooled liquid @@ -281,7 +281,7 @@ contains !! @param q_cons_vf Cell-average conservative variables !! @param rhoe mixture energy !! @param TS equilibrium temperature at the interface - subroutine s_infinite_pt_relaxation_k(j, k, l, MFL, pS, p_infpT, rM, q_cons_vf, rhoe, TS) + pure subroutine s_infinite_pt_relaxation_k(j, k, l, MFL, pS, p_infpT, rM, q_cons_vf, rhoe, TS) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_infinite_pt_relaxation_k @@ -386,7 +386,7 @@ contains !! @param rhoe mixture energy !! @param q_cons_vf Cell-average conservative variables !! @param TS equilibrium temperature at the interface - subroutine s_infinite_ptg_relaxation_k(j, k, l, pS, p_infpT, rhoe, q_cons_vf, TS) + pure subroutine s_infinite_ptg_relaxation_k(j, k, l, pS, p_infpT, rhoe, q_cons_vf, TS) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_infinite_ptg_relaxation_k @@ -511,7 +511,7 @@ contains !! @param j generic loop iterator for x direction !! @param k generic loop iterator for y direction !! @param l generic loop iterator for z direction - subroutine s_correct_partial_densities(MCT, q_cons_vf, rM, j, k, l) + pure subroutine s_correct_partial_densities(MCT, q_cons_vf, rM, j, k, l) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_correct_partial_densities @@ -574,7 +574,7 @@ contains !! @param pS equilibrium pressure at the interface !! @param q_cons_vf Cell-average conservative variables !! @param TJac Transpose of the Jacobian Matrix - subroutine s_compute_jacobian_matrix(InvJac, j, Jac, k, l, mCPD, mCVGP, mCVGP2, pS, q_cons_vf, TJac) + pure subroutine s_compute_jacobian_matrix(InvJac, j, Jac, k, l, mCPD, mCVGP, mCVGP2, pS, q_cons_vf, TJac) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_compute_jacobian_matrix @@ -681,7 +681,7 @@ contains !! @param pS equilibrium pressure at the interface !! @param rhoe mixture energy !! @param R2D (2D) residue array - subroutine s_compute_pTg_residue(j, k, l, mCPD, mCVGP, mQD, q_cons_vf, pS, rhoe, R2D) + pure subroutine s_compute_pTg_residue(j, k, l, mCPD, mCVGP, mQD, q_cons_vf, pS, rhoe, R2D) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_compute_pTg_residue @@ -732,7 +732,7 @@ contains !! @param pSat Saturation Pressure !! @param TSat Saturation Temperature !! @param TSIn equilibrium Temperature - subroutine s_TSat(pSat, TSat, TSIn) + pure elemental subroutine s_TSat(pSat, TSat, TSIn) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_TSat @@ -793,7 +793,7 @@ contains end subroutine s_TSat !> This subroutine finalizes the phase change module - subroutine s_finalize_relaxation_solver_module + impure subroutine s_finalize_relaxation_solver_module end subroutine s_finalize_relaxation_solver_module #endif diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 9cac8081f0..288c2fb0f3 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -461,10 +461,10 @@ contains end subroutine s_convert_species_to_mixture_variables - subroutine s_convert_species_to_mixture_variables_acc(rho_K, & - gamma_K, pi_inf_K, qv_K, & - alpha_K, alpha_rho_K, Re_K, k, l, r, & - G_K, G) + pure subroutine s_convert_species_to_mixture_variables_acc(rho_K, & + gamma_K, pi_inf_K, qv_K, & + alpha_K, alpha_rho_K, Re_K, k, l, r, & + G_K, G) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_convert_species_to_mixture_variables_acc #else @@ -545,9 +545,9 @@ contains end subroutine s_convert_species_to_mixture_variables_acc - subroutine s_convert_species_to_mixture_variables_bubbles_acc(rho_K, & - gamma_K, pi_inf_K, qv_K, & - alpha_K, alpha_rho_K, Re_K, k, l, r) + pure subroutine s_convert_species_to_mixture_variables_bubbles_acc(rho_K, & + gamma_K, pi_inf_K, qv_K, & + alpha_K, alpha_rho_K, Re_K, k, l, r) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_convert_species_to_mixture_variables_bubbles_acc #else @@ -616,7 +616,7 @@ contains !> The computation of parameters, the allocation of memory, !! the association of pointers and/or the execution of any !! other procedures that are necessary to setup the module. - subroutine s_initialize_variables_conversion_module + impure subroutine s_initialize_variables_conversion_module integer :: i, j @@ -743,7 +743,7 @@ contains end subroutine s_initialize_variables_conversion_module !Initialize mv at the quadrature nodes based on the initialized moments and sigma - subroutine s_initialize_mv(qK_cons_vf, mv) + pure subroutine s_initialize_mv(qK_cons_vf, mv) type(scalar_field), dimension(sys_size), intent(in) :: qK_cons_vf @@ -776,7 +776,7 @@ contains end subroutine s_initialize_mv !Initialize pb at the quadrature nodes using isothermal relations (Preston model) - subroutine s_initialize_pb(qK_cons_vf, mv, pb) + pure subroutine s_initialize_pb(qK_cons_vf, mv, pb) type(scalar_field), dimension(sys_size), intent(in) :: qK_cons_vf real(wp), dimension(idwint(1)%beg:, idwint(2)%beg:, idwint(3)%beg:, 1:, 1:), intent(in) :: mv @@ -1167,8 +1167,8 @@ contains !! @param ix Index bounds in the first coordinate direction !! @param iy Index bounds in the second coordinate direction !! @param iz Index bounds in the third coordinate direction - subroutine s_convert_primitive_to_conservative_variables(q_prim_vf, & - q_cons_vf) + impure subroutine s_convert_primitive_to_conservative_variables(q_prim_vf, & + q_cons_vf) type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf @@ -1589,7 +1589,7 @@ contains #endif end subroutine s_convert_primitive_to_flux_variables - subroutine s_finalize_variables_conversion_module() + impure subroutine s_finalize_variables_conversion_module() ! Deallocating the density, the specific heat ratio function and the ! liquid stiffness function @@ -1682,7 +1682,7 @@ contains #endif #ifndef MFC_PRE_PROCESS - subroutine s_compute_fast_magnetosonic_speed(rho, c, B, norm, c_fast, h) + pure subroutine s_compute_fast_magnetosonic_speed(rho, c, B, norm, c_fast, h) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_compute_fast_magnetosonic_speed #else diff --git a/src/post_process/m_checker.fpp b/src/post_process/m_checker.fpp index cfe8d8ad27..0bc9ec70d6 100644 --- a/src/post_process/m_checker.fpp +++ b/src/post_process/m_checker.fpp @@ -23,7 +23,7 @@ contains !> Checks compatibility of parameters in the input file. !! Used by the post_process stage - subroutine s_check_inputs + impure subroutine s_check_inputs call s_check_inputs_output_format call s_check_inputs_partial_domain @@ -39,13 +39,13 @@ contains end subroutine s_check_inputs !> Checks constraints on output format parameters - subroutine s_check_inputs_output_format + impure subroutine s_check_inputs_output_format @:PROHIBIT(format /= 1 .and. format /= 2) @:PROHIBIT(precision /= 1 .and. precision /= 2) end subroutine s_check_inputs_output_format !> Checks constraints on partial domain parameters - subroutine s_check_inputs_partial_domain + impure subroutine s_check_inputs_partial_domain @:PROHIBIT(output_partial_domain .and. format == 1) @:PROHIBIT(output_partial_domain .and. precision == 1) @:PROHIBIT(output_partial_domain .and. any([flux_wrt, heat_ratio_wrt, pres_inf_wrt, c_wrt, schlieren_wrt, qm_wrt, ib, any(omega_wrt)])) @@ -60,7 +60,7 @@ contains end subroutine s_check_inputs_partial_domain !> Checks constraints on partial density parameters - subroutine s_check_inputs_partial_density + impure subroutine s_check_inputs_partial_density character(len=5) :: iStr integer :: i @@ -72,26 +72,26 @@ contains end subroutine s_check_inputs_partial_density !> Checks constraints on momentum parameters - subroutine s_check_inputs_momentum + impure subroutine s_check_inputs_momentum @:PROHIBIT(n == 0 .and. mom_wrt(2)) @:PROHIBIT(p == 0 .and. mom_wrt(3)) end subroutine s_check_inputs_momentum !> Checks constraints on velocity parameters - subroutine s_check_inputs_velocity + impure subroutine s_check_inputs_velocity @:PROHIBIT(n == 0 .and. vel_wrt(2)) @:PROHIBIT(p == 0 .and. vel_wrt(3)) end subroutine s_check_inputs_velocity !> Checks constraints on flux limiter parameters - subroutine s_check_inputs_flux_limiter + impure subroutine s_check_inputs_flux_limiter @:PROHIBIT(n == 0 .and. flux_wrt(2)) @:PROHIBIT(p == 0 .and. flux_wrt(3)) @:PROHIBIT(all(flux_lim /= (/dflt_int, 1, 2, 3, 4, 5, 6, 7/)), "flux_lim must be between 1 and 7") end subroutine s_check_inputs_flux_limiter !> Checks constraints on volume fraction parameters - subroutine s_check_inputs_volume_fraction + impure subroutine s_check_inputs_volume_fraction character(len=5) :: iStr integer :: i @@ -103,7 +103,7 @@ contains end subroutine s_check_inputs_volume_fraction !> Checks constraints on vorticity parameters - subroutine s_check_inputs_vorticity + impure subroutine s_check_inputs_vorticity @:PROHIBIT(n == 0 .and. any(omega_wrt)) @:PROHIBIT(p == 0 .and. (omega_wrt(1) .or. omega_wrt(2))) @:PROHIBIT(any(omega_wrt) .and. fd_order == dflt_int, "fd_order must be set for omega_wrt") @@ -111,7 +111,7 @@ contains !> Checks constraints on numerical Schlieren parameters !! (schlieren_wrt and schlieren_alpha) - subroutine s_check_inputs_schlieren + impure subroutine s_check_inputs_schlieren character(len=5) :: iStr integer :: i @@ -130,13 +130,13 @@ contains end subroutine s_check_inputs_schlieren !> Checks constraints on surface tension parameters (cf_wrt and sigma) - subroutine s_check_inputs_surface_tension + impure subroutine s_check_inputs_surface_tension @:PROHIBIT(cf_wrt .and. .not. surface_tension, & "cf_wrt can only be enabled if the surface coefficient is set") end subroutine s_check_inputs_surface_tension !> Checks constraints on the absence of flow variables - subroutine s_check_inputs_no_flow_variables + impure subroutine s_check_inputs_no_flow_variables @:PROHIBIT(.not. any([ & (/rho_wrt, E_wrt, pres_wrt, gamma_wrt, heat_ratio_wrt, pi_inf_wrt, & pres_inf_wrt, cons_vars_wrt, prim_vars_wrt, c_wrt, schlieren_wrt/), & diff --git a/src/post_process/m_data_input.f90 b/src/post_process/m_data_input.f90 index 473ba80fc1..45a2baa728 100644 --- a/src/post_process/m_data_input.f90 +++ b/src/post_process/m_data_input.f90 @@ -35,7 +35,7 @@ module m_data_input !> Subroutine for reading data files !! @param t_step Current time-step to input - subroutine s_read_abstract_data_files(t_step) + impure subroutine s_read_abstract_data_files(t_step) implicit none @@ -69,7 +69,7 @@ end subroutine s_read_abstract_data_files !! present in the corresponding time-step directory and to !! populate the associated grid and conservative variables. !! @param t_step Current time-step - subroutine s_read_serial_data_files(t_step) + impure subroutine s_read_serial_data_files(t_step) integer, intent(in) :: t_step @@ -268,7 +268,7 @@ end subroutine s_read_serial_data_files !! present in the corresponding time-step directory and to !! populate the associated grid and conservative variables. !! @param t_step Current time-step - subroutine s_read_parallel_data_files(t_step) + impure subroutine s_read_parallel_data_files(t_step) integer, intent(in) :: t_step @@ -556,7 +556,7 @@ end subroutine s_read_parallel_data_files !! are used in aiding the multidimensional visualization of !! Silo database files, in VisIt, when processor boundary !! conditions are present. - subroutine s_populate_grid_variables_buffer_regions + impure subroutine s_populate_grid_variables_buffer_regions integer :: i !< Generic loop iterator @@ -801,7 +801,7 @@ end subroutine s_populate_grid_variables_buffer_regions !> The purpose of this procedure is to populate the buffers !! of the cell-average conservative variables, depending on !! the boundary conditions. - subroutine s_populate_conservative_variables_buffer_regions(q_particle) + impure subroutine s_populate_conservative_variables_buffer_regions(q_particle) type(scalar_field), intent(inout), optional :: q_particle @@ -1304,7 +1304,7 @@ end subroutine s_populate_conservative_variables_buffer_regions !> Computation of parameters, allocation procedures, and/or !! any other tasks needed to properly setup the module - subroutine s_initialize_data_input_module + impure subroutine s_initialize_data_input_module integer :: i !< Generic loop iterator @@ -1418,7 +1418,7 @@ subroutine s_initialize_data_input_module end subroutine s_initialize_data_input_module !> Deallocation procedures for the module - subroutine s_finalize_data_input_module + impure subroutine s_finalize_data_input_module integer :: i !< Generic loop iterator diff --git a/src/post_process/m_data_output.fpp b/src/post_process/m_data_output.fpp index 4426f58074..382f8387ae 100644 --- a/src/post_process/m_data_output.fpp +++ b/src/post_process/m_data_output.fpp @@ -109,7 +109,7 @@ module m_data_output contains - subroutine s_initialize_data_output_module() + impure subroutine s_initialize_data_output_module() ! Description: Computation of parameters, allocation procedures, and/or ! any other tasks needed to properly setup the module @@ -423,7 +423,7 @@ contains end subroutine s_initialize_data_output_module - subroutine s_define_output_region + impure subroutine s_define_output_region integer :: i integer :: lower_bound, upper_bound @@ -459,7 +459,7 @@ contains end subroutine s_define_output_region - subroutine s_open_formatted_database_file(t_step) + impure 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 @@ -585,7 +585,7 @@ contains end subroutine s_open_formatted_database_file - subroutine s_open_intf_data_file() + impure subroutine s_open_intf_data_file() character(LEN=path_len + 3*name_len) :: file_path !< !! Relative path to a file in the case directory @@ -601,7 +601,7 @@ contains end subroutine s_open_intf_data_file - subroutine s_open_energy_data_file() + impure subroutine s_open_energy_data_file() character(LEN=path_len + 3*name_len) :: file_path !< !! Relative path to a file in the case directory @@ -617,7 +617,7 @@ contains end subroutine s_open_energy_data_file - subroutine s_write_grid_to_formatted_database_file(t_step) + impure 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 @@ -826,7 +826,7 @@ contains end subroutine s_write_grid_to_formatted_database_file - subroutine s_write_variable_to_formatted_database_file(varname, t_step) + impure subroutine s_write_variable_to_formatted_database_file(varname, t_step) ! Description: The goal of this subroutine is to write to the formatted ! database file the flow variable at the current time-step, ! t_step. The local process(es) write the part of the flow @@ -1088,7 +1088,7 @@ contains !> Subroutine that writes the post processed results in the folder 'lag_bubbles_data' !! @param t_step Current time step - subroutine s_write_lag_bubbles_results(t_step) + impure subroutine s_write_lag_bubbles_results(t_step) integer, intent(in) :: t_step @@ -1191,7 +1191,7 @@ contains #endif end subroutine s_write_lag_bubbles_results - subroutine s_write_intf_data_file(q_prim_vf) + impure subroutine s_write_intf_data_file(q_prim_vf) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf integer :: i, j, k, l, cent !< Generic loop iterators @@ -1282,7 +1282,7 @@ contains end subroutine s_write_intf_data_file - subroutine s_write_energy_data_file(q_prim_vf, q_cons_vf) + impure subroutine s_write_energy_data_file(q_prim_vf, q_cons_vf) type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf, q_cons_vf real(wp) :: Elk, Egk, Elp, Egint, Vb, Vl, pres_av, Et real(wp) :: rho, pres, dV, tmp, gamma, pi_inf, MaxMa, MaxMa_glb, maxvel, c, Ma, H @@ -1380,7 +1380,7 @@ contains end subroutine s_write_energy_data_file - subroutine s_close_formatted_database_file() + impure 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 @@ -1407,19 +1407,19 @@ contains end subroutine s_close_formatted_database_file - subroutine s_close_intf_data_file() + impure subroutine s_close_intf_data_file() close (211) end subroutine s_close_intf_data_file - subroutine s_close_energy_data_file() + impure subroutine s_close_energy_data_file() close (251) end subroutine s_close_energy_data_file - subroutine s_finalize_data_output_module() + impure subroutine s_finalize_data_output_module() ! Description: Deallocation procedures for the module ! Deallocating the generic storage employed for the flow variable(s) diff --git a/src/post_process/m_derived_variables.fpp b/src/post_process/m_derived_variables.fpp index 65f78dfdac..0deffe61ba 100644 --- a/src/post_process/m_derived_variables.fpp +++ b/src/post_process/m_derived_variables.fpp @@ -59,7 +59,7 @@ contains !> Computation of parameters, allocation procedures, and/or !! any other tasks needed to properly setup the module - subroutine s_initialize_derived_variables_module + impure subroutine s_initialize_derived_variables_module ! Allocating the gradient magnitude of the density variable provided ! that numerical Schlieren function is outputted during post-process @@ -115,7 +115,7 @@ contains !! ratio. The latter is stored in the derived flow quantity !! storage variable, q_sf. !! @param q_sf Specific heat ratio - subroutine s_derive_specific_heat_ratio(q_sf) + pure subroutine s_derive_specific_heat_ratio(q_sf) real(wp), & dimension(-offset_x%beg:m + offset_x%end, & @@ -142,7 +142,7 @@ contains !! values of the liquid stiffness, which are stored in the !! derived flow quantity storage variable, q_sf. !! @param q_sf Liquid stiffness - subroutine s_derive_liquid_stiffness(q_sf) + pure subroutine s_derive_liquid_stiffness(q_sf) real(wp), & dimension(-offset_x%beg:m + offset_x%end, & @@ -171,7 +171,7 @@ contains !! derived flow quantity storage variable, q_sf. !! @param q_prim_vf Primitive variables !! @param q_sf Speed of sound - subroutine s_derive_sound_speed(q_prim_vf, q_sf) + pure subroutine s_derive_sound_speed(q_prim_vf, q_sf) type(scalar_field), & dimension(sys_size), & @@ -228,7 +228,7 @@ contains !! @param i Component indicator !! @param q_prim_vf Primitive variables !! @param q_sf Flux limiter - subroutine s_derive_flux_limiter(i, q_prim_vf, q_sf) + pure subroutine s_derive_flux_limiter(i, q_prim_vf, q_sf) integer, intent(in) :: i @@ -322,7 +322,7 @@ contains !! @param b right-hane-side !! @param sol Solution !! @param ndim Problem size - subroutine s_solve_linear_system(A, b, sol, ndim) + pure subroutine s_solve_linear_system(A, b, sol, ndim) integer, intent(in) :: ndim real(wp), dimension(ndim, ndim), intent(inout) :: A @@ -372,7 +372,7 @@ contains !! @param i Vorticity component indicator !! @param q_prim_vf Primitive variables !! @param q_sf Vorticity component - subroutine s_derive_vorticity_component(i, q_prim_vf, q_sf) + pure subroutine s_derive_vorticity_component(i, q_prim_vf, q_sf) integer, intent(in) :: i @@ -474,7 +474,7 @@ contains !! quantity storage variable, q_sf. !! @param q_prim_vf Primitive variables !! @param q_sf Q_M - subroutine s_derive_qm(q_prim_vf, q_sf) + pure subroutine s_derive_qm(q_prim_vf, q_sf) type(scalar_field), & dimension(sys_size), & intent(in) :: q_prim_vf @@ -561,7 +561,7 @@ contains !! variable, q_sf. !! @param q_cons_vf Conservative variables !! @param q_sf Numerical Schlieren function - subroutine s_derive_numerical_schlieren_function(q_cons_vf, q_sf) + impure subroutine s_derive_numerical_schlieren_function(q_cons_vf, q_sf) type(scalar_field), & dimension(sys_size), & @@ -686,7 +686,7 @@ contains end subroutine s_derive_numerical_schlieren_function !> Deallocation procedures for the module - subroutine s_finalize_derived_variables_module + impure subroutine s_finalize_derived_variables_module ! Deallocating the variable containing the gradient magnitude of the ! density field provided that the numerical Schlieren function was diff --git a/src/post_process/m_global_parameters.fpp b/src/post_process/m_global_parameters.fpp index 6d53f64015..2c93cca230 100644 --- a/src/post_process/m_global_parameters.fpp +++ b/src/post_process/m_global_parameters.fpp @@ -324,7 +324,7 @@ contains !> Assigns default values to user inputs prior to reading !! them in. This allows for an easier consistency check of !! these parameters once they are read from the input file. - subroutine s_assign_default_values_to_user_inputs + impure subroutine s_assign_default_values_to_user_inputs integer :: i !< Generic loop iterator @@ -463,7 +463,7 @@ contains !> Computation of parameters, allocation procedures, and/or !! any other tasks needed to properly setup the module - subroutine s_initialize_global_parameters_module + impure subroutine s_initialize_global_parameters_module integer :: i, j, fac @@ -885,7 +885,7 @@ contains end subroutine s_initialize_global_parameters_module !> Subroutine to initialize parallel infrastructure - subroutine s_initialize_parallel_io + impure subroutine s_initialize_parallel_io num_dims = 1 + min(1, n) + min(1, p) @@ -919,7 +919,7 @@ contains end subroutine s_initialize_parallel_io !> Deallocation procedures for the module - subroutine s_finalize_global_parameters_module + impure subroutine s_finalize_global_parameters_module integer :: i diff --git a/src/post_process/m_mpi_proxy.fpp b/src/post_process/m_mpi_proxy.fpp index 38369361b7..2e693488f1 100644 --- a/src/post_process/m_mpi_proxy.fpp +++ b/src/post_process/m_mpi_proxy.fpp @@ -48,7 +48,7 @@ contains !> Computation of parameters, allocation procedures, and/or !! any other tasks needed to properly setup the module - subroutine s_initialize_mpi_proxy_module + impure subroutine s_initialize_mpi_proxy_module #ifdef MFC_MPI @@ -144,7 +144,7 @@ contains !! these are not available to the remaining processors. This !! subroutine is then in charge of broadcasting the required !! information. - subroutine s_mpi_bcast_user_inputs + impure subroutine s_mpi_bcast_user_inputs #ifdef MFC_MPI integer :: i !< Generic loop iterator @@ -206,7 +206,7 @@ contains !! as well as recomputing some of the global parameters so !! that they reflect the configuration of sub-domain that !! is overseen by the local processor. - subroutine s_mpi_decompose_computational_domain + impure subroutine s_mpi_decompose_computational_domain #ifdef MFC_MPI @@ -646,7 +646,7 @@ contains !! cell-boundary locations is communicated. !! @param pbc_loc Processor boundary condition (PBC) location !! @param sweep_coord Coordinate direction normal to the processor boundary - subroutine s_mpi_sendrecv_grid_vars_buffer_regions(pbc_loc, sweep_coord) + impure subroutine s_mpi_sendrecv_grid_vars_buffer_regions(pbc_loc, sweep_coord) character(LEN=3), intent(in) :: pbc_loc character, intent(in) :: sweep_coord @@ -846,8 +846,8 @@ contains !! @param pbc_loc Processor boundary condition (PBC) location !! @param sweep_coord Coordinate direction normal to the processor boundary !! @param q_particle Projection of the lagrangian particles in the Eulerian framework - subroutine s_mpi_sendrecv_cons_vars_buffer_regions(q_cons_vf, pbc_loc, & - sweep_coord, q_particle) + impure subroutine s_mpi_sendrecv_cons_vars_buffer_regions(q_cons_vf, pbc_loc, & + sweep_coord, q_particle) type(scalar_field), & dimension(sys_size), & @@ -1496,7 +1496,7 @@ contains !! @param spatial_extents Spatial extents for each processor's sub-domain. First dimension !! corresponds to the minimum and maximum values, respectively, while !! the second dimension corresponds to the processor rank. - subroutine s_mpi_gather_spatial_extents(spatial_extents) + impure subroutine s_mpi_gather_spatial_extents(spatial_extents) real(wp), dimension(1:, 0:), intent(INOUT) :: spatial_extents @@ -1615,7 +1615,7 @@ contains !! puts back together the grid of the entire computational !! domain on the rank 0 processor. This is only done for 1D !! simulations. - subroutine s_mpi_defragment_1d_grid_variable + impure subroutine s_mpi_defragment_1d_grid_variable #ifdef MFC_MPI @@ -1651,7 +1651,7 @@ contains !! First dimension of array corresponds to the former's minimum and !! maximum values, respectively, while second dimension corresponds !! to each processor's rank. - subroutine s_mpi_gather_data_extents(q_sf, data_extents) + impure subroutine s_mpi_gather_data_extents(q_sf, data_extents) real(wp), dimension(:, :, :), intent(in) :: q_sf @@ -1681,7 +1681,7 @@ contains !! This is only done for 1D simulations. !! @param q_sf Flow variable defined on a single computational sub-domain !! @param q_root_sf Flow variable defined on the entire computational domain - subroutine s_mpi_defragment_1d_flow_variable(q_sf, q_root_sf) + impure subroutine s_mpi_defragment_1d_flow_variable(q_sf, q_root_sf) real(wp), & dimension(0:m), & @@ -1705,7 +1705,7 @@ contains end subroutine s_mpi_defragment_1d_flow_variable !> Deallocation procedures for the module - subroutine s_finalize_mpi_proxy_module + impure subroutine s_finalize_mpi_proxy_module #ifdef MFC_MPI diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index e9b71b1e26..e7435f6ad6 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -48,7 +48,7 @@ module m_start_up !> Reads the configuration file post_process.inp, in order !! to populate parameters in module m_global_parameters.f90 !! with the user provided inputs - subroutine s_read_input_file + impure subroutine s_read_input_file character(LEN=name_len) :: file_loc !< !! Generic string used to store the address of a particular file @@ -125,7 +125,7 @@ end subroutine s_read_input_file !! individual choices are compatible with the code's options !! and that the combination of these choices results into a !! valid configuration for the post-process - subroutine s_check_input_file + impure subroutine s_check_input_file character(LEN=len_trim(case_dir)) :: file_loc !< !! Generic string used to store the address of a particular file @@ -151,7 +151,7 @@ subroutine s_check_input_file end subroutine s_check_input_file - subroutine s_perform_time_step(t_step) + impure subroutine s_perform_time_step(t_step) integer, intent(inout) :: t_step if (proc_rank == 0) then @@ -189,7 +189,7 @@ subroutine s_perform_time_step(t_step) end subroutine s_perform_time_step - subroutine s_save_data(t_step, varname, pres, c, H) + impure subroutine s_save_data(t_step, varname, pres, c, H) integer, intent(inout) :: t_step character(LEN=name_len), intent(inout) :: varname @@ -671,12 +671,12 @@ subroutine s_save_data(t_step, varname, pres, c, H) end subroutine s_save_data - subroutine s_initialize_modules + impure subroutine s_initialize_modules ! Computation of parameters, allocation procedures, and/or any other tasks ! needed to properly setup the modules call s_initialize_global_parameters_module() if (bubbles_euler .and. nb > 1) then - call s_simpson + call s_simpson(weight, R0) end if if (bubbles_euler .and. .not. polytropic) then call s_initialize_nonpoly() @@ -695,7 +695,7 @@ subroutine s_initialize_modules end if end subroutine s_initialize_modules - subroutine s_initialize_mpi_domain + impure subroutine s_initialize_mpi_domain ! Initialization of the MPI environment call s_mpi_initialize() @@ -720,7 +720,7 @@ subroutine s_initialize_mpi_domain end subroutine s_initialize_mpi_domain - subroutine s_finalize_modules + impure subroutine s_finalize_modules ! Disassociate pointers for serial and parallel I/O s_read_data_files => null() diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp index d79c97d39a..11eb62f9e6 100644 --- a/src/pre_process/m_assign_variables.fpp +++ b/src/pre_process/m_assign_variables.fpp @@ -66,7 +66,7 @@ module m_assign_variables contains - subroutine s_initialize_assign_variables_module + impure subroutine s_initialize_assign_variables_module allocate (alf_sum%sf(0:m, 0:n, 0:p)) @@ -101,8 +101,8 @@ contains !! @param eta pseudo volume fraction !! @param q_prim_vf Primitive variables !! @param patch_id_fp Array to track patch ids - subroutine s_assign_patch_mixture_primitive_variables(patch_id, j, k, l, & - eta, q_prim_vf, patch_id_fp) + pure subroutine s_assign_patch_mixture_primitive_variables(patch_id, j, k, l, & + eta, q_prim_vf, patch_id_fp) !$acc routine seq integer, intent(in) :: patch_id @@ -190,7 +190,7 @@ contains !! @param k the y-dir node index !! @param l the z-dir node index !! @param q_prim_vf Primitive variables - subroutine s_perturb_primitive(j, k, l, q_prim_vf) + pure subroutine s_perturb_primitive(j, k, l, q_prim_vf) integer, intent(in) :: j, k, l type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf @@ -274,8 +274,8 @@ contains !! @param eta pseudo volume fraction !! @param q_prim_vf Primitive variables !! @param patch_id_fp Array to track patch ids - subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & - eta, q_prim_vf, patch_id_fp) + impure subroutine s_assign_patch_species_primitive_variables(patch_id, j, k, l, & + eta, q_prim_vf, patch_id_fp) !$acc routine seq integer, intent(in) :: patch_id @@ -691,7 +691,7 @@ contains end subroutine s_assign_patch_species_primitive_variables - subroutine s_finalize_assign_variables_module + impure subroutine s_finalize_assign_variables_module ! Nullifying procedure pointer to the subroutine assigning either ! the patch mixture or species primitive variables to a cell in the diff --git a/src/pre_process/m_boundary_conditions.fpp b/src/pre_process/m_boundary_conditions.fpp index 8c8b185c69..1e8f160b38 100644 --- a/src/pre_process/m_boundary_conditions.fpp +++ b/src/pre_process/m_boundary_conditions.fpp @@ -29,7 +29,7 @@ module m_boundary_conditions s_write_parallel_boundary_condition_files contains - subroutine s_line_segment_bc(patch_id, q_prim_vf, bc_type) + impure subroutine s_line_segment_bc(patch_id, q_prim_vf, bc_type) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(integer_field), dimension(1:num_dims, -1:1), intent(inout) :: bc_type @@ -79,7 +79,7 @@ contains end subroutine s_line_segment_bc - subroutine s_circle_bc(patch_id, q_prim_vf, bc_type) + impure subroutine s_circle_bc(patch_id, q_prim_vf, bc_type) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(integer_field), dimension(1:num_dims, -1:1), intent(inout) :: bc_type @@ -143,7 +143,7 @@ contains end subroutine s_circle_bc - subroutine s_rectangle_bc(patch_id, q_prim_vf, bc_type) + impure subroutine s_rectangle_bc(patch_id, q_prim_vf, bc_type) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(integer_field), dimension(1:num_dims, -1:1), intent(inout) :: bc_type @@ -233,7 +233,7 @@ contains end subroutine s_rectangle_bc - subroutine s_apply_boundary_patches(q_prim_vf, bc_type) + impure subroutine s_apply_boundary_patches(q_prim_vf, bc_type) type(scalar_field), dimension(sys_size) :: q_prim_vf type(integer_field), dimension(1:num_dims, -1:1) :: bc_type @@ -267,7 +267,7 @@ contains end subroutine s_apply_boundary_patches - subroutine s_write_serial_boundary_condition_files(q_prim_vf, bc_type, step_dirpath) + impure subroutine s_write_serial_boundary_condition_files(q_prim_vf, bc_type, step_dirpath) type(scalar_field), dimension(sys_size) :: q_prim_vf type(integer_field), dimension(1:num_dims, -1:1) :: bc_type @@ -307,7 +307,7 @@ contains end subroutine s_write_serial_boundary_condition_files - subroutine s_write_parallel_boundary_condition_files(q_prim_vf, bc_type) + impure subroutine s_write_parallel_boundary_condition_files(q_prim_vf, bc_type) type(scalar_field), dimension(sys_size) :: q_prim_vf type(integer_field), dimension(1:num_dims, -1:1) :: bc_type @@ -367,9 +367,9 @@ contains end subroutine s_write_parallel_boundary_condition_files - subroutine s_pack_boundary_condition_buffers(q_prim_vf) + impure subroutine s_pack_boundary_condition_buffers(q_prim_vf) - type(scalar_field), dimension(sys_size) :: q_prim_vf + type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf integer :: i, j, k do k = 0, p diff --git a/src/pre_process/m_check_ib_patches.fpp b/src/pre_process/m_check_ib_patches.fpp index 40debc4d62..9943ee2b59 100644 --- a/src/pre_process/m_check_ib_patches.fpp +++ b/src/pre_process/m_check_ib_patches.fpp @@ -33,7 +33,7 @@ module m_check_ib_patches contains - subroutine s_check_ib_patches + impure subroutine s_check_ib_patches integer :: i @@ -85,7 +85,7 @@ contains !! the circle patch have consistently been inputted by the !! user. !! @param patch_id Patch identifier - subroutine s_check_circle_ib_patch_geometry(patch_id) + impure subroutine s_check_circle_ib_patch_geometry(patch_id) integer, intent(in) :: patch_id @@ -103,7 +103,7 @@ contains !! the airfoil patch have consistently been inputted by the !! user. !! @param patch_id Patch identifier - subroutine s_check_airfoil_ib_patch_geometry(patch_id) + impure subroutine s_check_airfoil_ib_patch_geometry(patch_id) integer, intent(in) :: patch_id @@ -124,7 +124,7 @@ contains !! the 3d airfoil patch have consistently been inputted by the !! user. !! @param patch_id Patch identifier - subroutine s_check_3d_airfoil_ib_patch_geometry(patch_id) + impure subroutine s_check_3d_airfoil_ib_patch_geometry(patch_id) integer, intent(in) :: patch_id @@ -147,7 +147,7 @@ contains !! the rectangle patch have consistently been inputted by !! the user. !! @param patch_id Patch identifier - subroutine s_check_rectangle_ib_patch_geometry(patch_id) + impure subroutine s_check_rectangle_ib_patch_geometry(patch_id) integer, intent(in) :: patch_id @@ -170,7 +170,7 @@ contains !! the sphere patch have consistently been inputted by !! the user. !! @param patch_id Patch identifier - subroutine s_check_sphere_ib_patch_geometry(patch_id) + impure subroutine s_check_sphere_ib_patch_geometry(patch_id) integer, intent(in) :: patch_id @@ -193,7 +193,7 @@ contains !! the cuboid patch have consistently been inputted by !! the user. !! @param patch_id Patch identifier - subroutine s_check_cuboid_ib_patch_geometry(patch_id) + impure subroutine s_check_cuboid_ib_patch_geometry(patch_id) integer, intent(in) :: patch_id @@ -220,7 +220,7 @@ contains !! the cylinder patch have consistently been inputted by !! the user. !! @param patch_id Patch identifier - subroutine s_check_cylinder_ib_patch_geometry(patch_id) + impure subroutine s_check_cylinder_ib_patch_geometry(patch_id) integer, intent(in) :: patch_id @@ -261,7 +261,7 @@ contains !! the model patch have consistently been inputted by !! the user. !! @param patch_id Patch identifier - subroutine s_check_model_ib_patch_geometry(patch_id) + impure subroutine s_check_model_ib_patch_geometry(patch_id) integer, intent(in) :: patch_id @@ -282,7 +282,7 @@ contains !!> This subroutine verifies that the geometric parameters of !! the inactive patch remain unaltered by the user inputs. !! @param patch_id Patch identifier - subroutine s_check_inactive_ib_patch_geometry(patch_id) + impure subroutine s_check_inactive_ib_patch_geometry(patch_id) integer, intent(in) :: patch_id diff --git a/src/pre_process/m_check_patches.fpp b/src/pre_process/m_check_patches.fpp index 29846fd665..d1a8aade96 100644 --- a/src/pre_process/m_check_patches.fpp +++ b/src/pre_process/m_check_patches.fpp @@ -35,7 +35,7 @@ module m_check_patches contains - subroutine s_check_patches + impure subroutine s_check_patches integer :: i character(len=10) :: num_patches_str @@ -149,7 +149,7 @@ contains !> This subroutine checks the line segment patch input !! @param patch_id Patch identifier - subroutine s_check_line_segment_patch_geometry(patch_id) + impure subroutine s_check_line_segment_patch_geometry(patch_id) integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) @@ -163,7 +163,7 @@ contains !> This subroutine checks the circle patch input !! @param patch_id Patch identifier - subroutine s_check_circle_patch_geometry(patch_id) + impure subroutine s_check_circle_patch_geometry(patch_id) integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) @@ -178,7 +178,7 @@ contains !> This subroutine checks the rectangle patch input !! @param patch_id Patch identifier - subroutine s_check_rectangle_patch_geometry(patch_id) + impure subroutine s_check_rectangle_patch_geometry(patch_id) integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) @@ -194,7 +194,7 @@ contains !> This subroutine checks the line sweep patch input !! @param patch_id Patch identifier - subroutine s_check_line_sweep_patch_geometry(patch_id) + impure subroutine s_check_line_sweep_patch_geometry(patch_id) integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) @@ -211,7 +211,7 @@ contains !> This subroutine checks the ellipse patch input !! @param patch_id Patch identifier - subroutine s_check_ellipse_patch_geometry(patch_id) + impure subroutine s_check_ellipse_patch_geometry(patch_id) integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) @@ -228,7 +228,7 @@ contains !> This subroutine checks the model patch input !! @param patch_id Patch identifier - subroutine s_check_2D_TaylorGreen_vortex_patch_geometry(patch_id) + impure subroutine s_check_2D_TaylorGreen_vortex_patch_geometry(patch_id) integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) @@ -245,7 +245,7 @@ contains !> This subroutine checks the model patch input !! @param patch_id Patch identifier - subroutine s_check_1D_analytical_patch_geometry(patch_id) + impure subroutine s_check_1D_analytical_patch_geometry(patch_id) integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) @@ -260,7 +260,7 @@ contains !> This subroutine checks the model patch input !! @param patch_id Patch identifier - subroutine s_check_2D_analytical_patch_geometry(patch_id) + impure subroutine s_check_2D_analytical_patch_geometry(patch_id) integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) @@ -276,7 +276,7 @@ contains !> This subroutine checks the model patch input !! @param patch_id Patch identifier - subroutine s_check_3D_analytical_patch_geometry(patch_id) + impure subroutine s_check_3D_analytical_patch_geometry(patch_id) integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) @@ -293,7 +293,7 @@ contains !> This subroutine checks the model patch input !! @param patch_id Patch identifier - subroutine s_check_sphere_patch_geometry(patch_id) + impure subroutine s_check_sphere_patch_geometry(patch_id) integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) @@ -308,7 +308,7 @@ contains !> This subroutine checks the model patch input !! @param patch_id Patch identifier - subroutine s_check_spherical_harmonic_patch_geometry(patch_id) + impure subroutine s_check_spherical_harmonic_patch_geometry(patch_id) integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) @@ -329,7 +329,7 @@ contains !> This subroutine checks the model patch input !! @param patch_id Patch identifier - subroutine s_check_cuboid_patch_geometry(patch_id) + impure subroutine s_check_cuboid_patch_geometry(patch_id) ! Patch identifier integer, intent(in) :: patch_id @@ -347,7 +347,7 @@ contains !> This subroutine checks the model patch input !! @param patch_id Patch identifier - subroutine s_check_cylinder_patch_geometry(patch_id) + impure subroutine s_check_cylinder_patch_geometry(patch_id) ! Patch identifier integer, intent(in) :: patch_id @@ -377,7 +377,7 @@ contains !> This subroutine checks the model patch input !! @param patch_id Patch identifier - subroutine s_check_plane_sweep_patch_geometry(patch_id) + impure subroutine s_check_plane_sweep_patch_geometry(patch_id) ! Patch identifier integer, intent(in) :: patch_id @@ -395,7 +395,7 @@ contains !> This subroutine checks the model patch input !! @param patch_id Patch identifier - subroutine s_check_ellipsoid_patch_geometry(patch_id) + impure subroutine s_check_ellipsoid_patch_geometry(patch_id) integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) @@ -413,7 +413,7 @@ contains !!> This subroutine verifies that the geometric parameters of !! the inactive patch remain unaltered by the user inputs. !! @param patch_id Patch identifier - subroutine s_check_inactive_patch_geometry(patch_id) + impure subroutine s_check_inactive_patch_geometry(patch_id) integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) @@ -438,7 +438,7 @@ contains !> This subroutine verifies the active patch's right to overwrite the preceding patches !! @param patch_id Patch identifier - subroutine s_check_active_patch_alteration_rights(patch_id) + impure subroutine s_check_active_patch_alteration_rights(patch_id) integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) @@ -451,7 +451,7 @@ contains !> This subroutine verifies that inactive patches cannot overwrite other patches !! @param patch_id Patch identifier - subroutine s_check_inactive_patch_alteration_rights(patch_id) + impure subroutine s_check_inactive_patch_alteration_rights(patch_id) ! Patch identifier integer, intent(in) :: patch_id @@ -464,7 +464,7 @@ contains !> This subroutine checks the smoothing parameters !! @param patch_id Patch identifier - subroutine s_check_supported_patch_smoothing(patch_id) + impure subroutine s_check_supported_patch_smoothing(patch_id) integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) @@ -487,7 +487,7 @@ contains !> This subroutine verifies that inactive patches cannot be smoothed !! @param patch_id Patch identifier - subroutine s_check_unsupported_patch_smoothing(patch_id) + impure subroutine s_check_unsupported_patch_smoothing(patch_id) ! Patch identifier integer, intent(in) :: patch_id @@ -504,7 +504,7 @@ contains !> This subroutine checks the primitive variables !! @param patch_id Patch identifier - subroutine s_check_active_patch_primitive_variables(patch_id) + impure subroutine s_check_active_patch_primitive_variables(patch_id) integer, intent(in) :: patch_id @@ -565,7 +565,7 @@ contains !! associated with the given inactive patch remain unaltered !! by the user inputs. !! @param patch_id Patch identifier - subroutine s_check_inactive_patch_primitive_variables(patch_id) + impure subroutine s_check_inactive_patch_primitive_variables(patch_id) integer, intent(in) :: patch_id call s_int_to_str(patch_id, iStr) @@ -587,7 +587,7 @@ contains end subroutine s_check_inactive_patch_primitive_variables - subroutine s_check_model_geometry(patch_id) + impure subroutine s_check_model_geometry(patch_id) integer, intent(in) :: patch_id diff --git a/src/pre_process/m_checker.fpp b/src/pre_process/m_checker.fpp index 468eef27d4..46a7c55941 100644 --- a/src/pre_process/m_checker.fpp +++ b/src/pre_process/m_checker.fpp @@ -23,7 +23,7 @@ contains !> Checks compatibility of parameters in the input file. !! Used by the pre_process stage - subroutine s_check_inputs + impure subroutine s_check_inputs call s_check_parallel_io call s_check_inputs_restart @@ -37,7 +37,7 @@ contains end subroutine s_check_inputs !> Checks if mpi is enabled with parallel_io - subroutine s_check_parallel_io + impure subroutine s_check_parallel_io #ifndef MFC_MPI @:PROHIBIT(parallel_io, "MFC built with --no-mpi requires parallel_io=F") #endif @@ -45,7 +45,7 @@ contains !> Checks constraints on the restart parameters !! (old_grid, old_ic, etc.) - subroutine s_check_inputs_restart + impure subroutine s_check_inputs_restart logical :: skip_check !< Flag to skip the check when iterating over !! x, y, and z directions, for special treatment of cylindrical coordinates @@ -103,7 +103,7 @@ contains !> Checks constraints on grid stretching parameters !! (loops_x[y,z], stretch_x[y,z], etc.) - subroutine s_check_inputs_grid_stretching + impure subroutine s_check_inputs_grid_stretching ! Constraints on loops for grid stretching @:PROHIBIT(loops_x < 1) @:PROHIBIT(loops_y < 1) @@ -137,7 +137,7 @@ contains !> Checks constraints on the QBMM and polydisperse bubble parameters !! (qbmm, polydisperse, dist_type, rhoRV, and R0_type) - subroutine s_check_inputs_qbmm_and_polydisperse + impure 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 > 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") @@ -146,7 +146,7 @@ contains !> Checks constraints on initial partial density perturbation !! (perturb_flow, perturb_flow_fluid, perturb_flow_mag, perturb_sph, !! perturb_sph_fluid, and fluid_rho) - subroutine s_check_inputs_perturb_density + impure subroutine s_check_inputs_perturb_density character(len=5) :: iStr !< for int to string conversion integer :: i @@ -172,7 +172,7 @@ contains end do end subroutine s_check_inputs_perturb_density - subroutine s_check_inputs_chemistry + impure subroutine s_check_inputs_chemistry if (chemistry) then @:ASSERT(num_species > 0) @@ -182,7 +182,7 @@ contains !> Checks miscellaneous constraints !! (mixlayer_vel_profile and mixlayer_perturb) - subroutine s_check_inputs_misc + impure subroutine s_check_inputs_misc ! Hypertangent velocity profile @:PROHIBIT(mixlayer_vel_profile .and. (n == 0), & "mixlayer_vel_profile requires n > 0") @@ -198,7 +198,7 @@ contains end subroutine s_check_inputs_misc - subroutine s_check_bc + impure subroutine s_check_bc integer :: i character(len=5) :: iStr !< for int to string conversion diff --git a/src/pre_process/m_compute_levelset.fpp b/src/pre_process/m_compute_levelset.fpp index b22efc7c2b..25958a36b3 100644 --- a/src/pre_process/m_compute_levelset.fpp +++ b/src/pre_process/m_compute_levelset.fpp @@ -23,19 +23,9 @@ module m_compute_levelset s_cuboid_levelset, & s_sphere_levelset - 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 - !! a particular patch to yield the locations of the patch boundaries in the - !! x-, y- and z-coordinate directions. They are used as a means to concisely - !! perform the actions necessary to lay out a particular patch on the grid. - contains - subroutine s_circle_levelset(levelset, levelset_norm, ib_patch_id) + pure subroutine s_circle_levelset(levelset, levelset_norm, ib_patch_id) type(levelset_field), intent(INOUT) :: levelset type(levelset_norm_field), intent(INOUT) :: levelset_norm @@ -71,7 +61,7 @@ contains end subroutine s_circle_levelset - subroutine s_airfoil_levelset(levelset, levelset_norm, ib_patch_id) + pure subroutine s_airfoil_levelset(levelset, levelset_norm, ib_patch_id) type(levelset_field), intent(INOUT) :: levelset type(levelset_norm_field), intent(INOUT) :: levelset_norm @@ -154,7 +144,7 @@ contains end subroutine s_airfoil_levelset - subroutine s_3D_airfoil_levelset(levelset, levelset_norm, ib_patch_id) + pure subroutine s_3D_airfoil_levelset(levelset, levelset_norm, ib_patch_id) type(levelset_field), intent(INOUT) :: levelset type(levelset_norm_field), intent(INOUT) :: levelset_norm @@ -165,6 +155,8 @@ 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 @@ -256,7 +248,7 @@ contains end subroutine s_3D_airfoil_levelset !> Initialize IBM module - subroutine s_rectangle_levelset(levelset, levelset_norm, ib_patch_id) + pure subroutine s_rectangle_levelset(levelset, levelset_norm, ib_patch_id) type(levelset_field), intent(INOUT) :: levelset type(levelset_norm_field), intent(INOUT) :: levelset_norm @@ -266,6 +258,9 @@ contains real(wp) :: x, y, min_dist real(wp) :: side_dists(4) + real(wp) :: x_centroid, y_centroid + real(wp) :: length_x, length_y + integer :: i, j, k !< Loop index variables integer :: idx !< Shortest path direction indicator @@ -350,7 +345,7 @@ contains end subroutine s_rectangle_levelset - subroutine s_cuboid_levelset(levelset, levelset_norm, ib_patch_id) + pure subroutine s_cuboid_levelset(levelset, levelset_norm, ib_patch_id) type(levelset_field), intent(INOUT) :: levelset type(levelset_norm_field), intent(INOUT) :: levelset_norm @@ -360,6 +355,9 @@ contains real(wp) :: x, y, z, min_dist real(wp) :: side_dists(6) + real(wp) :: x_centroid, y_centroid, z_centroid + real(wp) :: length_x, length_y, length_z + integer :: i, j, k !< Loop index variables length_x = patch_ib(ib_patch_id)%length_x @@ -464,7 +462,7 @@ contains end subroutine s_cuboid_levelset - subroutine s_sphere_levelset(levelset, levelset_norm, ib_patch_id) + pure subroutine s_sphere_levelset(levelset, levelset_norm, ib_patch_id) type(levelset_field), intent(INOUT) :: levelset type(levelset_norm_field), intent(INOUT) :: levelset_norm @@ -501,7 +499,7 @@ contains end subroutine s_sphere_levelset - subroutine s_cylinder_levelset(levelset, levelset_norm, ib_patch_id) + pure subroutine s_cylinder_levelset(levelset, levelset_norm, ib_patch_id) type(levelset_field), intent(INOUT) :: levelset type(levelset_norm_field), intent(INOUT) :: levelset_norm diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp index 99695b2dab..86cc884eb0 100644 --- a/src/pre_process/m_data_output.fpp +++ b/src/pre_process/m_data_output.fpp @@ -51,7 +51,7 @@ module m_data_output !! @param ib_markers track if a cell is within the immersed boundary !! @param levelset closest distance from every cell to the IB !! @param levelset_norm normalized vector from every cell to the closest point to the IB - subroutine s_write_abstract_data_files(q_cons_vf, q_prim_vf, ib_markers, levelset, levelset_norm, bc_type) + impure subroutine s_write_abstract_data_files(q_cons_vf, q_prim_vf, ib_markers, levelset, levelset_norm, bc_type) import :: scalar_field, integer_field, sys_size, m, n, p, & pres_field, levelset_field, levelset_norm_field, num_dims @@ -96,7 +96,7 @@ contains !! @param ib_markers track if a cell is within the immersed boundary !! @param levelset closest distance from every cell to the IB !! @param levelset_norm normalized vector from every cell to the closest point to the IB - subroutine s_write_serial_data_files(q_cons_vf, q_prim_vf, ib_markers, levelset, levelset_norm, bc_type) + impure subroutine s_write_serial_data_files(q_cons_vf, q_prim_vf, ib_markers, levelset, levelset_norm, bc_type) type(scalar_field), & dimension(sys_size), & intent(in) :: q_cons_vf, q_prim_vf @@ -553,7 +553,7 @@ contains !! @param ib_markers track if a cell is within the immersed boundary !! @param levelset closest distance from every cell to the IB !! @param levelset_norm normalized vector from every cell to the closest point to the IB - subroutine s_write_parallel_data_files(q_cons_vf, q_prim_vf, ib_markers, levelset, levelset_norm, bc_type) + impure subroutine s_write_parallel_data_files(q_cons_vf, q_prim_vf, ib_markers, levelset, levelset_norm, bc_type) ! Conservative variables type(scalar_field), & @@ -869,7 +869,7 @@ contains !> Computation of parameters, allocation procedures, and/or !! any other tasks needed to properly setup the module - subroutine s_initialize_data_output_module + impure subroutine s_initialize_data_output_module ! Generic string used to store the address of a particular file character(LEN=len_trim(case_dir) + 2*name_len) :: file_loc character(len=15) :: temp @@ -963,7 +963,7 @@ contains end subroutine s_initialize_data_output_module !> Resets s_write_data_files pointer - subroutine s_finalize_data_output_module + impure subroutine s_finalize_data_output_module s_write_data_files => null() diff --git a/src/pre_process/m_global_parameters.fpp b/src/pre_process/m_global_parameters.fpp index d73f3e8ce6..bb49f35d0d 100644 --- a/src/pre_process/m_global_parameters.fpp +++ b/src/pre_process/m_global_parameters.fpp @@ -284,7 +284,7 @@ contains !> Assigns default values to user inputs prior to reading !! them in. This allows for an easier consistency check of !! these parameters once they are read from the input file. - subroutine s_assign_default_values_to_user_inputs + impure subroutine s_assign_default_values_to_user_inputs integer :: i !< Generic loop operator @@ -547,7 +547,7 @@ contains !> Computation of parameters, allocation procedures, and/or !! any other tasks needed to properly setup the module - subroutine s_initialize_global_parameters_module + impure subroutine s_initialize_global_parameters_module integer :: i, j, fac @@ -908,7 +908,7 @@ contains end subroutine s_initialize_global_parameters_module - subroutine s_initialize_parallel_io + impure subroutine s_initialize_parallel_io num_dims = 1 + min(1, n) + min(1, p) @@ -941,7 +941,7 @@ contains end subroutine s_initialize_parallel_io - subroutine s_finalize_global_parameters_module + impure subroutine s_finalize_global_parameters_module integer :: i diff --git a/src/pre_process/m_grid.f90 b/src/pre_process/m_grid.f90 index 3afd8e85d3..2c73bc4fe1 100644 --- a/src/pre_process/m_grid.f90 +++ b/src/pre_process/m_grid.f90 @@ -35,7 +35,7 @@ module m_grid abstract interface - subroutine s_generate_abstract_grid + impure subroutine s_generate_abstract_grid end subroutine s_generate_abstract_grid @@ -50,7 +50,7 @@ end subroutine s_generate_abstract_grid !! inputted by the user. The grid information is stored in !! the grid variables containing coordinates of the cell- !! centers and cell-boundaries. - subroutine s_generate_serial_grid + impure subroutine s_generate_serial_grid ! Generic loop iterator integer :: i, j !< generic loop operators @@ -189,7 +189,7 @@ end subroutine s_generate_serial_grid !! inputted by the user. The grid information is stored in !! the grid variables containing coordinates of the cell- !! centers and cell-boundaries. - subroutine s_generate_parallel_grid + impure subroutine s_generate_parallel_grid #ifdef MFC_MPI @@ -338,7 +338,7 @@ end subroutine s_generate_parallel_grid !> Computation of parameters, allocation procedures, and/or !! any other tasks needed to properly setup the module - subroutine s_initialize_grid_module + impure subroutine s_initialize_grid_module if (parallel_io .neqv. .true.) then s_generate_grid => s_generate_serial_grid @@ -349,7 +349,7 @@ subroutine s_initialize_grid_module end subroutine s_initialize_grid_module !> Deallocation procedures for the module - subroutine s_finalize_grid_module + impure subroutine s_finalize_grid_module s_generate_grid => null() diff --git a/src/pre_process/m_initial_condition.fpp b/src/pre_process/m_initial_condition.fpp index 844487329d..8b7e001ac7 100644 --- a/src/pre_process/m_initial_condition.fpp +++ b/src/pre_process/m_initial_condition.fpp @@ -68,7 +68,7 @@ contains !> Computation of parameters, allocation procedures, and/or !! any other tasks needed to properly setup the module - subroutine s_initialize_initial_condition_module + impure subroutine s_initialize_initial_condition_module integer :: i, j, k, l !< generic loop iterators @@ -173,7 +173,7 @@ contains !! on the grid using the primitive variables included with !! the patch parameters. The subroutine is complete once the !! primitive variables are converted to conservative ones. - subroutine s_generate_initial_condition + impure subroutine s_generate_initial_condition ! Converting the conservative variables to the primitive ones given ! preexisting initial condition data files were read in on start-up @@ -206,7 +206,7 @@ contains end subroutine s_generate_initial_condition !> Deallocation procedures for the module - subroutine s_finalize_initial_condition_module + impure subroutine s_finalize_initial_condition_module integer :: i !< Generic loop iterator diff --git a/src/pre_process/m_model.fpp b/src/pre_process/m_model.fpp index 8565556abc..214a5fcda1 100644 --- a/src/pre_process/m_model.fpp +++ b/src/pre_process/m_model.fpp @@ -29,7 +29,7 @@ contains !> This procedure reads a binary STL file. !! @param filepath Path to the STL file. !! @param model The binary of the STL file. - subroutine s_read_stl_binary(filepath, model) + impure subroutine s_read_stl_binary(filepath, model) character(LEN=*), intent(in) :: filepath type(t_model), intent(out) :: model @@ -78,7 +78,7 @@ contains !> This procedure reads an ASCII STL file. !! @param filepath Path to the STL file. !! @param model the STL file. - subroutine s_read_stl_ascii(filepath, model) + impure subroutine s_read_stl_ascii(filepath, model) character(LEN=*), intent(in) :: filepath type(t_model), intent(out) :: model @@ -186,7 +186,7 @@ contains !> This procedure reads an STL file. !! @param filepath Path to the STL file. !! @param model the STL file. - subroutine s_read_stl(filepath, model) + impure subroutine s_read_stl(filepath, model) character(LEN=*), intent(in) :: filepath type(t_model), intent(out) :: model @@ -220,7 +220,7 @@ contains !> This procedure reads an OBJ file. !! @param filepath Path to the odj file. !! @param model The obj file. - subroutine s_read_obj(filepath, model) + impure subroutine s_read_obj(filepath, model) character(LEN=*), intent(in) :: filepath type(t_model), intent(out) :: model @@ -296,7 +296,7 @@ contains !> This procedure reads a mesh from a file. !! @param filepath Path to the file to read. !! @return The model read from the file. - function f_model_read(filepath) result(model) + impure function f_model_read(filepath) result(model) character(LEN=*), intent(in) :: filepath @@ -318,7 +318,7 @@ contains !> This procedure writes a binary STL file. !! @param filepath Path to the STL file. !! @param model STL to write - subroutine s_write_stl(filepath, model) + impure subroutine s_write_stl(filepath, model) character(LEN=*), intent(in) :: filepath type(t_model), intent(in) :: model @@ -368,7 +368,7 @@ contains !> This procedure writes an OBJ file. !! @param filepath Path to the obj file. !! @param model obj to write. - subroutine s_write_obj(filepath, model) + impure subroutine s_write_obj(filepath, model) character(LEN=*), intent(in) :: filepath type(t_model), intent(in) :: model @@ -405,7 +405,7 @@ contains !> This procedure writes a binary STL file. !! @param filepath Path to the file to write. !! @param model Model to write. - subroutine s_model_write(filepath, model) + impure subroutine s_model_write(filepath, model) character(LEN=*), intent(in) :: filepath type(t_model), intent(in) :: model @@ -424,7 +424,7 @@ contains end subroutine s_model_write !> This procedure frees the memory allocated for an STL mesh. - subroutine s_model_free(model) + pure subroutine s_model_free(model) type(t_model), intent(inout) :: model @@ -432,7 +432,7 @@ contains end subroutine s_model_free - function f_read_line(iunit, line) result(bIsLine) + impure function f_read_line(iunit, line) result(bIsLine) integer, intent(in) :: iunit character(80), intent(out) :: line @@ -461,7 +461,7 @@ contains end function f_read_line - subroutine s_skip_ignored_lines(iunit, buffered_line, is_buffered) + impure subroutine s_skip_ignored_lines(iunit, buffered_line, is_buffered) integer, intent(in) :: iunit character(80), intent(inout) :: buffered_line logical, intent(inout) :: is_buffered @@ -485,7 +485,7 @@ contains !! @param spacing Space around the point to search in (grid spacing). !! @param spc Number of samples per cell. !! @return True if the point is inside the octree, false otherwise. - function f_model_is_inside(model, point, spacing, spc) result(fraction) + impure function f_model_is_inside(model, point, spacing, spc) result(fraction) type(t_model), intent(in) :: model t_vec3, intent(in) :: point @@ -532,7 +532,7 @@ contains !! @param ray Ray. !! @param triangle Triangle. !! @return True if the ray intersects the triangle, false otherwise. - function f_intersects_triangle(ray, triangle) result(intersects) + pure elemental function f_intersects_triangle(ray, triangle) result(intersects) type(t_ray), intent(in) :: ray type(t_triangle), intent(in) :: triangle @@ -592,7 +592,7 @@ contains !! @param boundary_v Output boundary vertices/normals. !! @param boundary_vertex_count Output total boundary vertex count !! @param boundary_edge_count Output total boundary edge counts - subroutine f_check_boundary(model, boundary_v, boundary_vertex_count, boundary_edge_count) + pure subroutine f_check_boundary(model, boundary_v, boundary_vertex_count, boundary_edge_count) type(t_model), intent(in) :: model 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 @@ -705,7 +705,7 @@ contains !! @param edge Edges end points to be registered !! @param edge_index Edge index iterator !! @param edge_count Total number of edges - subroutine f_register_edge(temp_boundary_v, edge, edge_index, edge_count) + pure 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(wp), intent(in), dimension(1:2, 1:2) :: edge !< Edges end points to be registered @@ -723,7 +723,7 @@ contains !! @param boundary_edge_count Output total number of boundary edges !! @param spacing Dimensions of the current levelset cell !! @param interpolate Logical output - subroutine f_check_interpolation_2D(boundary_v, boundary_edge_count, spacing, interpolate) + pure 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(wp), intent(in), dimension(1:boundary_edge_count, 1:3, 1:2) :: boundary_v @@ -753,7 +753,7 @@ contains !! @param model Model to search in. !! @param spacing Dimensions of the current levelset cell !! @param interpolate Logical output - subroutine f_check_interpolation_3D(model, spacing, interpolate) + pure subroutine f_check_interpolation_3D(model, spacing, interpolate) logical, intent(inout) :: interpolate type(t_model), intent(in) :: model t_vec3, intent(in) :: spacing @@ -799,7 +799,7 @@ contains !! @param spacing Dimensions of the current levelset cell !! @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) + pure subroutine f_interpolate_2D(boundary_v, boundary_edge_count, spacing, interpolated_boundary_v, total_vertices) real(wp), intent(in), dimension(:, :, :) :: boundary_v t_vec3, intent(in) :: spacing real(wp), allocatable, intent(inout), dimension(:, :) :: interpolated_boundary_v @@ -892,7 +892,7 @@ contains !! @param spacing Dimensions of the current levelset cell !! @param interpolated_boundary_v Output all the boundary vertices of the interpolated 3D model !! @param total_vertices Total number of vertices after interpolation - subroutine f_interpolate_3D(model, spacing, interpolated_boundary_v, total_vertices) + impure subroutine f_interpolate_3D(model, spacing, interpolated_boundary_v, total_vertices) t_vec3, intent(in) :: spacing type(t_model), intent(in) :: model real(wp), allocatable, intent(inout), dimension(:, :) :: interpolated_boundary_v @@ -1042,7 +1042,7 @@ contains !! @param point The cell centers of the current level cell !! @param normals The output levelset normals !! @param distance The output levelset distance - subroutine f_distance_normals_3D(model, point, normals, distance) + pure subroutine f_distance_normals_3D(model, point, normals, distance) type(t_model), intent(IN) :: model t_vec3, intent(in) :: point t_vec3, intent(out) :: normals @@ -1104,7 +1104,7 @@ contains !! @param point The cell centers of the current levelset cell !! @param spacing Dimensions of the current levelset cell !! @return Distance which the levelset distance without interpolation - function f_distance(boundary_v, boundary_vertex_count, boundary_edge_count, point, spacing) result(distance) + pure 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(wp), intent(in), dimension(1:boundary_edge_count, 1:3, 1:2) :: boundary_v t_vec3, intent(in) :: point @@ -1137,7 +1137,7 @@ contains !! @param point The cell centers of the current levelset cell !! @param spacing Dimensions of the current levelset cell !! @param normals Output levelset normals without interpolation - subroutine f_normals(boundary_v, boundary_vertex_count, boundary_edge_count, point, spacing, normals) + pure subroutine f_normals(boundary_v, boundary_vertex_count, boundary_edge_count, point, spacing, normals) integer, intent(in) :: boundary_vertex_count, boundary_edge_count real(wp), intent(in), dimension(1:boundary_edge_count, 1:3, 1:2) :: boundary_v t_vec3, intent(in) :: point @@ -1178,7 +1178,7 @@ contains !! @param point The cell centers of the current levelset cell !! @param spacing Dimensions of the current levelset cell !! @return Distance which the levelset distance without interpolation - function f_interpolated_distance(interpolated_boundary_v, total_vertices, point, spacing) result(distance) + pure function f_interpolated_distance(interpolated_boundary_v, total_vertices, point, spacing) result(distance) integer, intent(in) :: total_vertices real(wp), intent(in), dimension(1:total_vertices, 1:3) :: interpolated_boundary_v t_vec3, intent(in) :: point @@ -1207,7 +1207,7 @@ contains end function f_interpolated_distance !> This procedure calculates the barycentric facet area - function f_tri_area(tri) result(tri_area) + pure function f_tri_area(tri) result(tri_area) real(wp), dimension(1:3, 1:3), intent(in) :: tri t_vec3 :: AB, AC, cross real(wp) :: tri_area diff --git a/src/pre_process/m_mpi_proxy.fpp b/src/pre_process/m_mpi_proxy.fpp index 3aba6f6cd5..3950fdb42d 100644 --- a/src/pre_process/m_mpi_proxy.fpp +++ b/src/pre_process/m_mpi_proxy.fpp @@ -44,7 +44,7 @@ contains !! these are not available to the remaining processors. This !! subroutine is then in charge of broadcasting the required !! information. - subroutine s_mpi_bcast_user_inputs + impure subroutine s_mpi_bcast_user_inputs #ifdef MFC_MPI @@ -164,7 +164,7 @@ contains !! as well as recomputing some of the global parameters so !! that they reflect the configuration of sub-domain that is !! overseen by the local processor. - subroutine s_mpi_decompose_computational_domain + impure subroutine s_mpi_decompose_computational_domain #ifdef MFC_MPI diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index dca1ff1352..2425553d3f 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -64,7 +64,7 @@ module m_patches contains - subroutine s_apply_domain_patches(patch_id_fp, q_prim_vf, ib_markers_sf, levelset, levelset_norm) + impure subroutine s_apply_domain_patches(patch_id_fp, q_prim_vf, ib_markers_sf, levelset, levelset_norm) type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf integer, dimension(0:m, 0:m, 0:m), intent(inout) :: patch_id_fp, ib_markers_sf @@ -305,7 +305,7 @@ contains !! @param patch_id patch identifier !! @param patch_id_fp Array to track patch ids !! @param q_prim_vf Array of primitive variables - subroutine s_spiral(patch_id, patch_id_fp, q_prim_vf) + impure subroutine s_spiral(patch_id, patch_id_fp, q_prim_vf) integer, intent(in) :: patch_id integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp @@ -2395,7 +2395,7 @@ contains end subroutine s_convert_cylindrical_to_cartesian_coord - function f_convert_cyl_to_cart(cyl) result(cart) + pure function f_convert_cyl_to_cart(cyl) result(cart) !$acc routine seq @@ -2421,7 +2421,7 @@ contains !! @param myth Angle !! @param offset Thickness !! @param a Starting position - function f_r(myth, offset, a) + pure elemental function f_r(myth, offset, a) !$acc routine seq real(wp), intent(in) :: myth, offset, a real(wp) :: b diff --git a/src/pre_process/m_perturbation.fpp b/src/pre_process/m_perturbation.fpp index 23353eee0f..f4909e89ee 100644 --- a/src/pre_process/m_perturbation.fpp +++ b/src/pre_process/m_perturbation.fpp @@ -30,7 +30,7 @@ module m_perturbation contains - subroutine s_initialize_perturbation_module() + impure subroutine s_initialize_perturbation_module() bcxb = bc_x%beg; bcxe = bc_x%end; bcyb = bc_y%beg; bcye = bc_y%end; bczb = bc_z%beg; bcze = bc_z%end @@ -56,7 +56,7 @@ contains end subroutine s_initialize_perturbation_module - subroutine s_perturb_sphere(q_prim_vf) + impure subroutine s_perturb_sphere(q_prim_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf integer :: i, j, k, l !< generic loop operators @@ -88,7 +88,7 @@ contains end subroutine s_perturb_sphere - subroutine s_perturb_surrounding_flow(q_prim_vf) + impure subroutine s_perturb_surrounding_flow(q_prim_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf integer :: i, j, k !< generic loop iterators @@ -120,7 +120,7 @@ contains !! instability waves with spatial wavenumbers, (4,0), (2,0), !! and (1,0) are superposed. For a 3D waves, (4,4), (4,-4), !! (2,2), (2,-2), (1,1), (1,-1) areadded on top of 2D waves. - subroutine s_superposition_instability_wave(q_prim_vf) + impure subroutine s_superposition_instability_wave(q_prim_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf real(wp), dimension(mixlayer_nvar, 0:m, 0:n, 0:p) :: wave, wave1, wave2, wave_tmp real(wp) :: uratio, Ldomain @@ -183,7 +183,7 @@ contains end subroutine s_superposition_instability_wave !> This subroutine computes equilibrium bubble radius of the perturbed pressure field - subroutine s_compute_equilibrium_state(fP, fR0, fR) + impure subroutine s_compute_equilibrium_state(fP, fR0, fR) real(wp), intent(in) :: fP, fR0 real(wp), intent(inout) :: fR real(wp) :: f0, f1 @@ -229,7 +229,7 @@ contains !! The eigenvalue problem is derived from the linearized !! Euler equations with parallel mean flow assumption !! (See Sandham 1989 PhD thesis for details). - subroutine s_instability_wave(alpha, beta, wave, shift) + pure subroutine s_instability_wave(alpha, beta, wave, shift) 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), intent(in) :: shift !< phase shift @@ -281,7 +281,7 @@ contains !> This subroutine solves linear system from linear stability analysis and !! 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) + pure subroutine s_solve_linear_system(alpha, beta, u_mean, rho_mean, p_mean, d, gam, pi_inf, mach, wave, shift) 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 @@ -358,7 +358,7 @@ 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) + pure subroutine s_instability_nonreflecting_subsonic_buffer_bc(ar, ai, hr, hi, rho_mean, mach) 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 @@ -494,7 +494,7 @@ contains !> This subroutine generates an instability wave using the most unstable !! 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) + pure subroutine s_generate_wave(wr, wi, zr, zi, rho_mean, mach, alpha, beta, wave, shift) 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 @@ -615,7 +615,7 @@ contains end subroutine s_generate_wave - subroutine s_elliptic_smoothing(q_prim_vf, bc_type) + impure subroutine s_elliptic_smoothing(q_prim_vf, bc_type) type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(integer_field), dimension(1:num_dims, -1:1), intent(in) :: bc_type @@ -676,7 +676,7 @@ contains end subroutine s_elliptic_smoothing - subroutine s_finalize_perturbation_module() + impure subroutine s_finalize_perturbation_module() if (elliptic_smoothing) then deallocate (q_prim_temp) diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index d48a0929e3..1c9c79d342 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -76,13 +76,13 @@ module m_start_up abstract interface - subroutine s_read_abstract_grid_data_files + impure subroutine s_read_abstract_grid_data_files end subroutine s_read_abstract_grid_data_files !! @param q_cons_vf Conservative variables !! @param ib_markers track if a cell is within the immersed boundary - subroutine s_read_abstract_ic_data_files(q_cons_vf, ib_markers) + impure subroutine s_read_abstract_ic_data_files(q_cons_vf, ib_markers) import :: scalar_field, integer_field, sys_size, pres_field @@ -112,7 +112,7 @@ contains !> Reads the configuration file pre_process.inp, in order to !! populate the parameters in module m_global_parameters.f90 !! with the user provided inputs - subroutine s_read_input_file + impure subroutine s_read_input_file character(LEN=name_len) :: file_loc !< !! Generic string used to store the address of a particular file @@ -193,7 +193,7 @@ contains !! individual choices are compatible with the code's options !! and that the combination of these choices results into a !! valid configuration for the pre-process - subroutine s_check_input_file + impure subroutine s_check_input_file character(LEN=len_trim(case_dir)) :: file_loc !< !! Generic string used to store the address of a particular file @@ -228,7 +228,7 @@ contains !> The goal of this subroutine is to read in any preexisting !! grid data as well as based on the imported grid, complete !! the necessary global computational domain parameters. - subroutine s_read_serial_grid_data_files + impure subroutine s_read_serial_grid_data_files ! Generic string used to store the address of a particular file character(LEN=len_trim(case_dir) + 3*name_len) :: file_loc @@ -365,7 +365,7 @@ contains !! at the (non-)uniform cell-width distributions for all the !! active coordinate directions and making sure that all of !! the cell-widths are positively valued - subroutine s_check_grid_data_files + impure subroutine s_check_grid_data_files ! Cell-boundary Data Consistency Check in x-direction @@ -406,7 +406,7 @@ contains !! all new initial condition. !! @param q_cons_vf Conservative variables !! @param ib_markers track if a cell is within the immersed boundary - subroutine s_read_serial_ic_data_files(q_cons_vf, ib_markers) + impure subroutine s_read_serial_ic_data_files(q_cons_vf, ib_markers) type(scalar_field), & dimension(sys_size), & @@ -537,7 +537,7 @@ contains !! at the (non-)uniform cell-width distributions for all the !! active coordinate directions and making sure that all of !! the cell-widths are positively valued - subroutine s_read_parallel_grid_data_files + impure subroutine s_read_parallel_grid_data_files #ifdef MFC_MPI @@ -642,7 +642,7 @@ contains !! all new initial condition. !! @param q_cons_vf Conservative variables !! @param ib_markers track if a cell is within the immersed boundary - subroutine s_read_parallel_ic_data_files(q_cons_vf, ib_markers) + impure subroutine s_read_parallel_ic_data_files(q_cons_vf, ib_markers) type(scalar_field), & dimension(sys_size), & @@ -761,13 +761,13 @@ contains end subroutine s_read_parallel_ic_data_files - subroutine s_initialize_modules + impure subroutine s_initialize_modules ! Computation of parameters, allocation procedures, and/or any other tasks ! needed to properly setup the modules call s_initialize_global_parameters_module() !Quadrature weights and nodes for polydisperse simulations if (bubbles_euler .and. nb > 1) then - call s_simpson + call s_simpson(weight, R0) end if !Initialize variables for non-polytropic (Preston) model if (bubbles_euler .and. .not. polytropic) then @@ -808,7 +808,7 @@ contains end subroutine s_initialize_modules - subroutine s_read_grid() + impure subroutine s_read_grid() if (old_grid) then call s_read_grid_data_files() @@ -826,7 +826,7 @@ contains end subroutine s_read_grid - subroutine s_apply_initial_condition(start, finish, proc_time, time_avg, time_final, file_exists) + impure subroutine s_apply_initial_condition(start, finish, proc_time, time_avg, time_final, file_exists) real(wp), intent(inout) :: start, finish real(wp), dimension(:), intent(inout) :: proc_time @@ -863,7 +863,7 @@ contains call cpu_time(finish) end subroutine s_apply_initial_condition - subroutine s_save_data(proc_time, time_avg, time_final, file_exists) + impure subroutine s_save_data(proc_time, time_avg, time_final, file_exists) real(wp), dimension(:), intent(inout) :: proc_time real(wp), intent(inout) :: time_avg, time_final @@ -897,7 +897,7 @@ contains end if end subroutine s_save_data - subroutine s_initialize_mpi_domain + impure subroutine s_initialize_mpi_domain ! Initialization of the MPI environment call s_mpi_initialize() @@ -923,7 +923,7 @@ contains call s_mpi_decompose_computational_domain() end subroutine s_initialize_mpi_domain - subroutine s_finalize_modules + impure subroutine s_finalize_modules ! Disassociate pointers for serial and parallel I/O s_generate_grid => null() s_read_grid_data_files => null() diff --git a/src/simulation/m_acoustic_src.fpp b/src/simulation/m_acoustic_src.fpp index ac37ab0811..0205e4043b 100644 --- a/src/simulation/m_acoustic_src.fpp +++ b/src/simulation/m_acoustic_src.fpp @@ -62,7 +62,7 @@ module m_acoustic_src contains !> This subroutine initializes the acoustic source module - subroutine s_initialize_acoustic_src + impure subroutine s_initialize_acoustic_src integer :: i, j !< generic loop variables @:ALLOCATE(loc_acoustic(1:3, 1:num_source), mag(1:num_source), dipole(1:num_source), support(1:num_source), length(1:num_source), height(1:num_source), wavelength(1:num_source), frequency(1:num_source), gauss_sigma_dist(1:num_source), gauss_sigma_time(1:num_source), foc_length(1:num_source), aperture(1:num_source), npulse(1:num_source), pulse(1:num_source), dir(1:num_source), delay(1:num_source), element_polygon_ratio(1:num_source), rotate_angle(1:num_source), element_spacing_angle(1:num_source), num_elements(1:num_source), element_on(1:num_source), bb_num_freq(1:num_source), bb_bandwidth(1:num_source), bb_lowest_freq(1:num_source)) @@ -121,7 +121,7 @@ contains !! @param q_prim_vf Primitive variables !! @param t_step Current time step !! @param rhs_vf rhs variables - subroutine s_acoustic_src_calculations(q_cons_vf, q_prim_vf, t_step, rhs_vf) + impure subroutine s_acoustic_src_calculations(q_cons_vf, q_prim_vf, t_step, rhs_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf !< !! This variable contains the WENO-reconstructed values of the cell-average @@ -338,7 +338,7 @@ contains !! @param frequency_local Frequency at the spatial location for sine and square waves !! @param gauss_sigma_time_local sigma in time for Gaussian pulse !! @param source Source term amplitude - subroutine s_source_temporal(sim_time, c, ai, term_index, frequency_local, gauss_sigma_time_local, source, sum_BB) + pure elemental subroutine s_source_temporal(sim_time, c, ai, term_index, frequency_local, gauss_sigma_time_local, source, sum_BB) !$acc routine seq integer, intent(in) :: ai, term_index real(wp), intent(in) :: sim_time, c, sum_BB @@ -398,7 +398,7 @@ contains end subroutine s_source_temporal !> This subroutine identifies and precalculates the non-zero acoustic spatial sources before time-stepping - subroutine s_precalculate_acoustic_spatial_sources + impure subroutine s_precalculate_acoustic_spatial_sources integer :: j, k, l, ai integer :: count integer :: dim @@ -497,7 +497,7 @@ contains !! @param source Source term amplitude !! @param angle Angle of the source term with respect to the x-axis (for 2D or 2D axisymmetric) !! @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) + pure subroutine s_source_spatial(j, k, l, loc, ai, source, angle, xyz_to_r_ratios) integer, intent(in) :: j, k, l, ai real(wp), dimension(3), intent(in) :: loc real(wp), intent(out) :: source, angle, xyz_to_r_ratios(3) @@ -533,7 +533,7 @@ contains !! @param sig Sigma value for the Gaussian distribution !! @param r Displacement from source to current point !! @param source Source term amplitude - subroutine s_source_spatial_planar(ai, sig, r, source) + pure subroutine s_source_spatial_planar(ai, sig, r, source) integer, intent(in) :: ai real(wp), intent(in) :: sig, r(3) real(wp), intent(out) :: source @@ -563,7 +563,7 @@ contains !! @param source Source term amplitude !! @param angle Angle of the source term with respect to the x-axis (for 2D or 2D axisymmetric) !! @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) + pure subroutine s_source_spatial_transducer(ai, sig, r, source, angle, xyz_to_r_ratios) integer, intent(in) :: ai real(wp), intent(in) :: sig, r(3) real(wp), intent(out) :: source, angle, xyz_to_r_ratios(3) @@ -608,7 +608,7 @@ contains !! @param source Source term amplitude !! @param angle Angle of the source term with respect to the x-axis (for 2D or 2D axisymmetric) !! @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) + pure subroutine s_source_spatial_transducer_array(ai, sig, r, source, angle, xyz_to_r_ratios) integer, intent(in) :: ai real(wp), intent(in) :: sig, r(3) real(wp), intent(out) :: source, angle, xyz_to_r_ratios(3) @@ -690,7 +690,7 @@ contains !! @param ai Acoustic source index !! @param c Speed of sound !! @return frequency_local Converted frequency - function f_frequency_local(freq_conv_flag, ai, c) + pure elemental function f_frequency_local(freq_conv_flag, ai, c) !$acc routine seq logical, intent(in) :: freq_conv_flag integer, intent(in) :: ai @@ -709,7 +709,7 @@ contains !! @param c Speed of sound !! @param ai Acoustic source index !! @return gauss_sigma_time_local Converted Gaussian sigma time - function f_gauss_sigma_time_local(gauss_conv_flag, ai, c) + pure elemental function f_gauss_sigma_time_local(gauss_conv_flag, ai, c) !$acc routine seq logical, intent(in) :: gauss_conv_flag integer, intent(in) :: ai diff --git a/src/simulation/m_body_forces.fpp b/src/simulation/m_body_forces.fpp index c27ca8e017..1ef74cbcee 100644 --- a/src/simulation/m_body_forces.fpp +++ b/src/simulation/m_body_forces.fpp @@ -28,7 +28,7 @@ contains !> This subroutine inializes the module global array of mixture !! densities in each grid cell - subroutine s_initialize_body_forces_module + impure subroutine s_initialize_body_forces_module ! Simulation is at least 2D if (n > 0) then @@ -168,7 +168,7 @@ contains end subroutine s_compute_body_forces_rhs - subroutine s_finalize_body_forces_module + impure subroutine s_finalize_body_forces_module @:DEALLOCATE(rhoM) diff --git a/src/simulation/m_boundary_conditions.fpp b/src/simulation/m_boundary_conditions.fpp index 3707fec910..d0666e2ca7 100644 --- a/src/simulation/m_boundary_conditions.fpp +++ b/src/simulation/m_boundary_conditions.fpp @@ -18,7 +18,7 @@ module m_boundary_conditions contains - subroutine s_read_serial_boundary_condition_files(step_dirpath, bc_type) + impure subroutine s_read_serial_boundary_condition_files(step_dirpath, bc_type) character(LEN=*), intent(in) :: step_dirpath @@ -62,7 +62,7 @@ contains end subroutine s_read_serial_boundary_condition_files - subroutine s_read_parallel_boundary_condition_files(bc_type) + impure subroutine s_read_parallel_boundary_condition_files(bc_type) type(integer_field), dimension(1:num_dims, -1:1), intent(inout) :: bc_type diff --git a/src/simulation/m_bubbles.fpp b/src/simulation/m_bubbles.fpp index c93c333e41..bf008b9b00 100644 --- a/src/simulation/m_bubbles.fpp +++ b/src/simulation/m_bubbles.fpp @@ -38,7 +38,7 @@ contains !! @param f_bub_adv_src Source for bubble volume fraction !! @param f_divu Divergence of velocity !! @param fCson Speed of sound from fP (EL) - function f_rddot(fRho, fP, fR, fV, fR0, fpb, fpbdot, alf, fntait, fBtait, f_bub_adv_src, f_divu, fCson) + pure elemental function f_rddot(fRho, fP, fR, fV, fR0, fpb, fpbdot, alf, fntait, fBtait, f_bub_adv_src, f_divu, fCson) !$acc routine seq real(wp), intent(in) :: fRho, fP, fR, fV, fR0, fpb, fpbdot, alf real(wp), intent(in) :: fntait, fBtait, f_bub_adv_src, f_divu @@ -79,7 +79,7 @@ contains !! @param fR Current bubble radius !! @param fV Current bubble velocity !! @param fpb Internal bubble pressure - function f_cpbw(fR0, fR, fV, fpb) + pure elemental function f_cpbw(fR0, fR, fV, fpb) !$acc routine seq real(wp), intent(in) :: fR0, fR, fV, fpb @@ -98,7 +98,7 @@ contains !! @param fCpinf Driving bubble pressure !! @param fntait Tait EOS parameter !! @param fBtait Tait EOS parameter - function f_H(fCpbw, fCpinf, fntait, fBtait) + pure elemental function f_H(fCpbw, fCpinf, fntait, fBtait) !$acc routine seq real(wp), intent(in) :: fCpbw, fCpinf, fntait, fBtait @@ -118,7 +118,7 @@ contains !! @param fntait Tait EOS parameter !! @param fBtait Tait EOS parameter !! @param fH Bubble enthalpy - function f_cgas(fCpinf, fntait, fBtait, fH) + pure elemental function f_cgas(fCpinf, fntait, fBtait, fH) !$acc routine seq real(wp), intent(in) :: fCpinf, fntait, fBtait, fH @@ -141,7 +141,7 @@ contains !! @param fBtait Tait EOS parameter !! @param advsrc Advection equation source term !! @param divu Divergence of velocity - function f_cpinfdot(fRho, fP, falf, fntait, fBtait, advsrc, divu) + pure elemental function f_cpinfdot(fRho, fP, falf, fntait, fBtait, advsrc, divu) !$acc routine seq real(wp), intent(in) :: fRho, fP, falf, fntait, fBtait, advsrc, divu @@ -171,7 +171,7 @@ contains !! @param fV Current bubble velocity !! @param fR0 Equilibrium bubble radius !! @param fpbdot Time derivative of the internal bubble pressure - function f_Hdot(fCpbw, fCpinf, fCpinf_dot, fntait, fBtait, fR, fV, fR0, fpbdot) + pure elemental function f_Hdot(fCpbw, fCpinf, fCpinf_dot, fntait, fBtait, fR, fV, fR0, fpbdot) !$acc routine seq real(wp), intent(in) :: fCpbw, fCpinf, fCpinf_dot, fntait, fBtait real(wp), intent(in) :: fR, fV, fR0, fpbdot @@ -207,7 +207,7 @@ contains !! @param fV Current bubble velocity !! @param fR0 Equilibrium bubble radius !! @param fCpbw Boundary wall pressure - function f_rddot_RP(fCp, fRho, fR, fV, fR0, fCpbw) + pure elemental function f_rddot_RP(fCp, fRho, fR, fV, fR0, fCpbw) !$acc routine seq real(wp), intent(in) :: fCp, fRho, fR, fV, fR0, fCpbw @@ -230,7 +230,7 @@ contains !! @param fcgas Current gas sound speed !! @param fntait Tait EOS parameter !! @param fBtait Tait EOS parameter - function f_rddot_G(fCpbw, fR, fV, fH, fHdot, fcgas, fntait, fBtait) + pure elemental function f_rddot_G(fCpbw, fR, fV, fH, fHdot, fcgas, fntait, fBtait) !$acc routine seq real(wp), intent(in) :: fCpbw, fR, fV, fH, fHdot real(wp), intent(in) :: fcgas, fntait, fBtait @@ -253,10 +253,9 @@ contains !! @param fR Current bubble radius !! @param fV Current bubble velocity !! @param fpb Internal bubble pressure - function f_cpbw_KM(fR0, fR, fV, fpb) + pure elemental function f_cpbw_KM(fR0, fR, fV, fpb) !$acc routine seq real(wp), intent(in) :: fR0, fR, fV, fpb - real(wp) :: f_cpbw_KM if (polytropic) then @@ -281,14 +280,13 @@ contains !! @param fV Current bubble velocity !! @param fR0 Equilibrium bubble radius !! @param fC Current sound speed - function f_rddot_KM(fpbdot, fCp, fCpbw, fRho, fR, fV, fR0, fC) + pure elemental function f_rddot_KM(fpbdot, fCp, fCpbw, fRho, fR, fV, fR0, fC) !$acc routine seq real(wp), intent(in) :: fpbdot, fCp, fCpbw real(wp), intent(in) :: fRho, fR, fV, fR0, fC real(wp) :: tmp1, tmp2, cdot_star real(wp) :: f_rddot_KM - if (polytropic) then cdot_star = -3._wp*gam*Ca*((fR0/fR)**(3._wp*gam))*fV/fR if (.not. f_is_default(Web)) cdot_star = cdot_star - & @@ -316,11 +314,13 @@ contains !> Subroutine that computes bubble wall properties for vapor bubbles !! @param pb Internal bubble pressure !! @param iR0 Current bubble size index - subroutine s_bwproperty(pb, iR0) + pure elemental subroutine s_bwproperty(pb, iR0, chi_vw, k_mw, rho_mw) !$acc routine seq real(wp), intent(in) :: pb integer, intent(in) :: iR0 - + real(wp), intent(out) :: chi_vw !< Bubble wall properties (Ando 2010) + real(wp), intent(out) :: k_mw !< Bubble wall properties (Ando 2010) + real(wp), intent(out) :: rho_mw !< Bubble wall properties (Ando 2010) real(wp) :: x_vw ! mass fraction of vapor @@ -337,19 +337,21 @@ contains !> Function that computes the vapour flux !! @param fR Current bubble radius !! @param fV Current bubble velocity + !! @param fpb !! @param fmass_v Current mass of vapour !! @param iR0 Bubble size index (EE) or bubble identifier (EL) !! @param fmass_n Current gas mass (EL) !! @param fbeta_c Mass transfer coefficient (EL) !! @param fR_m Mixture gas constant (EL) !! @param fgamma_m Mixture gamma (EL) - function f_vflux(fR, fV, fpb, fmass_v, iR0, fmass_n, fbeta_c, fR_m, fgamma_m) + pure elemental subroutine s_vflux(fR, fV, fpb, fmass_v, iR0, vflux, fmass_n, fbeta_c, fR_m, fgamma_m) !$acc routine seq 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(wp), intent(out) :: vflux real(wp), intent(in), optional :: fmass_n, fbeta_c real(wp), intent(out), optional :: fR_m, fgamma_m @@ -357,7 +359,6 @@ contains real(wp) :: rho_mw_lag real(wp) :: grad_chi real(wp) :: conc_v - real(wp) :: f_vflux if (thermal == 3) then !transfer ! constant transfer model @@ -374,21 +375,21 @@ contains chi_bar = fmass_v/(fmass_v + fmass_n) grad_chi = (chi_bar - conc_v) rho_mw_lag = (fmass_n + fmass_v)/(4._wp/3._wp*pi*fR**3._wp) - f_vflux = 0._wp + vflux = 0._wp if (lag_params%massTransfer_model) then - f_vflux = -fbeta_c*rho_mw_lag*grad_chi/(1._wp - conc_v)/fR + vflux = -fbeta_c*rho_mw_lag*grad_chi/(1._wp - conc_v)/fR end if else 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._wp - chi_vw)/fR + vflux = rho_mw*grad_chi/Pe_c/(1._wp - chi_vw)/fR end if else ! polytropic - f_vflux = pv*fV/(R_v*Tw) + vflux = pv*fV/(R_v*Tw) end if - end function f_vflux + end subroutine s_vflux !> Function that computes the time derivative of !! the internal bubble pressure @@ -401,7 +402,7 @@ contains !! @param fbeta_t Mass transfer coefficient (EL) !! @param fR_m Mixture gas constant (EL) !! @param fgamma_m Mixture gamma (EL) - function f_bpres_dot(fvflux, fR, fV, fpb, fmass_v, iR0, fbeta_t, fR_m, fgamma_m) + pure elemental function f_bpres_dot(fvflux, fR, fV, fpb, fmass_v, iR0, fbeta_t, fR_m, fgamma_m) !$acc routine seq real(wp), intent(in) :: fvflux real(wp), intent(in) :: fR @@ -458,10 +459,10 @@ contains !! @param fbeta_t Heat transfer coefficient (EL) !! @param fCson Speed of sound (EL) !! @param adap_dt_stop Fail-safe exit if max iteration count reached - subroutine s_advance_step(fRho, fP, fR, fV, fR0, fpb, fpbdot, alf, & - fntait, fBtait, f_bub_adv_src, f_divu, & - bub_id, fmass_v, fmass_n, fbeta_c, & - fbeta_t, fCson, adap_dt_stop) + pure subroutine s_advance_step(fRho, fP, fR, fV, fR0, fpb, fpbdot, alf, & + fntait, fBtait, f_bub_adv_src, f_divu, & + bub_id, fmass_v, fmass_n, fbeta_c, & + fbeta_t, fCson, adap_dt_stop) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_advance_step #else @@ -593,9 +594,9 @@ contains !! @param f_divu Divergence of velocity !! @param fCson Speed of sound (EL) !! @param h Time step size - subroutine s_initial_substep_h(fRho, fP, fR, fV, fR0, fpb, fpbdot, alf, & - fntait, fBtait, f_bub_adv_src, f_divu, & - fCson, h) + pure subroutine s_initial_substep_h(fRho, fP, fR, fV, fR0, fpb, fpbdot, alf, & + fntait, fBtait, f_bub_adv_src, f_divu, & + fCson, h) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_initial_substep_h #else @@ -677,11 +678,11 @@ contains !! @param myV_tmp Bubble radial velocity at each stage !! @param myPb_tmp Internal bubble pressure at each stage (EL) !! @param myMv_tmp Mass of vapor in the bubble at each stage (EL) - subroutine s_advance_substep(err, fRho, fP, fR, fV, fR0, fpb, fpbdot, alf, & - fntait, fBtait, f_bub_adv_src, f_divu, & - bub_id, fmass_v, fmass_n, fbeta_c, & - fbeta_t, fCson, h, & - myR_tmp, myV_tmp, myPb_tmp, myMv_tmp) + pure subroutine s_advance_substep(err, fRho, fP, fR, fV, fR0, fpb, fpbdot, alf, & + fntait, fBtait, f_bub_adv_src, f_divu, & + bub_id, fmass_v, fmass_n, fbeta_c, & + fbeta_t, fCson, h, & + myR_tmp, myV_tmp, myPb_tmp, myMv_tmp) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_advance_substep #else @@ -706,8 +707,8 @@ contains if (bubbles_lagrange) then myPb_tmp(1) = fpb myMv_tmp(1) = fmass_v - mydMvdt_tmp(1) = f_advance_EL(myR_tmp(1), myV_tmp(1), myPb_tmp(1), myMv_tmp(1), bub_id, & - fmass_n, fbeta_c, fbeta_t, mydPbdt_tmp(1)) + call s_advance_EL(myR_tmp(1), myV_tmp(1), myPb_tmp(1), myMv_tmp(1), bub_id, & + fmass_n, fbeta_c, fbeta_t, mydPbdt_tmp(1), mydMvdt_tmp(1)) end if myA_tmp(1) = f_rddot(fRho, fP, myR_tmp(1), myV_tmp(1), fR0, & myPb_tmp(1), mydPbdt_tmp(1), alf, fntait, fBtait, & @@ -720,8 +721,8 @@ contains if (bubbles_lagrange) then myPb_tmp(2) = myPb_tmp(1) + h*mydPbdt_tmp(1) myMv_tmp(2) = myMv_tmp(1) + h*mydMvdt_tmp(1) - mydMvdt_tmp(2) = f_advance_EL(myR_tmp(2), myV_tmp(2), myPb_tmp(2), myMv_tmp(2), & - bub_id, fmass_n, fbeta_c, fbeta_t, mydPbdt_tmp(2)) + call s_advance_EL(myR_tmp(2), myV_tmp(2), myPb_tmp(2), myMv_tmp(2), & + bub_id, fmass_n, fbeta_c, fbeta_t, mydPbdt_tmp(2), mydMvdt_tmp(2)) end if myA_tmp(2) = f_rddot(fRho, fP, myR_tmp(2), myV_tmp(2), fR0, & myPb_tmp(2), mydPbdt_tmp(2), alf, fntait, fBtait, & @@ -734,8 +735,8 @@ contains if (bubbles_lagrange) then myPb_tmp(3) = myPb_tmp(1) + (h/4._wp)*(mydPbdt_tmp(1) + mydPbdt_tmp(2)) myMv_tmp(3) = myMv_tmp(1) + (h/4._wp)*(mydMvdt_tmp(1) + mydMvdt_tmp(2)) - mydMvdt_tmp(3) = f_advance_EL(myR_tmp(3), myV_tmp(3), myPb_tmp(3), myMv_tmp(3), & - bub_id, fmass_n, fbeta_c, fbeta_t, mydPbdt_tmp(3)) + call s_advance_EL(myR_tmp(3), myV_tmp(3), myPb_tmp(3), myMv_tmp(3), & + bub_id, fmass_n, fbeta_c, fbeta_t, mydPbdt_tmp(3), mydMvdt_tmp(3)) end if myA_tmp(3) = f_rddot(fRho, fP, myR_tmp(3), myV_tmp(3), fR0, & myPb_tmp(3), mydPbdt_tmp(3), alf, fntait, fBtait, & @@ -748,8 +749,8 @@ contains if (bubbles_lagrange) then myPb_tmp(4) = myPb_tmp(1) + (h/6._wp)*(mydPbdt_tmp(1) + mydPbdt_tmp(2) + 4._wp*mydPbdt_tmp(3)) myMv_tmp(4) = myMv_tmp(1) + (h/6._wp)*(mydMvdt_tmp(1) + mydMvdt_tmp(2) + 4._wp*mydMvdt_tmp(3)) - mydMvdt_tmp(4) = f_advance_EL(myR_tmp(4), myV_tmp(4), myPb_tmp(4), myMv_tmp(4), & - bub_id, fmass_n, fbeta_c, fbeta_t, mydPbdt_tmp(4)) + call s_advance_EL(myR_tmp(4), myV_tmp(4), myPb_tmp(4), myMv_tmp(4), & + bub_id, fmass_n, fbeta_c, fbeta_t, mydPbdt_tmp(4), mydMvdt_tmp(4)) end if myA_tmp(4) = f_rddot(fRho, fP, myR_tmp(4), myV_tmp(4), fR0, & myPb_tmp(4), mydPbdt_tmp(4), alf, fntait, fBtait, & @@ -781,20 +782,20 @@ contains !! @param fMv_tmp Mass of vapor in the bubble !! @param fdPbdt_tmp Rate of change of the internal bubble pressure !! @param fdMvdt_tmp Rate of change of the mass of vapor in the bubble - function f_advance_EL(fR_tmp, fV_tmp, fPb_tmp, fMv_tmp, bub_id, & - fmass_n, fbeta_c, fbeta_t, fdPbdt_tmp) + pure elemental subroutine s_advance_EL(fR_tmp, fV_tmp, fPb_tmp, fMv_tmp, bub_id, & + fmass_n, fbeta_c, fbeta_t, fdPbdt_tmp, advance_EL) !$acc routine seq real(wp), intent(IN) :: fR_tmp, fV_tmp, fPb_tmp, fMv_tmp real(wp), intent(IN) :: fmass_n, fbeta_c, fbeta_t integer, intent(IN) :: bub_id real(wp), intent(INOUT) :: fdPbdt_tmp + real(wp), intent(out) :: advance_EL + real(wp) :: fVapFlux, myR_m, mygamma_m - real(wp) :: fVapFlux, f_advance_EL, myR_m, mygamma_m - - fVapFlux = f_vflux(fR_tmp, fV_tmp, fPb_tmp, fMv_tmp, bub_id, fmass_n, fbeta_c, myR_m, mygamma_m) + call s_vflux(fR_tmp, fV_tmp, fPb_tmp, fMv_tmp, bub_id, fVapFlux, fmass_n, fbeta_c, myR_m, mygamma_m) fdPbdt_tmp = f_bpres_dot(fVapFlux, fR_tmp, fV_tmp, fPb_tmp, fMv_tmp, bub_id, fbeta_t, myR_m, mygamma_m) - f_advance_EL = 4._wp*pi*fR_tmp**2._wp*fVapFlux + advance_EL = 4._wp*pi*fR_tmp**2._wp*fVapFlux - end function f_advance_EL + end subroutine s_advance_EL end module m_bubbles diff --git a/src/simulation/m_bubbles_EE.fpp b/src/simulation/m_bubbles_EE.fpp index 99d935391e..d2bb02cbc5 100644 --- a/src/simulation/m_bubbles_EE.fpp +++ b/src/simulation/m_bubbles_EE.fpp @@ -31,7 +31,7 @@ module m_bubbles_EE contains - subroutine s_initialize_bubbles_EE_module + impure subroutine s_initialize_bubbles_EE_module integer :: l @@ -71,7 +71,7 @@ contains ! Compute the bubble volume fraction alpha from the bubble number density n !! @param q_cons_vf is the conservative variable - subroutine s_comp_alpha_from_n(q_cons_vf) + pure subroutine s_comp_alpha_from_n(q_cons_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf real(wp) :: nR3bar integer(wp) :: i, j, k, l @@ -92,10 +92,11 @@ contains end subroutine s_comp_alpha_from_n - subroutine s_compute_bubbles_EE_rhs(idir, q_prim_vf) + pure subroutine s_compute_bubbles_EE_rhs(idir, q_prim_vf, divu) integer, intent(in) :: idir type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf + type(scalar_field), intent(inout) :: divu !< matrix for div(u) integer :: j, k, l @@ -152,7 +153,7 @@ contains !! that are needed for the bubble modeling !! @param q_prim_vf Primitive variables !! @param q_cons_vf Conservative variables - subroutine s_compute_bubble_EE_source(q_cons_vf, q_prim_vf, t_step, rhs_vf) + impure subroutine s_compute_bubble_EE_source(q_cons_vf, q_prim_vf, t_step, rhs_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf integer, intent(in) :: t_step @@ -271,8 +272,8 @@ contains if (.not. polytropic) then pb = q_prim_vf(ps(q))%sf(j, k, l) mv = q_prim_vf(ms(q))%sf(j, k, l) - call s_bwproperty(pb, q) - vflux = f_vflux(myR, myV, pb, mv, q) + call s_bwproperty(pb, q, chi_vw, k_mw, rho_mw) + call s_vflux(myR, myV, pb, mv, q, vflux) pbdot = f_bpres_dot(vflux, myR, myV, pb, mv, q) bub_p_src(j, k, l, q) = nbub*pbdot diff --git a/src/simulation/m_bubbles_EL.fpp b/src/simulation/m_bubbles_EL.fpp index 0d5557cd2b..013d91988e 100644 --- a/src/simulation/m_bubbles_EL.fpp +++ b/src/simulation/m_bubbles_EL.fpp @@ -73,7 +73,7 @@ contains !> Initializes the lagrangian subgrid bubble solver !! @param q_cons_vf Initial conservative variables - subroutine s_initialize_bubbles_EL_module(q_cons_vf) + impure subroutine s_initialize_bubbles_EL_module(q_cons_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf @@ -144,7 +144,7 @@ contains end subroutine s_initialize_bubbles_EL_module !> The purpose of this procedure is to start lagrange bubble parameters applying nondimensionalization if needed - subroutine s_start_lagrange_inputs() + impure subroutine s_start_lagrange_inputs() integer :: id_bubbles, id_host real(wp) :: rho0, c0, T0, x0, p0 @@ -188,7 +188,7 @@ contains !> The purpose of this procedure is to obtain the initial bubbles' information !! @param q_cons_vf Conservative variables - subroutine s_read_input_bubbles(q_cons_vf) + impure subroutine s_read_input_bubbles(q_cons_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf @@ -278,7 +278,7 @@ contains !! @param inputBubble Bubble information !! @param q_cons_vf Conservative variables !! @param bub_id Local id of the bubble - subroutine s_add_bubbles(inputBubble, q_cons_vf, bub_id) + impure subroutine s_add_bubbles(inputBubble, q_cons_vf, bub_id) type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf real(wp), dimension(8), intent(in) :: inputBubble @@ -393,7 +393,7 @@ contains !> The purpose of this procedure is to obtain the information of the bubbles from a restart point. !! @param bub_id Local ID of the particle !! @param save_count File identifier - subroutine s_restart_bubbles(bub_id, save_count) + impure subroutine s_restart_bubbles(bub_id, save_count) integer, intent(inout) :: bub_id, save_count @@ -561,7 +561,7 @@ contains myR0 = bub_R0(k) ! Vapor and heat fluxes - myVapFlux = f_vflux(myR, myV, myPb, myMass_v, k, myMass_n, myBeta_c, myR_m, mygamma_m) + call s_vflux(myR, myV, myPb, myMass_v, k, myVapFlux, myMass_n, myBeta_c, myR_m, mygamma_m) myPbdot = f_bpres_dot(myVapFlux, myR, myV, myPb, myMass_v, k, myBeta_t, myR_m, mygamma_m) myMvdot = 4._wp*pi*myR**2._wp*myVapFlux @@ -733,7 +733,7 @@ contains !! @param gamma Liquid specific heat ratio !! @param pi_inf Liquid stiffness !! @param cson Calculated speed of sound - subroutine s_compute_cson_from_pinf(bub_id, q_prim_vf, pinf, cell, rhol, gamma, pi_inf, cson) + pure subroutine s_compute_cson_from_pinf(bub_id, q_prim_vf, pinf, cell, rhol, gamma, pi_inf, cson) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_compute_cson_from_pinf #else @@ -804,7 +804,7 @@ contains !! @param f_pinfl Driving pressure !! @param cell Bubble cell !! @param Romega Control volume radius - subroutine s_get_pinf(bub_id, q_prim_vf, ptype, f_pinfl, cell, preterm1, term2, Romega) + pure subroutine s_get_pinf(bub_id, q_prim_vf, ptype, f_pinfl, cell, preterm1, term2, Romega) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_get_pinf #else @@ -1017,7 +1017,7 @@ contains !> This subroutine updates the Lagrange variables using the tvd RK time steppers. !! The time derivative of the bubble variables must be stored at every stage to avoid precision errors. !! @param stage Current tvd RK stage - subroutine s_update_lagrange_tdv_rk(stage) + impure subroutine s_update_lagrange_tdv_rk(stage) integer, intent(in) :: stage @@ -1135,7 +1135,7 @@ contains !! @param pos Input coordinates !! @param cell Computational coordinate of the cell !! @param scoord Calculated particle coordinates - subroutine s_locate_cell(pos, cell, scoord) + pure subroutine s_locate_cell(pos, cell, scoord) real(wp), dimension(3), intent(in) :: pos real(wp), dimension(3), intent(out) :: scoord @@ -1187,7 +1187,7 @@ contains end subroutine s_locate_cell !> This subroutine transfer data into the temporal variables. - subroutine s_transfer_data_to_tmp() + impure subroutine s_transfer_data_to_tmp() integer :: k @@ -1208,7 +1208,7 @@ contains !> The purpose of this procedure is to determine if the global coordinates of the bubbles !! are present in the current MPI processor (including ghost cells). !! @param pos_part Spatial coordinates of the bubble - function particle_in_domain(pos_part) + pure function particle_in_domain(pos_part) logical :: particle_in_domain real(wp), dimension(3), intent(in) :: pos_part @@ -1261,7 +1261,7 @@ contains !> The purpose of this procedure is to determine if the lagrangian bubble is located in the !! physical domain. The ghost cells are not part of the physical domain. !! @param pos_part Spatial coordinates of the bubble - function particle_in_domain_physical(pos_part) + pure function particle_in_domain_physical(pos_part) logical :: particle_in_domain_physical real(wp), dimension(3), intent(in) :: pos_part @@ -1280,7 +1280,7 @@ contains !! @param q Input scalar field !! @param dq Output gradient of q !! @param dir Gradient spatial direction - subroutine s_gradient_dir(q, dq, dir) + pure subroutine s_gradient_dir(q, dq, dir) type(scalar_field), intent(inout) :: q type(scalar_field), intent(inout) :: dq @@ -1338,7 +1338,7 @@ contains !> Subroutine that writes on each time step the changes of the lagrangian bubbles. !! @param q_time Current time - subroutine s_write_lag_particles(qtime) + impure subroutine s_write_lag_particles(qtime) real(wp), intent(in) :: qtime integer :: k @@ -1382,7 +1382,7 @@ contains !! of the particles (void fraction) in the computatioational domain !! on each time step. !! @param q_time Current time - subroutine s_write_void_evol(qtime) + impure subroutine s_write_void_evol(qtime) real(wp), intent(in) :: qtime real(wp) :: volcell, voltot @@ -1456,7 +1456,7 @@ contains !> Subroutine that writes the restarting files for the particles in the lagrangian solver. !! @param t_step Current time step - subroutine s_write_restart_lag_bubbles(t_step) + impure subroutine s_write_restart_lag_bubbles(t_step) ! Generic string used to store the address of a particular file integer, intent(in) :: t_step @@ -1610,7 +1610,7 @@ contains end subroutine s_calculate_lag_bubble_stats !> Subroutine that writes the maximum and minimum radius of each bubble. - subroutine s_write_lag_bubble_stats() + impure subroutine s_write_lag_bubble_stats() integer :: k character(LEN=path_len + 2*name_len) :: file_loc @@ -1640,7 +1640,7 @@ contains !> The purpose of this subroutine is to remove one specific particle if dt is too small. !! @param bub_id Particle id - subroutine s_remove_lag_bubble(bub_id) + impure subroutine s_remove_lag_bubble(bub_id) integer, intent(in) :: bub_id @@ -1676,7 +1676,7 @@ contains end subroutine s_remove_lag_bubble !> The purpose of this subroutine is to deallocate variables - subroutine s_finalize_lagrangian_solver() + impure subroutine s_finalize_lagrangian_solver() integer :: i diff --git a/src/simulation/m_bubbles_EL_kernels.fpp b/src/simulation/m_bubbles_EL_kernels.fpp index 732affab75..47566eac19 100644 --- a/src/simulation/m_bubbles_EL_kernels.fpp +++ b/src/simulation/m_bubbles_EL_kernels.fpp @@ -22,7 +22,7 @@ contains !! @param lbk_s Computational coordinates of the bubbles !! @param lbk_pos Spatial coordinates of the bubbles !! @param updatedvar Eulerian variable to be updated - subroutine s_smoothfunction(nBubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar) + pure subroutine s_smoothfunction(nBubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar) integer, intent(in) :: nBubs real(wp), dimension(1:lag_params%nBubs_glb, 1:3, 1:2), intent(in) :: lbk_s, lbk_pos @@ -40,7 +40,7 @@ contains !> The purpose of this procedure contains the algorithm to use the delta kernel function to map the effect of the bubbles. !! The effect of the bubbles only affects the cell where the bubble is located. - subroutine s_deltafunc(nBubs, lbk_rad, lbk_vel, lbk_s, updatedvar) + pure subroutine s_deltafunc(nBubs, lbk_rad, lbk_vel, lbk_s, updatedvar) integer, intent(in) :: nBubs real(wp), dimension(1:lag_params%nBubs_glb, 1:3, 1:2), intent(in) :: lbk_s @@ -95,7 +95,7 @@ contains !> The purpose of this procedure contains the algorithm to use the gaussian kernel function to map the effect of the bubbles. !! The effect of the bubbles affects the 3X3x3 cells that surround the bubble. - subroutine s_gaussian(nBubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar) + pure subroutine s_gaussian(nBubs, lbk_rad, lbk_vel, lbk_s, lbk_pos, updatedvar) integer, intent(in) :: nBubs real(wp), dimension(1:lag_params%nBubs_glb, 1:3, 1:2), intent(in) :: lbk_s, lbk_pos @@ -199,7 +199,7 @@ contains end subroutine s_gaussian !> The purpose of this subroutine is to apply the gaussian kernel function for each bubble (Maeda and Colonius, 2018)). - subroutine s_applygaussian(center, cellaux, nodecoord, stddsv, strength_idx, func) + pure subroutine s_applygaussian(center, cellaux, nodecoord, stddsv, strength_idx, func) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_applygaussian #else @@ -269,7 +269,7 @@ contains !> The purpose of this subroutine is to check if the current cell is outside the computational domain or not (including ghost cells). !! @param cellaux Tested cell to smear the bubble effect in. !! @param celloutside If true, then cellaux is outside the computational domain. - subroutine s_check_celloutside(cellaux, celloutside) + pure subroutine s_check_celloutside(cellaux, celloutside) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_check_celloutside #else @@ -305,7 +305,7 @@ contains !> This subroutine relocates the current cell, if it intersects a symmetric boundary. !! @param cell Cell of the current bubble !! @param cellaux Cell to map the bubble effect in. - subroutine s_shift_cell_symmetric_bc(cellaux, cell) + pure subroutine s_shift_cell_symmetric_bc(cellaux, cell) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_shift_cell_symmetric_bc #else @@ -346,7 +346,7 @@ contains !! @param cell Cell where the bubble is located !! @param volpart Volume of the bubble !! @param stddsv Standard deviaton - subroutine s_compute_stddsv(cell, volpart, stddsv) + pure subroutine s_compute_stddsv(cell, volpart, stddsv) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_compute_stddsv #else @@ -387,7 +387,7 @@ contains !> The purpose of this procedure is to calculate the characteristic cell volume !! @param cell Computational coordinates (x, y, z) !! @param Charvol Characteristic volume - subroutine s_get_char_vol(cellx, celly, cellz, Charvol) + pure elemental subroutine s_get_char_vol(cellx, celly, cellz, Charvol) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_get_char_vol #else @@ -412,7 +412,7 @@ contains !! real type into integer. !! @param s Computational coordinates of the bubble, real type !! @param get_cell Computational coordinates of the bubble, integer type - subroutine s_get_cell(s_cell, get_cell) + pure subroutine s_get_cell(s_cell, get_cell) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_get_cell #else diff --git a/src/simulation/m_cbc.fpp b/src/simulation/m_cbc.fpp index 1723d4cd5d..1c7f1a4506 100644 --- a/src/simulation/m_cbc.fpp +++ b/src/simulation/m_cbc.fpp @@ -127,7 +127,7 @@ contains !> The computation of parameters, the allocation of memory, !! the association of pointers and/or the execution of any !! other procedures that are necessary to setup the module. - subroutine s_initialize_cbc_module + impure subroutine s_initialize_cbc_module integer :: i logical :: is_cbc @@ -1578,7 +1578,7 @@ contains end subroutine s_finalize_cbc ! Detext if the problem has any characteristic boundary conditions - subroutine s_any_cbc_boundaries(toggle) + pure elemental subroutine s_any_cbc_boundaries(toggle) logical, intent(inout) :: toggle @@ -1593,7 +1593,7 @@ contains end subroutine s_any_cbc_boundaries !> Module deallocation and/or disassociation procedures - subroutine s_finalize_cbc_module + impure subroutine s_finalize_cbc_module logical :: is_cbc diff --git a/src/simulation/m_checker.fpp b/src/simulation/m_checker.fpp index 814e957591..66ee9b9921 100644 --- a/src/simulation/m_checker.fpp +++ b/src/simulation/m_checker.fpp @@ -22,7 +22,7 @@ contains !> Checks compatibility of parameters in the input file. !! Used by the simulation stage - subroutine s_check_inputs + impure subroutine s_check_inputs call s_check_inputs_compilers @@ -47,7 +47,7 @@ contains end subroutine s_check_inputs !> Checks constraints on compiler options - subroutine s_check_inputs_compilers + impure subroutine s_check_inputs_compilers #if !defined(MFC_OpenACC) && !(defined(__PGI) || defined(_CRAYFTN)) @:PROHIBIT(rdma_mpi, "Unsupported value of rdma_mpi for the current compiler") #endif @@ -59,7 +59,7 @@ contains end subroutine s_check_inputs_compilers !> Checks constraints on WENO scheme parameters - subroutine s_check_inputs_weno + impure subroutine s_check_inputs_weno character(len=5) :: numStr !< for int to string conversion call s_int_to_str(num_stcls_min*weno_order, numStr) @@ -89,7 +89,7 @@ contains end subroutine s_check_inputs_weno !> Checks constraints on Riemann solver parameters - subroutine s_check_inputs_riemann_solver + impure subroutine s_check_inputs_riemann_solver @:PROHIBIT(riemann_solver /= 2 .and. model_eqns == 3, "6-equation model (model_eqns = 3) requires riemann_solver = 2") @:PROHIBIT(riemann_solver < 1 .or. riemann_solver > 4, "riemann_solver must be 1, 2, 3, or 4") @:PROHIBIT(all(wave_speeds /= (/dflt_int, 1, 2/)), "wave_speeds must be 1 or 2") @@ -103,7 +103,7 @@ contains end subroutine s_check_inputs_riemann_solver !> Checks constraints on geometry and precision - subroutine s_check_inputs_geometry_precision + impure 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.") @@ -111,7 +111,7 @@ contains end subroutine s_check_inputs_geometry_precision !> Checks constraints on time stepping parameters - subroutine s_check_inputs_time_stepping + impure subroutine s_check_inputs_time_stepping if (.not. cfl_dt) then @:PROHIBIT(dt <= 0) end if @@ -119,13 +119,13 @@ contains end subroutine s_check_inputs_time_stepping !> Checks constraints on parameters related to 6-equation model - subroutine s_check_inputs_model_eqns + impure subroutine s_check_inputs_model_eqns @:PROHIBIT(model_eqns == 3 .and. avg_state /= 2, "6-equation model (model_eqns = 3) requires avg_state = 2") @:PROHIBIT(model_eqns == 3 .and. wave_speeds /= 1, "6-equation model (model_eqns = 3) requires wave_speeds = 1") end subroutine s_check_inputs_model_eqns !> Checks constraints for GRCBC - subroutine s_check_inputs_grcbc + impure subroutine s_check_inputs_grcbc #:for DIR in ['x', 'y', 'z'] @:PROHIBIT(bc_${DIR}$%grcbc_in .and. (bc_${DIR}$%beg /= -7 .and. bc_${DIR}$%end /= -7), "Subsonic Inflow requires bc = -7") @:PROHIBIT(bc_${DIR}$%grcbc_out .and. (bc_${DIR}$%beg /= -8 .and. bc_${DIR}$%end /= -8), "Subsonic Outflow requires bc = -8") @@ -134,7 +134,7 @@ contains end subroutine s_check_inputs_grcbc !> Checks constraints on acoustic_source parameters - subroutine s_check_inputs_acoustic_src + impure subroutine s_check_inputs_acoustic_src integer :: j, dim character(len=5) :: jStr @@ -261,12 +261,12 @@ contains end subroutine s_check_inputs_acoustic_src !> Checks constraints on hypoelasticity parameters - subroutine s_check_inputs_hypoelasticity + impure subroutine s_check_inputs_hypoelasticity @:PROHIBIT(hypoelasticity .and. riemann_solver /= 1, "hypoelasticity requires HLL Riemann solver (riemann_solver = 1)") end subroutine !> Checks constraints on bubble parameters - subroutine s_check_inputs_bubbles_euler + impure subroutine s_check_inputs_bubbles_euler @:PROHIBIT(bubbles_euler .and. bubbles_lagrange, "Activate only one of the bubble subgrid models") @:PROHIBIT(bubbles_euler .and. riemann_solver /= 2, "Bubble modeling requires HLLC Riemann solver (riemann_solver = 2)") @:PROHIBIT(bubbles_euler .and. avg_state /= 2, "Bubble modeling requires arithmetic average (avg_state = 2)") @@ -275,7 +275,7 @@ contains end subroutine s_check_inputs_bubbles_euler !> Checks constraints on adaptive time stepping parameters (adap_dt) - subroutine s_check_inputs_adapt_dt + impure subroutine s_check_inputs_adapt_dt @:PROHIBIT(adap_dt .and. time_stepper /= 3, "adapt_dt requires Runge-Kutta 3 (time_stepper = 3)") @:PROHIBIT(adap_dt .and. qbmm) @:PROHIBIT(adap_dt .and. (.not. polytropic) .and. (.not. bubbles_lagrange)) @@ -283,7 +283,7 @@ contains end subroutine s_check_inputs_adapt_dt !> Checks constraints on alternative sound speed parameters (alt_soundspeed) - subroutine s_check_inputs_alt_soundspeed + impure subroutine s_check_inputs_alt_soundspeed @:PROHIBIT(alt_soundspeed .and. model_eqns /= 2, "5-equation model (model_eqns = 2) is required for alt_soundspeed") @:PROHIBIT(alt_soundspeed .and. riemann_solver /= 2, "alt_soundspeed requires HLLC Riemann solver (riemann_solver = 2)") @:PROHIBIT(alt_soundspeed .and. num_fluids /= 2 .and. num_fluids /= 3) @@ -291,7 +291,7 @@ contains !> Checks constraints on viscosity parameters (fluid_pp(i)%Re(1:2)) !! of the stiffened gas equation of state - subroutine s_check_inputs_stiffened_eos_viscosity + impure subroutine s_check_inputs_stiffened_eos_viscosity character(len=5) :: iStr, jStr integer :: i, j @@ -318,7 +318,7 @@ contains end subroutine s_check_inputs_stiffened_eos_viscosity !> Checks constraints on body forces parameters (bf_x[y,z], etc.) - subroutine s_check_inputs_body_forces + impure subroutine s_check_inputs_body_forces #:for DIR in ['x', 'y', 'z'] @:PROHIBIT(bf_${DIR}$ .and. f_is_default(k_${DIR}$), "k_${DIR}$ must be specified if bf_${DIR}$ is true") @:PROHIBIT(bf_${DIR}$ .and. f_is_default(w_${DIR}$), "w_${DIR}$ must be specified if bf_${DIR}$ is true") @@ -328,7 +328,7 @@ contains end subroutine s_check_inputs_body_forces !> Checks constraints on lagrangian bubble parameters - subroutine s_check_inputs_bubbles_lagrange + impure subroutine s_check_inputs_bubbles_lagrange @:PROHIBIT(bubbles_lagrange .and. file_per_process, "file_per_process must be false for bubbles_lagrange") @:PROHIBIT(bubbles_lagrange .and. n==0, "bubbles_lagrange accepts 2D and 3D simulations only") @:PROHIBIT(bubbles_lagrange .and. model_eqns==3, "The 6-equation flow model does not support bubbles_lagrange") @@ -336,7 +336,7 @@ contains end subroutine s_check_inputs_bubbles_lagrange !> Checks constraints on continuum damage model parameters - subroutine s_check_inputs_continuum_damage + impure subroutine s_check_inputs_continuum_damage @:PROHIBIT(cont_damage .and. f_is_default(tau_star)) @:PROHIBIT(cont_damage .and. f_is_default(cont_damage_s)) @:PROHIBIT(cont_damage .and. f_is_default(alpha_bar)) @@ -344,12 +344,12 @@ contains !> Checks miscellaneous constraints, !! including constraints on probe_wrt and integral_wrt - subroutine s_check_inputs_misc + impure subroutine s_check_inputs_misc @:PROHIBIT(probe_wrt .and. fd_order == dflt_int, "fd_order must be specified for probe_wrt") @:PROHIBIT(integral_wrt .and. (.not. bubbles_euler)) end subroutine s_check_inputs_misc - subroutine s_check_inputs_mhd + impure subroutine s_check_inputs_mhd @:PROHIBIT(mhd .and. (riemann_solver /= 1 .and. riemann_solver /= 4), & "MHD simulations require riemann_solver = 1 (HLL) or riemann_solver = 4 (HLLD)") @:PROHIBIT(riemann_solver == 4 .and. .not. mhd, "HLLD is only available for MHD simulations") diff --git a/src/simulation/m_compute_cbc.fpp b/src/simulation/m_compute_cbc.fpp index dc0339ec17..275acb7f6f 100644 --- a/src/simulation/m_compute_cbc.fpp +++ b/src/simulation/m_compute_cbc.fpp @@ -23,7 +23,7 @@ contains !! Thompson (1990). At the slip wall (frictionless wall), !! the normal component of velocity is zero at all times, !! while the transverse velocities may be nonzero. - subroutine s_compute_slip_wall_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) + pure subroutine s_compute_slip_wall_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_compute_slip_wall_L #else @@ -53,7 +53,7 @@ contains !! see pg. 13 of Thompson (1987). The nonreflecting subsonic !! buffer reduces the amplitude of any reflections caused by !! outgoing waves. - subroutine s_compute_nonreflecting_subsonic_buffer_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds, dYs_ds) + pure subroutine s_compute_nonreflecting_subsonic_buffer_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds, dYs_ds) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_compute_nonreflecting_subsonic_buffer_L #else @@ -103,7 +103,7 @@ contains !! see pg. 455, Thompson (1990). This nonreflecting subsonic !! CBC assumes an incoming flow and reduces the amplitude of !! any reflections caused by outgoing waves. - subroutine s_compute_nonreflecting_subsonic_inflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) + pure subroutine s_compute_nonreflecting_subsonic_inflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_compute_nonreflecting_subsonic_inflow_L #else @@ -137,7 +137,7 @@ contains !! CBC see pg. 454 of Thompson (1990). This nonreflecting !! subsonic CBC presumes an outgoing flow and reduces the !! amplitude of any reflections caused by outgoing waves. - subroutine s_compute_nonreflecting_subsonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds, dYs_ds) + pure subroutine s_compute_nonreflecting_subsonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds, dYs_ds) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_compute_nonreflecting_subsonic_outflow_L #else @@ -186,7 +186,7 @@ contains !! direction to the boundary. As a result, a fluid element !! at the boundary is simply advected outward at the fluid !! velocity. - subroutine s_compute_force_free_subsonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) + pure subroutine s_compute_force_free_subsonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_compute_force_free_subsonic_outflow_L #else @@ -224,7 +224,7 @@ contains !! CBC see pg. 455 Thompson (1990). The constant pressure !! subsonic outflow maintains a fixed pressure at the CBC !! boundary in absence of any transverse effects. - subroutine s_compute_constant_pressure_subsonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) + pure subroutine s_compute_constant_pressure_subsonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_compute_constant_pressure_subsonic_outflow_L #else @@ -263,7 +263,7 @@ contains !! state, or nearly a steady state, CBC in which only the !! transverse terms may generate a time dependence at the !! inflow boundary. - subroutine s_compute_supersonic_inflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) + pure subroutine s_compute_supersonic_inflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_compute_supersonic_inflow_L #else @@ -294,7 +294,7 @@ contains !! of Thompson (1990). For the supersonic outflow CBC, the !! flow evolution at the boundary is determined completely !! by the interior data. - subroutine s_compute_supersonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds, dYs_ds) + pure subroutine s_compute_supersonic_outflow_L(lambda, L, rho, c, mf, dalpha_rho_ds, dpres_ds, dvel_ds, dadv_ds, dYs_ds) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_compute_supersonic_outflow_L #else diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 7255f68cea..b66e13d9c2 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -76,7 +76,7 @@ contains !! @param q_cons_vf Conservative variables !! @param q_prim_vf Primitive variables !! @param t_step Current time step - subroutine s_write_data_files(q_cons_vf, q_T_sf, q_prim_vf, t_step, beta) + impure subroutine s_write_data_files(q_cons_vf, q_T_sf, q_prim_vf, t_step, beta) type(scalar_field), & dimension(sys_size), & @@ -108,7 +108,7 @@ contains !! In general, this requires generating a table header for !! those stability criteria which will be written at every !! time-step. - subroutine s_open_run_time_information_file + impure subroutine s_open_run_time_information_file character(LEN=name_len), parameter :: file_name = 'run_time.inf' !< !! Name of the run-time information file @@ -169,7 +169,7 @@ contains !> This opens a formatted data file where the root processor !! can write out the CoM information - subroutine s_open_com_files() + impure subroutine s_open_com_files() character(len=path_len + 3*name_len) :: file_path !< !! Relative path to the CoM file in the case directory @@ -209,7 +209,7 @@ contains !> This opens a formatted data file where the root processor !! can write out flow probe information - subroutine s_open_probe_files + impure subroutine s_open_probe_files character(LEN=path_len + 3*name_len) :: file_path !< !! Relative path to the probe data file in the case directory @@ -259,7 +259,7 @@ contains !! these stability criteria extrema over all time-steps. !! @param q_prim_vf Cell-average primitive variables !! @param t_step Current time step - subroutine s_write_run_time_information(q_prim_vf, t_step) + impure subroutine s_write_run_time_information(q_prim_vf, t_step) type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf integer, intent(in) :: t_step @@ -388,7 +388,7 @@ contains !! @param q_cons_vf Cell-average conservative variables !! @param q_prim_vf Cell-average primitive variables !! @param t_step Current time-step - subroutine s_write_serial_data_files(q_cons_vf, q_T_sf, q_prim_vf, t_step, beta) + impure subroutine s_write_serial_data_files(q_cons_vf, q_T_sf, q_prim_vf, t_step, beta) type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf type(scalar_field), intent(inout) :: q_T_sf @@ -786,7 +786,7 @@ contains !! @param q_prim_vf Cell-average primitive variables !! @param t_step Current time-step !! @param beta Eulerian void fraction from lagrangian bubbles - subroutine s_write_parallel_data_files(q_cons_vf, q_prim_vf, t_step, beta) + impure subroutine s_write_parallel_data_files(q_cons_vf, q_prim_vf, t_step, beta) type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf @@ -990,7 +990,7 @@ contains !! @param t_step Current time-step !! @param q_com Center of mass information !! @param moments Higher moment information - subroutine s_write_com_files(t_step, c_mass) + impure subroutine s_write_com_files(t_step, c_mass) integer, intent(in) :: t_step real(wp), dimension(num_fluids, 5), intent(in) :: c_mass @@ -1041,7 +1041,7 @@ contains !! @param t_step Current time-step !! @param q_cons_vf Conservative variables !! @param accel_mag Acceleration magnitude information - subroutine s_write_probe_files(t_step, q_cons_vf, accel_mag) + impure subroutine s_write_probe_files(t_step, q_cons_vf, accel_mag) integer, intent(in) :: t_step type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf @@ -1707,7 +1707,7 @@ contains !! the current computation and to close the file when done. !! The footer contains the stability criteria extrema over !! all of the time-steps and the simulation run-time. - subroutine s_close_run_time_information_file + impure subroutine s_close_run_time_information_file real(wp) :: run_time !< Run-time of the simulation @@ -1729,7 +1729,7 @@ contains end subroutine s_close_run_time_information_file !> Closes communication files - subroutine s_close_com_files() + impure subroutine s_close_com_files() integer :: i !< Generic loop iterator do i = 1, num_fluids @@ -1739,7 +1739,7 @@ contains end subroutine s_close_com_files !> Closes probe files - subroutine s_close_probe_files + impure subroutine s_close_probe_files integer :: i !< Generic loop iterator @@ -1752,7 +1752,7 @@ contains !> The computation of parameters, the allocation of memory, !! the association of pointers and/or the execution of any !! other procedures that are necessary to setup the module. - subroutine s_initialize_data_output_module + impure subroutine s_initialize_data_output_module ! Allocating/initializing ICFL, VCFL, CCFL and Rc stability criteria @:ALLOCATE(icfl_sf(0:m, 0:n, 0:p)) @@ -1773,7 +1773,7 @@ contains end subroutine s_initialize_data_output_module !> Module deallocation and/or disassociation procedures - subroutine s_finalize_data_output_module + impure subroutine s_finalize_data_output_module if (probe_wrt) then @:DEALLOCATE(c_mass) diff --git a/src/simulation/m_derived_variables.f90 b/src/simulation/m_derived_variables.f90 index 26c4c67f4b..4e53547a9a 100644 --- a/src/simulation/m_derived_variables.f90 +++ b/src/simulation/m_derived_variables.f90 @@ -53,7 +53,7 @@ module m_derived_variables !> Computation of parameters, allocation procedures, and/or !! any other tasks needed to properly setup the module - subroutine s_initialize_derived_variables_module + impure subroutine s_initialize_derived_variables_module ! Allocating the variables which will store the coefficients of the ! centered family of finite-difference schemes. Note that sufficient @@ -86,7 +86,7 @@ subroutine s_initialize_derived_variables_module end subroutine s_initialize_derived_variables_module !> Allocate and open derived variables. Computing FD coefficients. - subroutine s_initialize_derived_variables + impure subroutine s_initialize_derived_variables if (probe_wrt) then ! Opening and writing header of flow probe files @@ -175,8 +175,8 @@ end subroutine s_compute_derived_variables !! @param q_prim_vf2 Primitive variables !! @param q_prim_vf3 Primitive variables !! @param q_sf Acceleration component - subroutine s_derive_acceleration_component(i, q_prim_vf0, q_prim_vf1, & - q_prim_vf2, q_prim_vf3, q_sf) + pure subroutine s_derive_acceleration_component(i, q_prim_vf0, q_prim_vf1, & + q_prim_vf2, q_prim_vf3, q_sf) !DIR$ INLINEALWAYS s_derive_acceleration_component integer, intent(in) :: i @@ -321,7 +321,7 @@ end subroutine s_derive_acceleration_component !! is then written to a formatted data file by the root process. !! @param q_prim_vf Primitive variables !! @param c_m Mass,x-location,y-location,z-location - subroutine s_derive_center_of_mass(q_vf, c_m) + impure subroutine s_derive_center_of_mass(q_vf, c_m) type(scalar_field), dimension(sys_size), intent(IN) :: q_vf real(wp), dimension(1:num_fluids, 1:5), intent(INOUT) :: c_m integer :: i, j, k, l !< Generic loop iterators @@ -457,7 +457,7 @@ subroutine s_derive_center_of_mass(q_vf, c_m) end subroutine s_derive_center_of_mass !> Deallocation procedures for the module - subroutine s_finalize_derived_variables_module + impure subroutine s_finalize_derived_variables_module ! Closing CoM and flow probe files if (proc_rank == 0) then diff --git a/src/simulation/m_fftw.fpp b/src/simulation/m_fftw.fpp index 4adae18b14..3c18a8c1fe 100644 --- a/src/simulation/m_fftw.fpp +++ b/src/simulation/m_fftw.fpp @@ -70,7 +70,7 @@ contains !> The purpose of this subroutine is to create the fftw plan !! that will be used in the forward and backward DFTs when !! applying the Fourier filter in the azimuthal direction. - subroutine s_initialize_fftw_module + impure subroutine s_initialize_fftw_module ! Size of input array going into DFT real_size = p + 1 @@ -128,7 +128,7 @@ contains !! to remove the high-frequency content. This alleviates the !! restrictive CFL condition arising from cells near the axis. !! @param q_cons_vf Conservative variables - subroutine s_apply_fourier_filter(q_cons_vf) + impure 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(:) @@ -299,7 +299,7 @@ contains !> The purpose of this subroutine is to destroy the fftw plan !! that will be used in the forward and backward DFTs when !! applying the Fourier filter in the azimuthal direction. - subroutine s_finalize_fftw_module + impure subroutine s_finalize_fftw_module #if defined(MFC_OpenACC) @:DEALLOCATE(data_real_gpu, data_fltr_cmplx_gpu, data_cmplx_gpu) diff --git a/src/simulation/m_global_parameters.fpp b/src/simulation/m_global_parameters.fpp index bbe74fc268..d0b94f6b7a 100644 --- a/src/simulation/m_global_parameters.fpp +++ b/src/simulation/m_global_parameters.fpp @@ -504,7 +504,7 @@ contains !> Assigns default values to the user inputs before reading !! them in. This enables for an easier consistency check of !! these parameters once they are read from the input file. - subroutine s_assign_default_values_to_user_inputs + impure subroutine s_assign_default_values_to_user_inputs integer :: i, j !< Generic loop iterator @@ -776,7 +776,7 @@ contains !> The computation of parameters, the allocation of memory, !! the association of pointers and/or the execution of any !! other procedures that are necessary to setup the module. - subroutine s_initialize_global_parameters_module + impure subroutine s_initialize_global_parameters_module integer :: i, j, k integer :: fac @@ -1259,7 +1259,7 @@ contains end subroutine s_initialize_global_parameters_module !> Initializes parallel infrastructure - subroutine s_initialize_parallel_io + impure subroutine s_initialize_parallel_io #:if not MFC_CASE_OPTIMIZATION num_dims = 1 + min(1, n) + min(1, p) @@ -1296,7 +1296,7 @@ contains end subroutine s_initialize_parallel_io !> Module deallocation and/or disassociation procedures - subroutine s_finalize_global_parameters_module + impure subroutine s_finalize_global_parameters_module integer :: i diff --git a/src/simulation/m_hyperelastic.fpp b/src/simulation/m_hyperelastic.fpp index 46addb7685..be79e98232 100644 --- a/src/simulation/m_hyperelastic.fpp +++ b/src/simulation/m_hyperelastic.fpp @@ -45,7 +45,7 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_initialize_hyperelastic_module + impure subroutine s_initialize_hyperelastic_module integer :: i !< generic iterator @:ALLOCATE(btensor%vf(1:b_size)) @@ -219,7 +219,7 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) + pure subroutine s_neoHookean_cauchy_solver(btensor, q_prim_vf, G, j, k, l) !$acc routine seq type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor @@ -258,7 +258,7 @@ contains !! calculate the inverse of grad_xi to obtain F, F is a nxn tensor !! calculate the FFtranspose to obtain the btensor, btensor is nxn tensor !! btensor is symmetric, save the data space - subroutine s_Mooney_Rivlin_cauchy_solver(btensor, q_prim_vf, G, j, k, l) + pure subroutine s_Mooney_Rivlin_cauchy_solver(btensor, q_prim_vf, G, j, k, l) !$acc routine seq type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf type(scalar_field), dimension(b_size), intent(inout) :: btensor @@ -291,7 +291,7 @@ contains end subroutine s_Mooney_Rivlin_cauchy_solver - subroutine s_finalize_hyperelastic_module() + impure subroutine s_finalize_hyperelastic_module() integer :: i !< iterator diff --git a/src/simulation/m_hypoelastic.fpp b/src/simulation/m_hypoelastic.fpp index 3913cc8313..56f36e7ca3 100644 --- a/src/simulation/m_hypoelastic.fpp +++ b/src/simulation/m_hypoelastic.fpp @@ -37,7 +37,7 @@ module m_hypoelastic contains - subroutine s_initialize_hypoelastic_module + impure subroutine s_initialize_hypoelastic_module integer :: i @@ -370,7 +370,7 @@ contains end subroutine s_compute_hypoelastic_rhs - subroutine s_finalize_hypoelastic_module() + impure subroutine s_finalize_hypoelastic_module() @:DEALLOCATE(Gs) @:DEALLOCATE(rho_K_field, G_K_field) @@ -387,7 +387,7 @@ contains end subroutine s_finalize_hypoelastic_module - subroutine s_compute_damage_state(q_cons_vf, rhs_vf) + pure subroutine s_compute_damage_state(q_cons_vf, rhs_vf) type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp index 70e184ac30..420a024545 100644 --- a/src/simulation/m_ibm.fpp +++ b/src/simulation/m_ibm.fpp @@ -48,7 +48,7 @@ module m_ibm contains !> Allocates memory for the variables in the IBM module - subroutine s_initialize_ibm_module() + impure subroutine s_initialize_ibm_module() if (p > 0) then @:ALLOCATE(ib_markers%sf(-gp_layers:m+gp_layers, & @@ -76,7 +76,7 @@ contains !> Initializes the values of various IBM variables, such as ghost points and !! image points. - subroutine s_ibm_setup() + impure subroutine s_ibm_setup() integer :: i, j, k @@ -89,7 +89,7 @@ contains !$acc update host(ib_markers%sf) - call s_find_num_ghost_points() + call s_find_num_ghost_points(num_gps, num_inner_gps) !$acc update device(num_gps, num_inner_gps) @:ALLOCATE(ghost_points(1:num_gps)) @@ -113,7 +113,7 @@ contains !! @param q_prim_vf Primitive variables !! @param pb Internal bubble pressure !! @param mv Mass of vapor in bubble - subroutine s_ibm_correct_state(q_cons_vf, q_prim_vf, pb, mv) + pure subroutine s_ibm_correct_state(q_cons_vf, q_prim_vf, pb, mv) type(scalar_field), & dimension(sys_size), & @@ -342,7 +342,7 @@ contains !! @param ghost_points Ghost Points !! @param levelset Closest distance from each grid cell to IB !! @param levelset_norm Vector pointing in the direction of the closest distance - subroutine s_compute_image_points(ghost_points, levelset, levelset_norm) + impure subroutine s_compute_image_points(ghost_points, levelset, levelset_norm) type(ghost_point), dimension(num_gps), intent(INOUT) :: ghost_points type(levelset_field), intent(IN) :: levelset @@ -426,7 +426,11 @@ contains !> Function that finds the number of ghost points, used for allocating !! memory. - subroutine s_find_num_ghost_points() + pure subroutine s_find_num_ghost_points(num_gps, num_inner_gps) + + integer, intent(out) :: num_gps + integer, intent(out) :: num_inner_gps + integer, dimension(2*gp_layers + 1, 2*gp_layers + 1) & :: subsection_2D integer, dimension(2*gp_layers + 1, 2*gp_layers + 1, 2*gp_layers + 1) & @@ -470,7 +474,7 @@ contains end subroutine s_find_num_ghost_points !> Function that finds the ghost points - subroutine s_find_ghost_points(ghost_points, inner_points) + pure subroutine s_find_ghost_points(ghost_points, inner_points) type(ghost_point), dimension(num_gps), intent(INOUT) :: ghost_points type(ghost_point), dimension(num_inner_gps), intent(INOUT) :: inner_points @@ -585,7 +589,7 @@ contains end subroutine s_find_ghost_points !> Function that computes the interpolation coefficients of image points - subroutine s_compute_interpolation_coeffs(ghost_points) + pure subroutine s_compute_interpolation_coeffs(ghost_points) type(ghost_point), dimension(num_gps), intent(INOUT) :: ghost_points @@ -739,7 +743,7 @@ contains !> Function that uses the interpolation coefficients and the current state !! at the cell centers in order to estimate the state at the image point - subroutine s_interpolate_image_point(q_prim_vf, gp, alpha_rho_IP, alpha_IP, pres_IP, vel_IP, c_IP, r_IP, v_IP, pb_IP, mv_IP, nmom_IP, pb, mv, presb_IP, massv_IP) + pure subroutine s_interpolate_image_point(q_prim_vf, gp, alpha_rho_IP, alpha_IP, pres_IP, vel_IP, c_IP, r_IP, v_IP, pb_IP, mv_IP, nmom_IP, pb, mv, presb_IP, massv_IP) !$acc routine seq type(scalar_field), & dimension(sys_size), & @@ -860,7 +864,7 @@ contains end subroutine s_interpolate_image_point !> Subroutine to deallocate memory reserved for the IBM module - subroutine s_finalize_ibm_module() + impure subroutine s_finalize_ibm_module() @:DEALLOCATE(ib_markers%sf) @:DEALLOCATE(levelset%sf) diff --git a/src/simulation/m_mhd.fpp b/src/simulation/m_mhd.fpp index 49b1639391..f5730b513f 100644 --- a/src/simulation/m_mhd.fpp +++ b/src/simulation/m_mhd.fpp @@ -33,7 +33,7 @@ module m_mhd contains - subroutine s_initialize_mhd_powell_module + impure subroutine s_initialize_mhd_powell_module ! Additional safety check beyond m_checker if (n == 0) call s_mpi_abort('Fatal Error: Powell correction is not applicable for 1D') @@ -67,7 +67,7 @@ contains !! S = - (divB) [ 0, Bx, By, Bz, vdotB, vx, vy, vz ]^T !! @param q_prim_vf Primitive variables !! @param rhs_vf rhs variables - subroutine s_compute_mhd_powell_rhs(q_prim_vf, rhs_vf) + pure subroutine s_compute_mhd_powell_rhs(q_prim_vf, rhs_vf) type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf @@ -134,7 +134,7 @@ contains end subroutine s_compute_mhd_powell_rhs - subroutine s_finalize_mhd_powell_module + impure subroutine s_finalize_mhd_powell_module @:DEALLOCATE(du_dx, dv_dx, dw_dx) @:DEALLOCATE(fd_coeff_x_h) diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index 27e3beae49..f931227f4d 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -55,7 +55,7 @@ contains !! available to the other processors. Then, the purpose of !! this subroutine is to distribute the user inputs to the !! remaining processors in the communicator. - subroutine s_mpi_bcast_user_inputs() + impure subroutine s_mpi_bcast_user_inputs() #ifdef MFC_MPI @@ -213,7 +213,7 @@ contains !! in each of the coordinate directions, approximately the !! same number of cells, and then recomputing the affected !! global parameters. - subroutine s_mpi_decompose_computational_domain + impure subroutine s_mpi_decompose_computational_domain #ifdef MFC_MPI @@ -586,7 +586,7 @@ contains !! directly from those of the cell-width distributions. !! @param mpi_dir MPI communication coordinate direction !! @param pbc_loc Processor boundary condition (PBC) location - subroutine s_mpi_sendrecv_grid_variables_buffers(mpi_dir, pbc_loc) + impure subroutine s_mpi_sendrecv_grid_variables_buffers(mpi_dir, pbc_loc) integer, intent(in) :: mpi_dir integer, intent(in) :: pbc_loc @@ -764,7 +764,7 @@ contains !> The goal of this procedure is to populate the buffers of !! the cell-average conservative variables by communicating !! with the neighboring processors. - subroutine s_mpi_sendrecv_ib_buffers(ib_markers, gp_layers) + impure subroutine s_mpi_sendrecv_ib_buffers(ib_markers, gp_layers) type(integer_field), intent(inout) :: ib_markers integer, intent(in) :: gp_layers @@ -1610,7 +1610,7 @@ contains end subroutine s_mpi_sendrecv_ib_buffers - subroutine s_mpi_send_random_number(phi_rn, num_freq) + impure subroutine s_mpi_send_random_number(phi_rn, num_freq) integer, intent(in) :: num_freq real(wp), intent(inout), dimension(1:num_freq) :: phi_rn #ifdef MFC_MPI diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp index c93a4be2f7..1c52cee2fa 100644 --- a/src/simulation/m_qbmm.fpp +++ b/src/simulation/m_qbmm.fpp @@ -43,7 +43,7 @@ module m_qbmm contains - subroutine s_initialize_qbmm_module + impure subroutine s_initialize_qbmm_module integer :: i1, i2, q, i, j @@ -411,7 +411,7 @@ contains end subroutine s_initialize_qbmm_module - subroutine s_compute_qbmm_rhs(idir, q_cons_vf, q_prim_vf, rhs_vf, flux_n_vf, pb, rhs_pb, mv, rhs_mv) + pure subroutine s_compute_qbmm_rhs(idir, q_cons_vf, q_prim_vf, rhs_vf, flux_n_vf, pb, rhs_pb, mv, rhs_mv) integer, intent(in) :: idir type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf, q_prim_vf @@ -679,7 +679,7 @@ contains !Coefficient array for non-polytropic model (pb and mv values are accounted in wght_pb and wght_mv) - subroutine s_coeff_nonpoly(pres, rho, c, coeffs) + pure subroutine s_coeff_nonpoly(pres, rho, c, coeffs) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_coeff_nonpoly #else @@ -752,7 +752,7 @@ contains end subroutine s_coeff_nonpoly !Coefficient array for polytropic model (pb for each R0 bin accounted for in wght_pb) - subroutine s_coeff(pres, rho, c, coeffs) + pure subroutine s_coeff(pres, rho, c, coeffs) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_coeff #else @@ -1030,7 +1030,7 @@ contains end subroutine s_mom_inv - subroutine s_chyqmom(momin, wght, abscX, abscY) + pure subroutine s_chyqmom(momin, wght, abscX, abscY) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_chyqmom #else @@ -1097,7 +1097,7 @@ contains end subroutine s_chyqmom - subroutine s_hyqmom(frho, fup, fmom) + pure subroutine s_hyqmom(frho, fup, fmom) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_hyqmom #else @@ -1119,7 +1119,7 @@ contains end subroutine s_hyqmom - function f_quad(abscX, abscY, wght_in, q, r, s) + pure function f_quad(abscX, abscY, wght_in, q, r, s) !$acc routine seq real(wp), dimension(nnode, nb), intent(in) :: abscX, abscY, wght_in real(wp), intent(in) :: q, r, s @@ -1135,7 +1135,7 @@ contains end function f_quad - function f_quad2D(abscX, abscY, wght_in, pow) + pure function f_quad2D(abscX, abscY, wght_in, pow) !$acc routine seq real(wp), dimension(nnode), intent(in) :: abscX, abscY, wght_in real(wp), dimension(3), intent(in) :: pow diff --git a/src/simulation/m_rhs.fpp b/src/simulation/m_rhs.fpp index 7ab49b4aec..deb869c11b 100644 --- a/src/simulation/m_rhs.fpp +++ b/src/simulation/m_rhs.fpp @@ -172,7 +172,7 @@ contains !> The computation of parameters, the allocation of memory, !! the association of pointers and/or the execution of any !! other procedures that are necessary to setup the module. - subroutine s_initialize_rhs_module + impure subroutine s_initialize_rhs_module integer :: i, j, k, l, id !< Generic loop iterators @@ -611,7 +611,7 @@ contains end subroutine s_initialize_rhs_module - subroutine s_compute_rhs(q_cons_vf, q_T_sf, q_prim_vf, bc_type, rhs_vf, pb, rhs_pb, mv, rhs_mv, t_step, time_avg, stage) + impure subroutine s_compute_rhs(q_cons_vf, q_T_sf, q_prim_vf, bc_type, rhs_vf, pb, rhs_pb, mv, rhs_mv, t_step, time_avg, stage) type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf type(scalar_field), intent(inout) :: q_T_sf @@ -838,7 +838,7 @@ contains ! RHS additions for sub-grid bubbles_euler if (bubbles_euler) then call nvtxStartRange("RHS-BUBBLES-COMPUTE") - call s_compute_bubbles_EE_rhs(id, q_prim_qp%vf) + call s_compute_bubbles_EE_rhs(id, q_prim_qp%vf, divu) call nvtxEndRange end if @@ -1657,7 +1657,7 @@ contains !! purpose, this pressure is finally corrected using the !! mixture-total-energy equation. !! @param q_cons_vf Cell-average conservative variables - subroutine s_pressure_relaxation_procedure(q_cons_vf) + pure subroutine s_pressure_relaxation_procedure(q_cons_vf) type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf @@ -2038,7 +2038,7 @@ contains end subroutine s_reconstruct_cell_boundary_values_first_order !> Module deallocation and/or disassociation procedures - subroutine s_finalize_rhs_module + impure subroutine s_finalize_rhs_module integer :: i, j, l diff --git a/src/simulation/m_riemann_solvers.fpp b/src/simulation/m_riemann_solvers.fpp index 8dcd4e808c..52a4640524 100644 --- a/src/simulation/m_riemann_solvers.fpp +++ b/src/simulation/m_riemann_solvers.fpp @@ -202,17 +202,17 @@ contains !! For more information please refer to: !! 1) s_compute_cartesian_viscous_source_flux !! 2) s_compute_cylindrical_viscous_source_flux - subroutine s_compute_viscous_source_flux(velL_vf, & - dvelL_dx_vf, & - dvelL_dy_vf, & - dvelL_dz_vf, & - velR_vf, & - dvelR_dx_vf, & - dvelR_dy_vf, & - dvelR_dz_vf, & - flux_src_vf, & - norm_dir, & - ix, iy, iz) + pure subroutine s_compute_viscous_source_flux(velL_vf, & + dvelL_dx_vf, & + dvelL_dy_vf, & + dvelL_dz_vf, & + velR_vf, & + dvelR_dx_vf, & + dvelR_dy_vf, & + dvelR_dz_vf, & + flux_src_vf, & + norm_dir, & + ix, iy, iz) type(scalar_field), & dimension(num_vels), & @@ -3311,7 +3311,7 @@ contains !> The computation of parameters, the allocation of memory, !! the association of pointers and/or the execution of any !! other procedures that are necessary to setup the module. - subroutine s_initialize_riemann_solvers_module + impure subroutine s_initialize_riemann_solvers_module ! Allocating the variables that will be utilized to formulate the ! left, right, and average states of the Riemann problem, as well @@ -3957,11 +3957,11 @@ contains !! @param[in] ix Global X-direction loop bounds (int_bounds_info). !! @param[in] iy Global Y-direction loop bounds (int_bounds_info). !! @param[in] iz Global Z-direction loop bounds (int_bounds_info). - subroutine s_compute_cylindrical_viscous_source_flux(velL_vf, & - dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, & - velR_vf, & - dvelR_dx_vf, dvelR_dy_vf, dvelR_dz_vf, & - flux_src_vf, norm_dir, ix, iy, iz) + pure subroutine s_compute_cylindrical_viscous_source_flux(velL_vf, & + dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, & + velR_vf, & + dvelR_dx_vf, dvelR_dy_vf, dvelR_dz_vf, & + flux_src_vf, norm_dir, ix, iy, iz) type(scalar_field), dimension(num_dims), intent(in) :: velL_vf, velR_vf type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf @@ -4119,17 +4119,17 @@ contains !! @param[in] ix X-direction loop bounds (int_bounds_info). !! @param[in] iy Y-direction loop bounds (int_bounds_info). !! @param[in] iz Z-direction loop bounds (int_bounds_info). - subroutine s_compute_cartesian_viscous_source_flux(velL_vf, & - dvelL_dx_vf, & - dvelL_dy_vf, & - dvelL_dz_vf, & - velR_vf, & - dvelR_dx_vf, & - dvelR_dy_vf, & - dvelR_dz_vf, & - flux_src_vf, & - norm_dir, & - ix, iy, iz) + pure subroutine s_compute_cartesian_viscous_source_flux(velL_vf, & + dvelL_dx_vf, & + dvelL_dy_vf, & + dvelL_dz_vf, & + velR_vf, & + dvelR_dx_vf, & + dvelR_dy_vf, & + dvelR_dz_vf, & + flux_src_vf, & + norm_dir, & + ix, iy, iz) ! Arguments type(scalar_field), dimension(num_dims), intent(in) :: velL_vf, velR_vf @@ -4212,7 +4212,7 @@ contains end if if (shear_stress) then - current_tau_shear = 0.0_wp + ! current_tau_shear = 0.0_wp call s_calculate_shear_stress_tensor(vel_grad_avg, Re_shear, divergence_v, current_tau_shear) do i_dim = 1, num_dims @@ -4226,7 +4226,7 @@ contains end if if (bulk_stress) then - current_tau_bulk = 0.0_wp + ! current_tau_bulk = 0.0_wp call s_calculate_bulk_stress_tensor(Re_bulk, divergence_v, current_tau_bulk) do i_dim = 1, num_dims @@ -4252,7 +4252,7 @@ contains !! @param[in] Re_shear Shear Reynolds number. !! @param[in] divergence_v Velocity divergence (du/dx + dv/dy + dw/dz). !! @param[out] tau_shear_out Calculated shear stress tensor (stress on i-face, j-direction). - subroutine s_calculate_shear_stress_tensor(vel_grad_avg, Re_shear, divergence_v, tau_shear_out) + pure subroutine s_calculate_shear_stress_tensor(vel_grad_avg, Re_shear, divergence_v, tau_shear_out) !$acc routine seq implicit none @@ -4286,7 +4286,7 @@ contains !! @param[in] Re_bulk Bulk Reynolds number. !! @param[in] divergence_v Velocity divergence (du/dx + dv/dy + dw/dz). !! @param[out] tau_bulk_out Calculated bulk stress tensor (stress on i-face, i-direction). - subroutine s_calculate_bulk_stress_tensor(Re_bulk, divergence_v, tau_bulk_out) + pure subroutine s_calculate_bulk_stress_tensor(Re_bulk, divergence_v, tau_bulk_out) !$acc routine seq implicit none @@ -4316,9 +4316,9 @@ contains !! @param ix Index bounds in first coordinate direction !! @param iy Index bounds in second coordinate direction !! @param iz Index bounds in third coordinate direction - subroutine s_finalize_riemann_solver(flux_vf, flux_src_vf, & - flux_gsrc_vf, & - norm_dir, ix, iy, iz) + pure subroutine s_finalize_riemann_solver(flux_vf, flux_src_vf, & + flux_gsrc_vf, & + norm_dir, ix, iy, iz) type(scalar_field), & dimension(sys_size), & @@ -4475,7 +4475,7 @@ contains end subroutine s_finalize_riemann_solver !> Module deallocation and/or disassociation procedures - subroutine s_finalize_riemann_solvers_module + impure subroutine s_finalize_riemann_solvers_module if (viscous) then @:DEALLOCATE(Re_avg_rsx_vf) diff --git a/src/simulation/m_sim_helpers.f90 b/src/simulation/m_sim_helpers.f90 index 4d525cf5d9..64960b1353 100644 --- a/src/simulation/m_sim_helpers.f90 +++ b/src/simulation/m_sim_helpers.f90 @@ -29,7 +29,7 @@ module m_sim_helpers !! @param j x index !! @param k y index !! @param l z index - subroutine s_compute_enthalpy(q_prim_vf, pres, rho, gamma, pi_inf, Re, H, alpha, vel, vel_sum, j, k, l) + pure subroutine s_compute_enthalpy(q_prim_vf, pres, rho, gamma, pi_inf, Re, H, alpha, vel, vel_sum, j, k, l) #ifdef _CRAYFTN !DIR$ INLINEALWAYS s_compute_enthalpy #else @@ -97,7 +97,7 @@ end subroutine s_compute_enthalpy !! @param icfl_sf cell centered inviscid cfl number !! @param vcfl_sf (optional) cell centered viscous cfl number !! @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) + pure subroutine s_compute_stability_from_dt(vel, c, rho, Re_l, j, k, l, icfl_sf, vcfl_sf, Rc_sf) !$acc routine seq real(wp), intent(in), dimension(num_vels) :: vel real(wp), intent(in) :: c, rho @@ -194,7 +194,7 @@ end subroutine s_compute_stability_from_dt !! @param j x coordinate !! @param k y coordinate !! @param l z coordinate - subroutine s_compute_dt_from_cfl(vel, c, max_dt, rho, Re_l, j, k, l) + pure subroutine s_compute_dt_from_cfl(vel, c, max_dt, rho, Re_l, j, k, l) !$acc routine seq real(wp), dimension(num_vels), intent(in) :: vel real(wp), intent(in) :: c, rho @@ -268,9 +268,9 @@ subroutine s_compute_dt_from_cfl(vel, c, max_dt, rho, Re_l, j, k, l) end subroutine s_compute_dt_from_cfl - subroutine s_assign_default_bc_type(bc_type) + pure subroutine s_assign_default_bc_type(bc_type) - type(integer_field), dimension(1:num_dims, -1:1), intent(in) :: bc_type + type(integer_field), dimension(1:num_dims, -1:1), intent(inout) :: bc_type bc_type(1, -1)%sf(:, :, :) = bc_x%beg bc_type(1, 1)%sf(:, :, :) = bc_x%end diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index a5120c76a1..bf1d429714 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -112,7 +112,7 @@ contains !> Read data files. Dispatch subroutine that replaces procedure pointer. !! @param q_cons_vf Conservative variables - subroutine s_read_data_files(q_cons_vf) + impure subroutine s_read_data_files(q_cons_vf) type(scalar_field), & dimension(sys_size), & @@ -130,7 +130,7 @@ contains !> The purpose of this procedure is to first verify that an !! input file has been made available by the user. Provided !! that this is so, the input file is then read in. - subroutine s_read_input_file + impure subroutine s_read_input_file ! Relative path to the input file provided by the user character(LEN=name_len), parameter :: file_path = './simulation.inp' @@ -228,7 +228,7 @@ contains !> The goal of this procedure is to verify that each of the !! user provided inputs is valid and that their combination !! constitutes a meaningful configuration for the simulation. - subroutine s_check_input_file + impure subroutine s_check_input_file ! Relative path to the current directory file in the case directory character(LEN=path_len) :: file_path @@ -256,7 +256,7 @@ contains !! up the latter. This procedure also calculates the cell- !! width distributions from the cell-boundary locations. !! @param q_cons_vf Cell-averaged conservative variables - subroutine s_read_serial_data_files(q_cons_vf) + impure subroutine s_read_serial_data_files(q_cons_vf) type(scalar_field), dimension(sys_size), intent(INOUT) :: q_cons_vf @@ -501,7 +501,7 @@ contains end subroutine s_read_serial_data_files !! @param q_cons_vf Conservative variables - subroutine s_read_parallel_data_files(q_cons_vf) + impure subroutine s_read_parallel_data_files(q_cons_vf) type(scalar_field), & dimension(sys_size), & @@ -963,7 +963,7 @@ contains !! of the grid variables, which are constituted of the cell- !! boundary locations and cell-width distributions, based on !! the boundary conditions. - subroutine s_populate_grid_variables_buffers + impure subroutine s_populate_grid_variables_buffers integer :: i !< Generic loop iterator @@ -1239,7 +1239,7 @@ contains end subroutine s_initialize_internal_energy_equations - 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) + impure 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(wp), intent(inout) :: time_avg, time_final real(wp), intent(inout) :: io_time_avg, io_time_final @@ -1329,7 +1329,7 @@ contains end subroutine s_perform_time_step - subroutine s_save_performance_metrics(t_step, time_avg, time_final, io_time_avg, io_time_final, proc_time, io_proc_time, file_exists, start, finish, nt) + impure 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(wp), intent(inout) :: time_avg, time_final @@ -1391,7 +1391,7 @@ contains end subroutine s_save_performance_metrics - subroutine s_save_data(t_step, start, finish, io_time_avg, nt) + impure subroutine s_save_data(t_step, start, finish, io_time_avg, nt) integer, intent(inout) :: t_step real(wp), intent(inout) :: start, finish, io_time_avg integer, intent(inout) :: nt @@ -1460,12 +1460,12 @@ contains end subroutine s_save_data - subroutine s_initialize_modules + impure subroutine s_initialize_modules call s_initialize_global_parameters_module() !Quadrature weights and nodes for polydisperse simulations if (bubbles_euler .and. nb > 1 .and. R0_type == 1) then - call s_simpson + call s_simpson(weight, R0) end if !Initialize variables for non-polytropic (Preston) model if (bubbles_euler .and. .not. polytropic) then @@ -1558,7 +1558,7 @@ contains end subroutine s_initialize_modules - subroutine s_initialize_mpi_domain + impure subroutine s_initialize_mpi_domain integer :: ierr #ifdef MFC_OpenACC real(wp) :: starttime, endtime @@ -1669,7 +1669,7 @@ contains end if end subroutine s_initialize_gpu_vars - subroutine s_finalize_modules + impure subroutine s_finalize_modules call s_finalize_time_steppers_module() if (hypoelasticity) call s_finalize_hypoelastic_module() diff --git a/src/simulation/m_surface_tension.fpp b/src/simulation/m_surface_tension.fpp index f46c5243e7..8dac00ee39 100644 --- a/src/simulation/m_surface_tension.fpp +++ b/src/simulation/m_surface_tension.fpp @@ -40,11 +40,11 @@ module m_surface_tension type(int_bounds_info) :: is1, is2, is3, iv !$acc declare create(is1, is2, is3, iv) - integer :: j, k, l, i - contains - subroutine s_initialize_surface_tension_module + impure subroutine s_initialize_surface_tension_module + + integer :: j @:ALLOCATE(c_divs(1:num_dims + 1)) @@ -65,10 +65,10 @@ contains end if end subroutine s_initialize_surface_tension_module - subroutine s_compute_capilary_source_flux(q_prim_vf, & - vSrc_rsx_vf, vSrc_rsy_vf, vSrc_rsz_vf, & - flux_src_vf, & - id, isx, isy, isz) + pure subroutine s_compute_capilary_source_flux(q_prim_vf, & + vSrc_rsx_vf, vSrc_rsy_vf, vSrc_rsz_vf, & + flux_src_vf, & + id, isx, isy, isz) type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf real(wp), dimension(-1:, 0:, 0:, 1:), intent(in) :: vSrc_rsx_vf @@ -83,6 +83,7 @@ contains real(wp), dimension(num_dims, num_dims) :: Omega real(wp) :: w1L, w1R, w2L, w2R, w3L, w3R, w1, w2, w3 real(wp) :: normWL, normWR, normW + integer :: j, k, l, i if (id == 1) then !$acc parallel loop collapse(3) gang vector default(present) private(Omega, & @@ -225,12 +226,13 @@ contains end subroutine s_compute_capilary_source_flux - subroutine s_get_capilary(q_prim_vf, bc_type) + impure subroutine s_get_capilary(q_prim_vf, bc_type) type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf type(integer_field), dimension(1:num_dims, -1:1), intent(in) :: bc_type type(int_bounds_info) :: isx, isy, isz + integer :: j, k, l, i isx%beg = -1; isy%beg = 0; isz%beg = 0 @@ -376,7 +378,8 @@ contains end subroutine s_reconstruct_cell_boundary_values_capillary - subroutine s_finalize_surface_tension_module + impure subroutine s_finalize_surface_tension_module + integer :: j do j = 1, num_dims @:DEALLOCATE(c_divs(j)%sf) diff --git a/src/simulation/m_time_steppers.fpp b/src/simulation/m_time_steppers.fpp index 81824587c1..7dd75f7486 100644 --- a/src/simulation/m_time_steppers.fpp +++ b/src/simulation/m_time_steppers.fpp @@ -82,7 +82,7 @@ contains !> The computation of parameters, the allocation of memory, !! the association of pointers and/or the execution of any !! other procedures that are necessary to setup the module. - subroutine s_initialize_time_steppers_module + impure subroutine s_initialize_time_steppers_module integer :: i, j !< Generic loop iterators @@ -341,7 +341,7 @@ contains !> 1st order TVD RK time-stepping algorithm !! @param t_step Current time step - subroutine s_1st_order_tvd_rk(t_step, time_avg) + impure subroutine s_1st_order_tvd_rk(t_step, time_avg) integer, intent(in) :: t_step real(wp), intent(inout) :: time_avg @@ -447,7 +447,7 @@ contains !> 2nd order TVD RK time-stepping algorithm !! @param t_step Current time-step - subroutine s_2nd_order_tvd_rk(t_step, time_avg) + impure subroutine s_2nd_order_tvd_rk(t_step, time_avg) integer, intent(in) :: t_step real(wp), intent(inout) :: time_avg @@ -627,7 +627,7 @@ contains !> 3rd order TVD RK time-stepping algorithm !! @param t_step Current time-step - subroutine s_3rd_order_tvd_rk(t_step, time_avg) + impure subroutine s_3rd_order_tvd_rk(t_step, time_avg) integer, intent(IN) :: t_step real(wp), intent(INOUT) :: time_avg @@ -920,7 +920,7 @@ contains !> Bubble source part in Strang operator splitting scheme !! @param t_step Current time-step - subroutine s_adaptive_dt_bubble(t_step, stage) + impure subroutine s_adaptive_dt_bubble(t_step, stage) integer, intent(in) :: t_step, stage @@ -957,7 +957,7 @@ contains end subroutine s_adaptive_dt_bubble - subroutine s_compute_dt() + impure subroutine s_compute_dt() real(wp) :: rho !< Cell-avg. density real(wp), dimension(num_vels) :: vel !< Cell-avg. velocity @@ -1081,7 +1081,7 @@ contains end subroutine s_time_step_cycling !> Module deallocation and/or disassociation procedures - subroutine s_finalize_time_steppers_module + impure subroutine s_finalize_time_steppers_module integer :: i, j !< Generic loop iterators diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp index a56143a1aa..615448e0d3 100644 --- a/src/simulation/m_viscous.fpp +++ b/src/simulation/m_viscous.fpp @@ -31,7 +31,7 @@ module m_viscous contains - subroutine s_initialize_viscous_module + impure subroutine s_initialize_viscous_module integer :: i, j !< generic loop iterators @@ -1455,7 +1455,7 @@ contains end subroutine s_compute_fd_gradient - subroutine s_finalize_viscous_module() + impure subroutine s_finalize_viscous_module() @:DEALLOCATE(Res_viscous) diff --git a/src/simulation/m_weno.fpp b/src/simulation/m_weno.fpp index 2071b3a0f0..39e0b281a8 100644 --- a/src/simulation/m_weno.fpp +++ b/src/simulation/m_weno.fpp @@ -109,7 +109,7 @@ contains !> The computation of parameters, the allocation of memory, !! the association of pointers and/or the execution of any !! other procedures that are necessary to setup the module. - subroutine s_initialize_weno_module + impure subroutine s_initialize_weno_module if (weno_order == 1) return @@ -1235,7 +1235,7 @@ contains !! @param j First-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) + pure subroutine s_preserve_monotonicity(v_rs_ws, vL_rs_vf, vR_rs_vf) real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(IN) :: v_rs_ws real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(INOUT) :: vL_rs_vf, vR_rs_vf @@ -1399,7 +1399,7 @@ contains end subroutine s_preserve_monotonicity !> Module deallocation and/or disassociation procedures - subroutine s_finalize_weno_module() + impure subroutine s_finalize_weno_module() if (weno_order == 1) return