m_start_up.fpp.f90

Go to the documentation of this file.

# 1 "/home/runner/work/MFC/MFC/src/pre_process/m_start_up.fpp"
!>
!! @file
!! @brief Contains module m_start_up
 
# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
! New line at end of file is required for FYPP
# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
! New line at end of file is required for FYPP
# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
 
# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
 
# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
! New line at end of file is required for FYPP
# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
 
# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
! New line at end of file is required for FYPP
# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
 
# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
 
# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
! New line at end of file is required for FYPP
# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
 
! GPU parallel region (scalar reductions, maxval/minval)
# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! GPU parallel loop over threads (most common GPU macro)
# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! Required closing for GPU_PARALLEL_LOOP
# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! Mark routine for device compilation
# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! Declare device-resident data
# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! Inner loop within a GPU parallel region
# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! Scoped GPU data region
# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! Host code with device pointers (for MPI with GPU buffers)
# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! Allocate device memory (unscoped)
# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! Free device memory
# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! Atomic operation on device
# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! End atomic capture block
# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! Copy data between host and device
# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! Synchronization barrier
# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! Import GPU library module (openacc or omp_lib)
# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! Emit code only for AMD compiler
# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! Emit code for non-Cray compilers
# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! Emit code only for Cray compiler
# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
! Emit code for non-NVIDIA compilers
# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
 
# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
! New line at end of file is required for FYPP
# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
 
# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
 
! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
 
! Allocate and create GPU device memory
# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
 
! Free GPU device memory and deallocate
# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
 
! Cray-specific GPU pointer setup for vector fields
# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
 
! Cray-specific GPU pointer setup for scalar fields
# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
 
! Cray-specific GPU pointer setup for acoustic source spatials
# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
 
# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
 
# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
! New line at end of file is required for FYPP
# 6 "/home/runner/work/MFC/MFC/src/pre_process/m_start_up.fpp" 2
 
!> @brief Reads and validates user inputs, loads existing grid/IC data, and initializes pre-process modules
module m_start_up
 
    use m_derived_types
    use m_global_parameters
    use m_mpi_proxy
    use m_mpi_common
    use m_variables_conversion
    use m_grid
    use m_initial_condition
    use m_data_output
    use m_compile_specific
    use m_icpp_patches
    use m_assign_variables
    use m_phase_change
    use m_helper_basic
    use m_helper
 
#ifdef MFC_MPI
    use mpi
#endif
 
    use m_check_patches
    use m_check_ib_patches
    use m_helper
    use m_checker_common
    use m_checker
    use m_boundary_common
    use m_boundary_conditions
 
    implicit none
 
    private
    public :: s_read_input_file, s_check_input_file, s_read_grid_data_files, s_read_ic_data_files, s_read_serial_grid_data_files, &
        & s_read_serial_ic_data_files, s_read_parallel_grid_data_files, s_read_parallel_ic_data_files, s_check_grid_data_files, &
        & s_initialize_modules, s_initialize_mpi_domain, s_finalize_modules, s_apply_initial_condition, s_save_data, s_read_grid
 
    abstract interface
 
        !> Abstract interface for reading grid data files in serial or parallel.
        impure subroutine s_read_abstract_grid_data_files
 
        end subroutine s_read_abstract_grid_data_files
 
        !> Abstract interface for reading initial condition data files in serial or parallel.
        impure subroutine s_read_abstract_ic_data_files(q_cons_vf_in)
 
            import :: scalar_field, integer_field, sys_size, pres_field
 
            type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf_in
 
        end subroutine s_read_abstract_ic_data_files
    end interface
 
    character(LEN=path_len + name_len) :: proc_rank_dir  !< Location of the folder associated with the rank of the local processor
    character(LEN=path_len + 2*name_len), private :: t_step_dir  !< Path to preexisting time-step folder for restart
    procedure(s_read_abstract_grid_data_files), pointer :: s_read_grid_data_files => null()
    procedure(s_read_abstract_ic_data_files), pointer :: s_read_ic_data_files => null()
 
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
    impure subroutine s_read_input_file
 
        character(LEN=name_len) :: file_loc
        logical                 :: file_check
        integer                 :: iostatus
        character(len=1000)     :: line
 
