diff --git a/.github/workflows/lint-source.yml b/.github/workflows/lint-source.yml index aefd5495a..0b8a2bca8 100644 --- a/.github/workflows/lint-source.yml +++ b/.github/workflows/lint-source.yml @@ -29,11 +29,14 @@ jobs: run: pip install fortitude-lint ansi2txt - name: Lint the source code - run: fortitude check --file-extensions=f90,fpp,fypp --ignore=E001,S001,S101,M011,F001,S041,T001,S101 ./src/** || true + run: fortitude check --file-extensions=f90,fpp,fypp --ignore=E001,S001,S101,M011,F001,S041,T001,S101,S102,T002,T011 ./src/** || true - name: Ensure kind is specified run: fortitude check --file-extensions=f90,fpp,fypp --select=P001 ./src/** + - name: Ensure subroutines are named + run: fortitude check --file-extensions=f90,fpp,fypp --select=S061 ./src/** + - name: No double precision intrinsics run: | ! grep -iR 'double_precision\|dsqrt\|dexp\|dlog\|dble\|dabs\|double\ precision\|real(8)\|real(4)\|dprod\|dmin\|dmax\|dfloat\|dreal\|dcos\|dsin\|dtan\|dsign\|dtanh\|dsinh\|dcosh\|d0' --exclude-dir=syscheck --exclude="*nvtx*" --exclude="*precision_select*" ./src/* diff --git a/src/common/m_checker_common.fpp b/src/common/m_checker_common.fpp index e8d6e1981..2a1210ab6 100644 --- a/src/common/m_checker_common.fpp +++ b/src/common/m_checker_common.fpp @@ -130,7 +130,7 @@ contains @:PROHIBIT(adv_n .and. (.not. bubbles_euler)) @:PROHIBIT(adv_n .and. num_fluids /= 1) @:PROHIBIT(adv_n .and. qbmm) - end subroutine + end subroutine s_check_inputs_adv_n !> Checks constraints on the hypoelasticity parameters. !! Called by s_check_inputs_common for pre-processing and simulation diff --git a/src/common/m_helper.fpp b/src/common/m_helper.fpp index b290b5bbb..d00439a9b 100644 --- a/src/common/m_helper.fpp +++ b/src/common/m_helper.fpp @@ -101,7 +101,7 @@ contains end do write (*, fmt="(A1)") " " - end subroutine + end subroutine s_print_2D_array !> Initializes non-polydisperse bubble modeling subroutine s_initialize_nonpoly @@ -248,7 +248,7 @@ contains write (res, '(I0)') i res = trim(res) - end subroutine + end subroutine s_int_to_str !> Computes the Simpson weights for quadrature subroutine s_simpson diff --git a/src/common/m_mpi_common.fpp b/src/common/m_mpi_common.fpp index c13709c0b..405da5877 100644 --- a/src/common/m_mpi_common.fpp +++ b/src/common/m_mpi_common.fpp @@ -234,7 +234,6 @@ contains subroutine s_mpi_gather_data(my_vector, counts, gathered_vector, root) - implicit none integer, intent(in) :: counts ! Array of vector lengths for each process real(wp), intent(in), dimension(counts) :: my_vector ! Input vector on each process integer, intent(in) :: root ! Rank of the root process diff --git a/src/common/m_phase_change.fpp b/src/common/m_phase_change.fpp index faa554bfe..f6a0e1666 100644 --- a/src/common/m_phase_change.fpp +++ b/src/common/m_phase_change.fpp @@ -794,7 +794,7 @@ contains !> This subroutine finalizes the phase change module subroutine s_finalize_relaxation_solver_module - end subroutine + end subroutine s_finalize_relaxation_solver_module #endif diff --git a/src/post_process/m_data_input.f90 b/src/post_process/m_data_input.f90 index 0f28032fc..50a662f17 100644 --- a/src/post_process/m_data_input.f90 +++ b/src/post_process/m_data_input.f90 @@ -37,6 +37,8 @@ module m_data_input !! @param t_step Current time-step to input subroutine s_read_abstract_data_files(t_step) + implicit none + integer, intent(in) :: t_step end subroutine s_read_abstract_data_files diff --git a/src/pre_process/include/2dHardcodedIC.fpp b/src/pre_process/include/2dHardcodedIC.fpp index 5732acbd3..1505b99b4 100644 --- a/src/pre_process/include/2dHardcodedIC.fpp +++ b/src/pre_process/include/2dHardcodedIC.fpp @@ -100,8 +100,8 @@ end if case (205) ! 2D lung wave interaction problem - h = 0.0 !non dim origin y - lam = 1.0 !non dim lambda + h = 0.0_wp !non dim origin y + lam = 1.0_wp !non dim lambda amp = patch_icpp(patch_id)%a(2) !to be changed later! !non dim amplitude intH = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h @@ -115,8 +115,8 @@ end if case (206) ! 2D lung wave interaction problem - horizontal domain - h = 0.0 !non dim origin y - lam = 1.0 !non dim lambda + h = 0.0_wp !non dim origin y + lam = 1.0_wp !non dim lambda amp = patch_icpp(patch_id)%a(2) intL = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h diff --git a/src/pre_process/include/3dHardcodedIC.fpp b/src/pre_process/include/3dHardcodedIC.fpp index 5cf1f08ef..e0018598a 100644 --- a/src/pre_process/include/3dHardcodedIC.fpp +++ b/src/pre_process/include/3dHardcodedIC.fpp @@ -44,8 +44,8 @@ end if case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|) - h = 0.0 - lam = 1.0 + h = 0.0_wp + lam = 1.0_wp amp = patch_icpp(patch_id)%a(2) intH = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h) if (x_cc(i) > intH) then diff --git a/src/pre_process/m_assign_variables.fpp b/src/pre_process/m_assign_variables.fpp index b6304949d..edb636ad2 100644 --- a/src/pre_process/m_assign_variables.fpp +++ b/src/pre_process/m_assign_variables.fpp @@ -692,4 +692,4 @@ contains end subroutine s_finalize_assign_variables_module -end module +end module m_assign_variables diff --git a/src/pre_process/m_compute_levelset.fpp b/src/pre_process/m_compute_levelset.fpp index 3caad2cdd..d339157be 100644 --- a/src/pre_process/m_compute_levelset.fpp +++ b/src/pre_process/m_compute_levelset.fpp @@ -261,7 +261,7 @@ contains type(levelset_field), intent(INOUT) :: levelset type(levelset_norm_field), intent(INOUT) :: levelset_norm - integer :: ib_patch_id + integer, intent(in) :: ib_patch_id real(wp) :: top_right(2), bottom_left(2) real(wp) :: x, y, min_dist real(wp) :: side_dists(4) diff --git a/src/pre_process/m_grid.f90 b/src/pre_process/m_grid.f90 index 0f92e8f22..3afd8e85d 100644 --- a/src/pre_process/m_grid.f90 +++ b/src/pre_process/m_grid.f90 @@ -37,8 +37,6 @@ module m_grid subroutine s_generate_abstract_grid - ! integer, intent(IN), optional :: dummy - end subroutine s_generate_abstract_grid end interface diff --git a/src/pre_process/m_model.fpp b/src/pre_process/m_model.fpp index 1e8df1621..bbd50e52b 100644 --- a/src/pre_process/m_model.fpp +++ b/src/pre_process/m_model.fpp @@ -215,7 +215,7 @@ contains call s_read_stl_binary(filepath, model) end if - end subroutine + end subroutine s_read_stl !> This procedure reads an OBJ file. !! @param filepath Path to the odj file. @@ -291,7 +291,7 @@ contains close (iunit) - end subroutine + end subroutine s_read_obj !> This procedure reads a mesh from a file. !! @param filepath Path to the file to read. @@ -709,7 +709,7 @@ contains 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 - real(wp), dimension(1:edge_count, 1:2, 1:2) :: temp_boundary_v !< Temporary edge end vertex buffer + real(wp), dimension(1:edge_count, 1:2, 1:2), intent(inout) :: temp_boundary_v !< Temporary edge end vertex buffer ! Increment edge index and store the edge edge_index = edge_index + 1 @@ -804,7 +804,10 @@ contains t_vec3, intent(in) :: spacing real(wp), allocatable, intent(inout), dimension(:, :) :: interpolated_boundary_v - integer :: i, j, num_segments, total_vertices, boundary_edge_count + integer, intent(inout) :: total_vertices, boundary_edge_count + integer :: num_segments + integer :: i, j + real(wp) :: edge_length, cell_width real(wp), dimension(1:2) :: edge_x, edge_y, edge_del real(wp), allocatable :: temp_boundary_v(:, :) diff --git a/src/pre_process/m_patches.fpp b/src/pre_process/m_patches.fpp index 0afee832e..39e354cb9 100644 --- a/src/pre_process/m_patches.fpp +++ b/src/pre_process/m_patches.fpp @@ -1406,7 +1406,7 @@ contains integer, intent(IN) :: patch_id integer, intent(INOUT), dimension(0:m, 0:n, 0:p) :: patch_id_fp - type(scalar_field), dimension(1:sys_size) :: q_prim_vf + type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf real(wp) :: r, x_p, eps, phi real(wp), dimension(2:9) :: as, Ps diff --git a/src/pre_process/m_perturbation.fpp b/src/pre_process/m_perturbation.fpp index 5f9262891..ccb1b6175 100644 --- a/src/pre_process/m_perturbation.fpp +++ b/src/pre_process/m_perturbation.fpp @@ -223,7 +223,7 @@ contains 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) :: shift !< phase shift + real(wp), intent(in) :: shift !< phase shift real(wp), dimension(0:nbp - 1) :: u_mean !< mean density and velocity profiles real(wp) :: rho_mean, p_mean !< mean density and pressure real(wp), dimension(0:nbp - 1, 0:nbp - 1) :: d !< differential operator in y dir diff --git a/src/simulation/m_acoustic_src.fpp b/src/simulation/m_acoustic_src.fpp index 27901561d..eea836845 100644 --- a/src/simulation/m_acoustic_src.fpp +++ b/src/simulation/m_acoustic_src.fpp @@ -329,7 +329,7 @@ contains end do end do end do - end subroutine + end subroutine s_acoustic_src_calculations !> This subroutine gives the temporally varying amplitude of the pulse !! @param sim_time Simulation time @@ -487,7 +487,7 @@ contains end do #endif - end subroutine + end subroutine s_precalculate_acoustic_spatial_sources !> This subroutine gives the spatial support of the acoustic source !! @param j x-index diff --git a/src/simulation/m_boundary_conditions.fpp b/src/simulation/m_boundary_conditions.fpp index b541a34d1..073c62d07 100644 --- a/src/simulation/m_boundary_conditions.fpp +++ b/src/simulation/m_boundary_conditions.fpp @@ -1376,7 +1376,7 @@ contains end if - end subroutine + end subroutine s_qbmm_extrapolation subroutine s_populate_capillary_buffers(c_divs) diff --git a/src/simulation/m_fftw.fpp b/src/simulation/m_fftw.fpp index fbc529d18..4adae18b1 100644 --- a/src/simulation/m_fftw.fpp +++ b/src/simulation/m_fftw.fpp @@ -322,4 +322,4 @@ contains end subroutine s_finalize_fftw_module -end module +end module m_fftw diff --git a/src/simulation/m_nvtx.f90 b/src/simulation/m_nvtx.f90 index 2a49731f5..e2a493a49 100644 --- a/src/simulation/m_nvtx.f90 +++ b/src/simulation/m_nvtx.f90 @@ -23,7 +23,7 @@ module m_nvtx integer(c_int64_t) :: payload ! union uint,int,double integer(c_int) :: messageType = 1 ! NVTX_MESSAGE_TYPE_ASCII = 1 type(c_ptr) :: message ! ascii char - end type + end type nvtxEventAttributes #if defined(MFC_OpenACC) && defined(__PGI) @@ -33,7 +33,7 @@ subroutine nvtxRangePushA(name) bind(C, name='nvtxRangePushA') use iso_c_binding character(kind=c_char, len=*) :: name - end subroutine + end subroutine nvtxRangePushA ! push range with custom label and custom color subroutine nvtxRangePushEx(event) bind(C, name='nvtxRangePushEx') @@ -41,13 +41,13 @@ subroutine nvtxRangePushEx(event) bind(C, name='nvtxRangePushEx') import :: nvtxEventAttributes type(nvtxEventAttributes) :: event - end subroutine - end interface + end subroutine nvtxRangePushEx + end interface nvtxRangePush interface nvtxRangePop subroutine nvtxRangePop() bind(C, name='nvtxRangePop') - end subroutine - end interface + end subroutine nvtxRangePop + end interface nvtxRangePop #endif @@ -71,12 +71,12 @@ subroutine nvtxStartRange(name, id) end if #endif - end subroutine + end subroutine nvtxStartRange subroutine nvtxEndRange #if defined(MFC_OpenACC) && defined(__PGI) call nvtxRangePop #endif - end subroutine + end subroutine nvtxEndRange end module m_nvtx diff --git a/src/simulation/m_qbmm.fpp b/src/simulation/m_qbmm.fpp index 3c111c4fb..4a23839af 100644 --- a/src/simulation/m_qbmm.fpp +++ b/src/simulation/m_qbmm.fpp @@ -675,7 +675,7 @@ contains end if - end subroutine + end subroutine s_compute_qbmm_rhs !Coefficient array for non-polytropic model (pb and mv values are accounted in wght_pb and wght_mv) diff --git a/src/simulation/m_sim_helpers.f90 b/src/simulation/m_sim_helpers.f90 index fdb387cbc..0c6f95a67 100644 --- a/src/simulation/m_sim_helpers.f90 +++ b/src/simulation/m_sim_helpers.f90 @@ -35,15 +35,17 @@ subroutine s_compute_enthalpy(q_prim_vf, pres, rho, gamma, pi_inf, Re, H, alpha, !$acc routine seq #endif - type(scalar_field), dimension(sys_size) :: q_prim_vf - real(wp), dimension(num_fluids) :: alpha_rho - real(wp), dimension(num_fluids) :: alpha - real(wp), dimension(num_dims) :: vel - real(wp) :: rho, gamma, pi_inf, qv, vel_sum, E, H, pres - real(wp), dimension(2) :: Re - real(wp) :: G !< Cell-avg. fluid shear modulus - real(wp), dimension(num_fluids) :: Gs !< Cell-avg. fluid shear moduli - integer :: i, j, k, l + type(scalar_field), intent(in), dimension(sys_size) :: q_prim_vf + real(wp), intent(inout), dimension(num_fluids) :: alpha + real(wp), intent(inout), dimension(num_dims) :: vel + real(wp), intent(inout) :: rho, gamma, pi_inf, vel_sum, H, pres + integer, intent(in) :: j, k, l + real(wp), dimension(2), intent(inout) :: Re + + real(wp), dimension(num_fluids) :: alpha_rho, Gs + real(wp) :: qv, E, G + + integer :: i !$acc loop seq do i = 1, num_fluids @@ -96,15 +98,16 @@ end subroutine s_compute_enthalpy !! @param Rc_sf (optional) cell centered Rc subroutine s_compute_stability_from_dt(vel, c, rho, Re_l, j, k, l, icfl_sf, vcfl_sf, Rc_sf) !$acc routine seq - real(wp), dimension(num_dims) :: vel - real(wp) :: c, rho - real(wp), dimension(0:m, 0:n, 0:p) :: icfl_sf - real(wp), dimension(0:m, 0:n, 0:p), optional :: vcfl_sf, Rc_sf + real(wp), intent(in), dimension(num_dims) :: vel + real(wp), intent(in) :: c, rho + real(wp), dimension(0:m, 0:n, 0:p), intent(inout) :: icfl_sf + real(wp), dimension(0:m, 0:n, 0:p), intent(inout), optional :: vcfl_sf, Rc_sf + real(wp), dimension(2), intent(in) :: Re_l + integer, intent(in) :: j, k, l + real(wp) :: fltr_dtheta !< !! Modified dtheta accounting for Fourier filtering in azimuthal direction. - integer :: j, k, l integer :: Nfq - real(wp), dimension(2) :: Re_l if (grid_geometry == 3) then if (k == 0) then @@ -192,14 +195,17 @@ end subroutine s_compute_stability_from_dt !! @param l z coordinate subroutine s_compute_dt_from_cfl(vel, c, max_dt, rho, Re_l, j, k, l) !$acc routine seq - real(wp), dimension(num_dims) :: vel - real(wp) :: c, icfl_dt, vcfl_dt, rho - real(wp), dimension(0:m, 0:n, 0:p) :: max_dt + real(wp), dimension(num_dims), intent(in) :: vel + real(wp), intent(in) :: c, rho + real(wp), dimension(0:m, 0:n, 0:p), intent(inout) :: max_dt + real(wp), dimension(2), intent(in) :: Re_l + integer, intent(in) :: j, k, l + + real(wp) :: icfl_dt, vcfl_dt real(wp) :: fltr_dtheta !< !! Modified dtheta accounting for Fourier filtering in azimuthal direction. - integer :: j, k, l + integer :: Nfq - real(wp), dimension(2) :: Re_l if (grid_geometry == 3) then if (k == 0) then