Code Tidying

Author: XZTian64

src/common/m_boundary_common.fpp

@@ -1028,9 +1028,9 @@ contains
         integer, intent(in) :: bc_dir, bc_loc
         integer, intent(in) :: k, l
 
+#ifdef MFC_SIMULATION
         integer :: j, i
 
-#ifdef MFC_SIMULATION
         if (bc_dir == 1) then !< x-direction
             if (bc_loc == -1) then !bc_x%beg
                 do i = 1, sys_size
@@ -1520,7 +1520,7 @@ contains
 
         character(LEN=*), intent(in) :: step_dirpath
 
-        integer :: dir, loc, i
+        integer :: dir, loc
         character(len=path_len) :: file_path
 
         character(len=10) :: status
@@ -1561,12 +1561,10 @@ contains
         integer :: dir, loc
         character(len=path_len) :: file_loc, file_path
 
-        character(len=10) :: status
-
 #ifdef MFC_MPI
         integer :: ierr
         integer :: file_id
-        integer :: offset
+        integer(KIND=MPI_ADDRESS_KIND) :: offset
         character(len=7) :: proc_rank_str
         logical :: dir_check
 
@@ -1625,8 +1623,6 @@ contains
         logical :: file_exist
         character(len=path_len) :: file_path
 
-        character(len=10) :: status
-
         ! Read bc_types
         file_path = trim(step_dirpath)//'/bc_type.dat'
         inquire (FILE=trim(file_path), EXIST=file_exist)
@@ -1668,12 +1664,10 @@ contains
         integer :: dir, loc
         character(len=path_len) :: file_loc, file_path
 
-        character(len=10) :: status
-
 #ifdef MFC_MPI
         integer :: ierr
         integer :: file_id
-        integer :: offset
+        integer(KIND=MPI_ADDRESS_KIND) :: offset
         character(len=7) :: proc_rank_str
         logical :: dir_check
 
@@ -1696,7 +1690,7 @@ contains
         file_path = trim(file_loc)//'/bc_'//trim(proc_rank_str)//'.dat'
         call MPI_File_open(MPI_COMM_SELF, trim(file_path), MPI_MODE_RDONLY, MPI_INFO_NULL, file_id, ierr)
 
-        offset = 0
+        offset = int(0, KIND=MPI_ADDRESS_KIND)
 
         ! Read bc_types
         do dir = 1, num_dims
@@ -1788,9 +1782,9 @@ contains
         !!          boundary locations and cell-width distributions, based on
         !!          the boundary conditions.
     subroutine s_populate_grid_variables_buffers
-
+#ifndef MFC_PRE_PROCESS
         integer :: i !< Generic loop iterator
-
+#endif
 #ifdef MFC_SIMULATION
         ! Required for compatibility between codes
         type(int_bounds_info) :: offset_x, offset_y, offset_z

src/common/m_checker_common.fpp

@@ -316,8 +316,9 @@ contains
     !> Checks constraints on the surface tension parameters.
         !! Called by s_check_inputs_common for all three stages
     impure subroutine s_check_inputs_surface_tension
-
+#ifdef MFC_PRE_PROCESS
         integer :: i
+#endif MFC_PRE_PROCESS
 
         @:PROHIBIT(surface_tension .and. sigma < 0._wp, &
             "sigma must be greater than or equal to zero")

src/common/m_finite_differences.fpp

@@ -67,18 +67,20 @@ contains
     !!  @param s_cc Locations of the cell-centers in the s-coordinate direction
     !!  @param fd_coeff_s Finite-diff. coefficients in the s-coordinate direction
     pure subroutine s_compute_finite_difference_coefficients(q, s_cc, fd_coeff_s, buff_size, &
-                                                             fd_number_in, fd_order_in, offset_s)
+                                                             fd_order_in, fd_number_in, offset_s)
 
         integer :: lB, lE !< loop bounds
         integer, intent(IN) :: q
-        integer, intent(IN) :: buff_size, fd_number_in, fd_order_in
+        integer, intent(IN) :: buff_size, fd_order_in
+        integer, optional, intent(IN) :: fd_number_in
+
         type(int_bounds_info), optional, intent(IN) :: offset_s
         real(wp), allocatable, dimension(:, :), intent(INOUT) :: fd_coeff_s
 
         real(wp), &
             dimension(-buff_size:q + buff_size), &
             intent(IN) :: s_cc
-
+        integer :: fd_number
         integer :: i !< Generic loop iterator
 
         if (present(offset_s)) then
@@ -88,6 +90,11 @@ contains
             lB = 0
             lE = q
         end if