# 1 "/home/runner/work/MFC/MFC/build/include/pre_process/generated_namelist.fpp" 1
! AUTO-GENERATED - do not edit directly. Regenerate: cmake reconfigure
!
namelist /user_inputs/ bx0, ca, r0ref, re_inv, web, a_x, a_y, a_z, adv_n, bc_x, bc_y, bc_z, bub_pp, bubbles_euler, &
    & bubbles_lagrange, case_dir, cfl_adap_dt, cfl_const_dt, cont_damage, cyl_coord, dist_type, down_sample, elliptic_smoothing, &
    & elliptic_smoothing_iters, fft_wrt, file_per_process, fluid_pp, fluid_rho, hyper_cleaning, hyperelasticity, hypoelasticity, &
    & ib, ib_airfoil, igr, igr_order, loops_x, loops_y, loops_z, m, mhd, mixlayer_perturb, mixlayer_perturb_k0, &
    & mixlayer_perturb_nk, mixlayer_vel_coef, mixlayer_vel_profile, model_eqns, mpp_lim, muscl_order, n, n_start, n_start_old, &
    & nb, num_bc_patches, num_fluids, num_ibs, num_patches, num_stl_models, old_grid, old_ic, p, palpha_eps, parallel_io, &
    & patch_bc, patch_ib, patch_icpp, perturb_flow, perturb_flow_fluid, perturb_flow_mag, perturb_sph, perturb_sph_fluid, &
    & pi_fac, poly_sigma, polydisperse, polytropic, pre_stress, precision, pref, ptgalpha_eps, qbmm, recon_type, relativity, &
    & relax, relax_model, rhorv, rhoref, sigr, sigv, sigma, simplex_params, simplex_perturb, stl_models, stretch_x, stretch_y, &
    & stretch_z, surface_tension, t_step_old, t_step_start, thermal, viscous, weno_order, x_a, x_b, x_domain, y_a, y_b, &
    & y_domain, z_a, z_b, z_domain
# 78 "/home/runner/work/MFC/MFC/src/pre_process/m_start_up.fpp" 2
 
        file_loc = 'pre_process.inp'
        inquire (file=trim(file_loc), exist=file_check)
 
        if (file_check) then
            open (1, file=trim(file_loc), form='formatted', status='old', action='read')
            read (1, nml=user_inputs, iostat=iostatus)
            if (iostatus /= 0) then
                backspace(1)
                read (1, fmt='(A)') line
                print *, 'Invalid line in namelist: ' // trim(line)
                call s_mpi_abort('Invalid line in pre_process.inp. It is ' // 'likely due to a datatype mismatch. Exiting.')
            end if
            close (1)
 
            call s_update_cell_bounds(cells_bounds, m, n, p)
 
            m_glb = m
            n_glb = n
            p_glb = p
 
            nglobal = int(m_glb + 1, kind=8)*int(n_glb + 1, kind=8)*int(p_glb + 1, kind=8)
 
            if (cfl_adap_dt .or. cfl_const_dt) cfl_dt = .true.
 
            if (any((/bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, bc_z%end/) == bc_dirichlet) .or. num_bc_patches > 0) then
                bc_io = .true.
            end if
        else
            call s_mpi_abort('File pre_process.inp is missing. Exiting.')
        end if
 
    end subroutine s_read_input_file
 
    !> Checking that the user inputs make sense, i.e. that the 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
    impure subroutine s_check_input_file
 
        character(LEN=len_trim(case_dir)) :: file_loc
        logical                           :: dir_check
 
        case_dir = adjustl(case_dir)
 
        file_loc = trim(case_dir) // '/.'
 
        call my_inquire(file_loc, dir_check)
 
        if (dir_check .neqv. .true.) then
            print '(A)', 'WARNING: Ensure that compiler flags/choices in Makefiles match your compiler! '
            print '(A)', 'WARNING: Ensure that preprocessor flags are enabled! '
            call s_mpi_abort('Unsupported choice for the value of case_dir.' // 'Exiting.')
        end if
 
        call s_check_inputs_common()
        call s_check_inputs()
 
        call s_check_patches()
 
        if (ib) call s_check_ib_patches()
 
    end subroutine s_check_input_file
 
    !> 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.
    impure subroutine s_read_serial_grid_data_files
 
        character(LEN=len_trim(case_dir) + 3*name_len) :: file_loc
        logical                                        :: dir_check
        logical                                        :: file_check
 
        write (proc_rank_dir, '(A,I0)') '/p_all/p', proc_rank
        proc_rank_dir = trim(case_dir) // trim(proc_rank_dir)
 
        write (t_step_dir, '(A,I0)') '/', t_step_start
        t_step_dir = trim(proc_rank_dir) // trim(t_step_dir)
 
        file_loc = trim(t_step_dir) // '/.'
        call my_inquire(file_loc, dir_check)
 
        if (dir_check .neqv. .true.) then
            call s_mpi_abort('Time-step folder ' // trim(t_step_dir) // ' is missing. Exiting.')
        end if
 
        file_loc = trim(t_step_dir) // '/x_cb.dat'
        inquire (file=trim(file_loc), exist=file_check)
 
        if (file_check) then
            open (1, file=trim(file_loc), form='unformatted', status='old', action='read')
            read (1) x_cb(-1:m)
            close (1)
        else
            call s_mpi_abort('File x_cb.dat is missing in ' // trim(t_step_dir) // '. Exiting.')
        end if
 
        x_cc(0:m) = (x_cb(0:m) + x_cb(-1:(m - 1)))/2._wp
 
        dx = minval(x_cb(0:m) - x_cb(-1:m - 1))
        if (num_procs > 1) call s_mpi_reduce_min(dx)
 
        x_domain%beg = x_cb(-1)
        x_domain%end = x_cb(m)
 
        if (n > 0) then
            file_loc = trim(t_step_dir) // '/y_cb.dat'
            inquire (file=trim(file_loc), exist=file_check)
 
            if (file_check) then
                open (1, file=trim(file_loc), form='unformatted', status='old', action='read')
                read (1) y_cb(-1:n)
                close (1)
            else
                call s_mpi_abort('File y_cb.dat is missing in ' // trim(t_step_dir) // '. Exiting.')
            end if
 
            y_cc(0:n) = (y_cb(0:n) + y_cb(-1:(n - 1)))/2._wp
 
            dy = minval(y_cb(0:n) - y_cb(-1:n - 1))
            if (num_procs > 1) call s_mpi_reduce_min(dy)
 
            y_domain%beg = y_cb(-1)
            y_domain%end = y_cb(n)
 
            if (p > 0) then
                file_loc = trim(t_step_dir) // '/z_cb.dat'
                inquire (file=trim(file_loc), exist=file_check)
 
                if (file_check) then
                    open (1, file=trim(file_loc), form='unformatted', status='old', action='read')
                    read (1) z_cb(-1:p)
                    close (1)
                else
                    call s_mpi_abort('File z_cb.dat is missing in ' // trim(t_step_dir) // '. Exiting.')
                end if
 
                z_cc(0:p) = (z_cb(0:p) + z_cb(-1:(p - 1)))/2._wp
 
                dz = minval(z_cb(0:p) - z_cb(-1:p - 1))
                if (num_procs > 1) call s_mpi_reduce_min(dz)
 
                z_domain%beg = z_cb(-1)
                z_domain%end = z_cb(p)
            end if
        end if
 
        ! Clean processor dir and create time-step dir (unless reading preexisting IC)
        if (old_ic .neqv. .true.) then
            call s_delete_directory(trim(proc_rank_dir))
            call s_create_directory(trim(proc_rank_dir) // '/0')
        end if
 
    end subroutine s_read_serial_grid_data_files
 
    !> Cell-boundary data are checked for consistency by looking 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
    impure subroutine s_check_grid_data_files
 
        if (any(x_cb(0:m) - x_cb(-1:m - 1) <= 0._wp)) then
            call s_mpi_abort('x_cb.dat in ' // trim(t_step_dir) // ' contains non-positive cell-spacings. Exiting.')
        end if
 
        if (n > 0) then
            if (any(y_cb(0:n) - y_cb(-1:n - 1) <= 0._wp)) then
                call s_mpi_abort('y_cb.dat in ' // trim(t_step_dir) // ' contains non-positive cell-spacings. ' // 'Exiting.')
            end if
 
            if (p > 0) then
                if (any(z_cb(0:p) - z_cb(-1:p - 1) <= 0._wp)) then
                    call s_mpi_abort('z_cb.dat in ' // trim(t_step_dir) // ' contains non-positive cell-spacings' // ' .Exiting.')
                end if
            end if
        end if
 
    end subroutine s_check_grid_data_files
 
    !> The goal of this subroutine is to read in any preexisting initial condition data files so that they may be used by the
    !! pre-process as a starting point in the creation of an all new initial condition.
    impure subroutine s_read_serial_ic_data_files(q_cons_vf_in)
 
        type(scalar_field), dimension(sys_size), intent(inout)   :: q_cons_vf_in
        character(LEN=len_trim(case_dir) + 3*name_len)           :: file_loc
        character(len=int(floor(log10(real(sys_size, wp)))) + 1) :: file_num
        logical                                                  :: file_check
        integer                                                  :: i, r
 
        do i = 1, sys_size
            write (file_num, '(I0)') i
            file_loc = trim(t_step_dir) // '/q_cons_vf' // trim(file_num) // '.dat'
            inquire (file=trim(file_loc), exist=file_check)
 
            if (file_check) then
                open (1, file=trim(file_loc), form='unformatted', status='old', action='read')
                read (1) q_cons_vf_in(i)%sf
                close (1)
            else
                call s_mpi_abort('File q_cons_vf' // trim(file_num) // '.dat is missing in ' // trim(t_step_dir) // '. Exiting.')
            end if
        end do
 
        if (qbmm .and. .not. polytropic) then
            do i = 1, nb
                do r = 1, nnode
                    write (file_num, '(I0)') sys_size + r + (i - 1)*nnode
                    file_loc = trim(t_step_dir) // '/pb' // trim(file_num) // '.dat'
                    inquire (file=trim(file_loc), exist=file_check)
 
                    if (file_check) then
                        open (1, file=trim(file_loc), form='unformatted', status='old', action='read')
                        read (1) pb%sf(:,:,:,r, i)
                        close (1)
                    else
                        call s_mpi_abort('File pb' // trim(file_num) // '.dat is missing in ' // trim(t_step_dir) // '. Exiting.')
                    end if
                end do
            end do
 
            do i = 1, nb
                do r = 1, nnode
                    write (file_num, '(I0)') sys_size + r + (i - 1)*nnode
                    file_loc = trim(t_step_dir) // '/mv' // trim(file_num) // '.dat'
                    inquire (file=trim(file_loc), exist=file_check)
 
                    if (file_check) then
                        open (1, file=trim(file_loc), form='unformatted', status='old', action='read')
                        read (1) mv%sf(:,:,:,r, i)
                        close (1)
                    else
                        call s_mpi_abort('File mv' // trim(file_num) // '.dat is missing in ' // trim(t_step_dir) // '. Exiting.')
                    end if
                end do
            end do
        end if
 
        ! Since the preexisting grid and initial condition data files have been read in, the directory associated with the rank of
        ! the local process may be cleaned out to make room for new pre-process data. In addition, the time-step folder that will
        ! contain the new grid and initial condition data are also generated.
        call s_delete_directory(trim(proc_rank_dir))
        call s_create_directory(trim(proc_rank_dir) // '/0')
 
    end subroutine s_read_serial_ic_data_files
 
    !> Cell-boundary data are checked for consistency by looking 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
    impure subroutine s_read_parallel_grid_data_files
 
#ifdef MFC_MPI
        real(wp), allocatable, dimension(:)  :: x_cb_glb, y_cb_glb, z_cb_glb
        integer                              :: ifile, ierr, data_size
        integer, dimension(MPI_STATUS_SIZE)  :: status
        character(LEN=path_len + 2*name_len) :: file_loc
        logical                              :: file_exist
 
        allocate (x_cb_glb(-1:m_glb))
        allocate (y_cb_glb(-1:n_glb))
        allocate (z_cb_glb(-1:p_glb))
 
        file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // 'x_cb.dat'
        inquire (file=trim(file_loc), exist=file_exist)
 
        if (file_exist) then
            data_size = m_glb + 2
            call mpi_file_open(mpi_comm_world, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
            call mpi_file_read_all(ifile, x_cb_glb, data_size, mpi_p, status, ierr)
            call mpi_file_close(ifile, ierr)
        else
            call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting. ')
        end if
 
        x_cb(-1:m) = x_cb_glb((start_idx(1) - 1):(start_idx(1) + m))
        x_cc(0:m) = (x_cb(0:m) + x_cb(-1:(m - 1)))/2._wp
        dx = minval(x_cb(0:m) - x_cb(-1:(m - 1)))
        if (num_procs > 1) call s_mpi_reduce_min(dx)
        x_domain%beg = x_cb(-1)
        x_domain%end = x_cb(m)
 
        if (n > 0) then
            file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // 'y_cb.dat'
            inquire (file=trim(file_loc), exist=file_exist)
 
            if (file_exist) then
                data_size = n_glb + 2
                call mpi_file_open(mpi_comm_world, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
                call mpi_file_read_all(ifile, y_cb_glb, data_size, mpi_p, status, ierr)
                call mpi_file_close(ifile, ierr)
            else
                call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting. ')
            end if
 
            y_cb(-1:n) = y_cb_glb((start_idx(2) - 1):(start_idx(2) + n))
            y_cc(0:n) = (y_cb(0:n) + y_cb(-1:(n - 1)))/2._wp
            dy = minval(y_cb(0:n) - y_cb(-1:(n - 1)))
            if (num_procs > 1) call s_mpi_reduce_min(dy)
            y_domain%beg = y_cb(-1)
            y_domain%end = y_cb(n)
 
            if (p > 0) then
                file_loc = trim(case_dir) // '/restart_data' // trim(mpiiofs) // 'z_cb.dat'
                inquire (file=trim(file_loc), exist=file_exist)
 
                if (file_exist) then
                    data_size = p_glb + 2
                    call mpi_file_open(mpi_comm_world, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
                    call mpi_file_read_all(ifile, z_cb_glb, data_size, mpi_p, status, ierr)
                    call mpi_file_close(ifile, ierr)
                else
                    call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting. ')
                end if
 
                z_cb(-1:p) = z_cb_glb((start_idx(3) - 1):(start_idx(3) + p))
                z_cc(0:p) = (z_cb(0:p) + z_cb(-1:(p - 1)))/2._wp
                dz = minval(z_cb(0:p) - z_cb(-1:(p - 1)))
                if (num_procs > 1) call s_mpi_reduce_min(dz)
                z_domain%beg = z_cb(-1)
                z_domain%end = z_cb(p)
            end if
        end if
 
        deallocate (x_cb_glb, y_cb_glb, z_cb_glb)
#endif
 
    end subroutine s_read_parallel_grid_data_files
 
    !> The goal of this subroutine is to read in any preexisting initial condition data files so that they may be used by the
    !! pre-process as a starting point in the creation of an all new initial condition.
    impure subroutine s_read_parallel_ic_data_files(q_cons_vf_in)
 
        type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf_in
 
#ifdef MFC_MPI
        integer                              :: ifile, ierr, data_size
        integer, dimension(MPI_STATUS_SIZE)  :: status
        integer(KIND=MPI_OFFSET_KIND)        :: disp
        integer(KIND=MPI_OFFSET_KIND)        :: m_mok, n_mok, p_mok
        integer(KIND=MPI_OFFSET_KIND)        :: wp_mok, var_mok
        integer(KIND=MPI_OFFSET_KIND)        :: mok
        character(LEN=path_len + 2*name_len) :: file_loc
        logical                              :: file_exist
        integer                              :: i
 
        if (cfl_adap_dt) then
            write (file_loc, '(I0,A)') n_start, '.dat'
        else
            write (file_loc, '(I0,A)') t_step_start, '.dat'
        end if
        file_loc = trim(restart_dir) // trim(mpiiofs) // trim(file_loc)
        inquire (file=trim(file_loc), exist=file_exist)
 
        if (file_exist) then
            call mpi_file_open(mpi_comm_world, file_loc, mpi_mode_rdonly, mpi_info_int, ifile, ierr)
 
            call s_initialize_mpi_data(q_cons_vf_in)
 
            data_size = (m + 1)*(n + 1)*(p + 1)
 
            ! Resize some integers so MPI can read even the biggest files
            m_mok = int(m_glb + 1, mpi_offset_kind)
            n_mok = int(n_glb + 1, mpi_offset_kind)
            p_mok = int(p_glb + 1, mpi_offset_kind)
            wp_mok = int(storage_size(0._stp)/8, mpi_offset_kind)
            mok = int(1._wp, mpi_offset_kind)
 
            do i = 1, sys_size
                var_mok = int(i, mpi_offset_kind)
 
                ! Initial displacement to skip at beginning of file
                disp = m_mok*max(mok, n_mok)*max(mok, p_mok)*wp_mok*(var_mok - 1)
 
                call mpi_file_set_view(ifile, disp, mpi_p, mpi_io_data%view(i), 'native', mpi_info_int, ierr)
                call mpi_file_read(ifile, mpi_io_data%var(i)%sf, data_size, mpi_p, status, ierr)
            end do
 
            if (qbmm .and. .not. polytropic) then
                do i = sys_size + 1, sys_size + 2*nb*nnode
                    var_mok = int(i, mpi_offset_kind)
 
                    ! Initial displacement to skip at beginning of file
                    disp = m_mok*max(mok, n_mok)*max(mok, p_mok)*wp_mok*(var_mok - 1)
 
                    call mpi_file_set_view(ifile, disp, mpi_p, mpi_io_data%view(i), 'native', mpi_info_int, ierr)
                    call mpi_file_read(ifile, mpi_io_data%var(i)%sf, data_size, mpi_p, status, ierr)
                end do
            end if
 
            call s_mpi_barrier()
 
            call mpi_file_close(ifile, ierr)
        else
            call s_mpi_abort('File ' // trim(file_loc) // ' is missing. Exiting. ')
        end if
 
        call s_mpi_barrier()
#endif
 
    end subroutine s_read_parallel_ic_data_files
 
    !> Initialize all pre-process modules, allocate data structures, and set I/O procedure pointers.
    impure subroutine s_initialize_modules
 
        call s_initialize_global_parameters_module()
        if (bubbles_euler .or. bubbles_lagrange) then
            call s_initialize_bubbles_model()
        end if
        call s_initialize_mpi_common_module()
        call s_initialize_data_output_module()
        call s_initialize_variables_conversion_module()
        call s_initialize_grid_module()
        call s_initialize_initial_condition_module()
        call s_initialize_perturbation_module()
        call s_initialize_assign_variables_module()
        call s_initialize_boundary_common_module()
        if (relax) call s_initialize_phasechange_module()
 
        ! Create the D directory if it doesn't exit, to store the serial data files
        call s_create_directory('D')
 
        if (parallel_io .neqv. .true.) then
            s_generate_grid => s_generate_serial_grid
            s_read_grid_data_files => s_read_serial_grid_data_files
            s_read_ic_data_files => s_read_serial_ic_data_files
            s_write_data_files => s_write_serial_data_files
        else
            s_generate_grid => s_generate_parallel_grid
            s_read_grid_data_files => s_read_parallel_grid_data_files
            s_read_ic_data_files => s_read_parallel_ic_data_files
            s_write_data_files => s_write_parallel_data_files
        end if
 
    end subroutine s_initialize_modules
 
    !> Read an existing grid from data files or generate a new grid from user inputs.
    impure subroutine s_read_grid()
 
        if (old_grid) then
            call s_read_grid_data_files()
            call s_check_grid_data_files()
        else
            if (parallel_io .neqv. .true.) then
                call s_generate_grid()
            else
                if (proc_rank == 0) call s_generate_grid()
                call s_mpi_barrier()
                call s_read_grid_data_files()
                call s_check_grid_data_files()
            end if
        end if
 
    end subroutine s_read_grid
 
    !> Generate or read the initial condition, apply relaxation if needed, and write output data files.
    impure subroutine s_apply_initial_condition(start, finish)
 
        real(wp), intent(inout) :: start, finish
        integer                 :: j, k, l
        real(wp)                :: r2
 
        call cpu_time(start)
 
        if (old_ic) call s_read_ic_data_files(ic%q_cons_vf)
 
        call s_generate_initial_condition()
 
        ! hard-coded psi
        if (hyper_cleaning) then
    if (.not. (eqn_idx%psi > 0)) then
# 540 "/home/runner/work/MFC/MFC/src/pre_process/m_start_up.fpp"
        call s_mpi_abort("m_start_up.fpp:540: " // "Assertion failed: eqn_idx%psi > 0. " &
# 540 "/home/runner/work/MFC/MFC/src/pre_process/m_start_up.fpp"
                         & // "hyper_cleaning requires eqn_idx%psi to be set")
# 540 "/home/runner/work/MFC/MFC/src/pre_process/m_start_up.fpp"
    end if
            do l = 0, p
                do k = 0, n
                    do j = 0, m
                        r2 = x_cc(j)**2
                        if (n > 0) r2 = r2 + y_cc(k)**2
                        if (p > 0) r2 = r2 + z_cc(l)**2
                        ic%q_cons_vf(eqn_idx%psi)%sf(j, k, l) = 1.0e-2_wp*exp(-r2/(2.0_wp*0.05_wp**2))
                        ic%q_prim_vf(eqn_idx%psi)%sf(j, k, l) = ic%q_cons_vf(eqn_idx%psi)%sf(j, k, l)
                    end do
                end do
            end do
        end if
 
        if (relax) then
            if (proc_rank == 0) then
                print *, 'initial condition might have been altered due to enforcement of pTg-equilibrium (relax = "T" activated)'
            end if
 
            call s_infinite_relaxation_k(ic%q_cons_vf)
        end if
 
        if (chemistry) then
            call s_write_data_files(ic%q_cons_vf, ic%q_prim_vf, ic%bc_type, ic%q_T_sf)
        else
            call s_write_data_files(ic%q_cons_vf, ic%q_prim_vf, ic%bc_type)
        end if
 
        call cpu_time(finish)
 
    end subroutine s_apply_initial_condition
 
    !> Gather processor timing data and write elapsed wall-clock time to a summary file.
    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
        logical, intent(inout)                :: file_exists
 
        call s_mpi_barrier()
 
        if (num_procs > 1) then
            call mpi_bcast_time_step_values(proc_time, time_avg)
        end if
 
        if (proc_rank == 0) then
            time_final = 0._wp
            if (num_procs == 1) then
                time_final = time_avg
                print *, "Elapsed Time", time_final
            else
                time_final = maxval(proc_time)
                print *, "Elapsed Time", time_final
            end if
            inquire (file='pre_time_data.dat', exist=file_exists)
            if (file_exists) then
                open (1, file='pre_time_data.dat', position='append', status='old')
                write (1, *) num_procs, time_final
                close (1)
            else
                open (1, file='pre_time_data.dat', status='new')
                write (1, *) num_procs, time_final
                close (1)
            end if
        end if
 
    end subroutine s_save_data
 
    !> Initialize MPI, read and validate user inputs on rank 0, and decompose the computational domain.
    impure subroutine s_initialize_mpi_domain
 
        call s_mpi_initialize()
 
        if (proc_rank == 0) then
            call s_assign_default_values_to_user_inputs()
            call s_read_input_file()
            call s_check_input_file()
 
            print '(" Pre-processing a ", I0, "x", I0, "x", I0, " case on ", I0, " rank(s)")', m, n, p, num_procs
        end if
 
        ! Broadcasting the user inputs to all of the processors and performing the parallel computational domain decomposition.
        ! Neither procedure has to be carried out if pre-process is in fact not truly executed in parallel.
        call s_mpi_bcast_user_inputs()
        call s_initialize_parallel_io()
        call s_mpi_decompose_computational_domain()
 
    end subroutine s_initialize_mpi_domain
 
    !> Finalize all pre-process modules, deallocate resources, and shut down MPI.
    impure subroutine s_finalize_modules
 
        s_generate_grid => null()
        s_read_grid_data_files => null()
        s_read_ic_data_files => null()
        s_write_data_files => null()
 
        call s_finalize_mpi_common_module()
        call s_finalize_grid_module()
        call s_finalize_variables_conversion_module()
        call s_finalize_data_output_module()
        call s_finalize_global_parameters_module()
        call s_finalize_assign_variables_module()
        call s_finalize_perturbation_module()
        call s_finalize_boundary_common_module()
        if (relax) call s_finalize_relaxation_solver_module()
        call s_finalize_initial_condition_module()
        call s_mpi_finalize()
 
    end subroutine s_finalize_modules
 
end module m_start_up