+        if (present(fd_number_in)) then
+            fd_number = fd_number_in
+        else
+            fd_number = 2
+        end if
 
 #ifdef MFC_POST_PROCESS
         if (allocated(fd_coeff_s)) deallocate (fd_coeff_s)

src/common/m_helper_basic.f90

@@ -21,7 +21,7 @@ module m_helper_basic
     !> This procedure checks if two floating point numbers of wp are within tolerance.
     !! @param a First number.
     !! @param b Second number.
-    !! @param tol_input Relative error (default = 1.e-10_wp).
+    !! @param tol_input Relative error (default = 1.e-10_wp for double precision and 1e-6 for single).
     !! @return Result of the comparison.
     logical pure elemental function f_approx_equal(a, b, tol_input) result(res)
         !$acc routine seq
@@ -32,7 +32,11 @@ logical pure elemental function f_approx_equal(a, b, tol_input) result(res)
         if (present(tol_input)) then
             tol = tol_input
         else
-            tol = 1.e-10_wp
+            if (wp == selected_real_kind(15, 307)) then
+                tol = 1.e-10_wp  ! Double Precision
+            else if (wp == selected_real_kind(6, 37)) then
+                tol = 1.e-6_wp   ! Single Precision
+            end if
         end if
 
         if (a == b) then
@@ -47,7 +51,7 @@ end function f_approx_equal
     !> This procedure checks if the point numbers of wp belongs to another array are within tolerance.
     !! @param a First number.
     !! @param b Array that contains several point numbers.
-    !! @param tol_input Relative error (default = 1e-10_wp).
+    !! @param tol_input Relative error (default = 1.e-10_wp for double precision and 1e-6 for single).
     !! @return Result of the comparison.
     logical pure function f_approx_in_array(a, b, tol_input) result(res)
         !$acc routine seq
@@ -62,7 +66,11 @@ logical pure function f_approx_in_array(a, b, tol_input) result(res)
         if (present(tol_input)) then
             tol = tol_input
         else
-            tol = 1e-10_wp
+            if (wp == selected_real_kind(15, 307)) then
+                tol = 1.e-10_wp  ! Double Precision
+            else if (wp == selected_real_kind(6, 37)) then
+                tol = 1.e-6_wp   ! Single Precision
+            end if
         end if
 
         do i = 1, size(b)

src/common/m_mpi_common.fpp

@@ -130,12 +130,17 @@ contains
         type(scalar_field), intent(in), optional :: beta
 
         integer, dimension(num_dims) :: sizes_glb, sizes_loc
-        integer, dimension(1) :: airfoil_glb, airfoil_loc, airfoil_start
+#ifndef MFC_POST_PROCESS
 
+        integer, dimension(1) :: airfoil_glb, airfoil_loc, airfoil_start
+#endif
 #ifdef MFC_MPI
 
         ! Generic loop iterator
-        integer :: i, j
+        integer :: i
+#ifndef MFC_POST_PROCESS
+        integer :: j
+#endif
 
         !Altered system size for the lagrangian subgrid bubble model
         integer :: alt_sys
@@ -363,6 +368,11 @@ contains
         real(wp), intent(out) :: vcfl_max_glb
         real(wp), intent(out) :: Rc_min_glb
 
+        ! Initiate the global variables to the local values to avoid warnings
+        icfl_max_glb = icfl_max_loc
+        vcfl_max_glb = vcfl_max_loc
+        Rc_min_glb = Rc_min_loc
+
 #ifdef MFC_SIMULATION
 #ifdef MFC_MPI
 

src/common/m_nvtx.f90

@@ -55,19 +55,24 @@ end subroutine nvtxRangePop
 
     subroutine nvtxStartRange(name, id)
         character(kind=c_char, len=*), intent(IN) :: name
-        integer, intent(IN), optional :: id
+        integer, intent(in), optional :: id
+        integer :: id_color
+#if defined(MFC_OpenACC) && defined(__PGI)
         type(nvtxEventAttributes) :: event
+#endif
+        if (present(id)) then
+            id_color = col(mod(id, 7) + 1)
+        end if
+        tempName = trim(name)//c_null_char
 
 #if defined(MFC_OpenACC) && defined(__PGI)
 
-        tempName = trim(name)//c_null_char
-
-        if (.not. present(id)) then
-            call nvtxRangePush(tempName)
-        else
-            event%color = col(mod(id, 7) + 1)
+        if (present(id)) then
+            event%color = id_color
             event%message = c_loc(tempName)
             call nvtxRangePushEx(event)
+        else
+            call nvtxRangePush(tempName)
         end if
 
 #endif