diff --git a/src/common/m_helper.f90 b/src/common/m_helper.f90 index fbcc51b049..524bc46ec5 100644 --- a/src/common/m_helper.f90 +++ b/src/common/m_helper.f90 @@ -20,7 +20,8 @@ module m_helper private; public :: s_compute_finite_difference_coefficients, & s_comp_n_from_prim, & - s_comp_n_from_cons + s_comp_n_from_cons, & + s_int_to_str contains @@ -120,4 +121,11 @@ subroutine s_comp_n_from_cons(vftmp, nRtmp, ntmp, weight) end subroutine s_comp_n_from_cons + subroutine s_int_to_str(i, res) + character(len=*) :: res + integer,intent(in) :: i + write(res,'(I0)') i + res = trim(res) + end subroutine + end module m_helper diff --git a/src/common/m_mpi_common.fpp b/src/common/m_mpi_common.fpp index ea334771b1..fb38e8c6f4 100644 --- a/src/common/m_mpi_common.fpp +++ b/src/common/m_mpi_common.fpp @@ -310,14 +310,22 @@ contains end subroutine s_mpi_reduce_maxloc ! ----------------------------------- !> The subroutine terminates the MPI execution environment. - subroutine s_mpi_abort() ! --------------------------------------------- + subroutine s_mpi_abort(prnt) ! --------------------------------------------- + + character(len=*), intent(in), optional :: prnt + + if (present(prnt)) then + print*, prnt + call flush(6) + + end if #ifndef MFC_MPI stop 1 #else - + ! Terminating the MPI environment call MPI_ABORT(MPI_COMM_WORLD, 1, ierr) diff --git a/src/common/m_variables_conversion.fpp b/src/common/m_variables_conversion.fpp index 521a5423b7..2f0ed86a10 100644 --- a/src/common/m_variables_conversion.fpp +++ b/src/common/m_variables_conversion.fpp @@ -920,10 +920,9 @@ contains #else if (proc_rank == 0) then - print '(A)', 'Conversion from primitive to '// & + call s_mpi_abort('Conversion from primitive to '// & 'conservative variables not '// & - 'implemented. Exiting ...' - call s_mpi_abort() + 'implemented. Exiting ...') end if #endif diff --git a/src/post_process/m_data_input.f90 b/src/post_process/m_data_input.f90 index 5017576aa1..8b4cebfd9f 100644 --- a/src/post_process/m_data_input.f90 +++ b/src/post_process/m_data_input.f90 @@ -92,9 +92,8 @@ subroutine s_read_serial_data_files(t_step) ! ----------------------------- ! If the time-step directory is missing, the post-process exits. if (dir_check .neqv. .true.) then - print '(A)', 'Time-step folder '//trim(t_step_dir)// & - ' is missing. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Time-step folder '//trim(t_step_dir)// & + ' is missing. Exiting ...') end if ! Reading the Grid Data File for the x-direction =================== @@ -110,9 +109,8 @@ subroutine s_read_serial_data_files(t_step) ! ----------------------------- read (1) x_cb(-1:m) close (1) else - print '(A)', 'File x_cb.dat is missing in '// & - trim(t_step_dir)//'. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('File x_cb.dat is missing in '// & + trim(t_step_dir)//'. Exiting ...') end if ! Computing the cell-width distribution @@ -138,9 +136,8 @@ subroutine s_read_serial_data_files(t_step) ! ----------------------------- read (1) y_cb(-1:n) close (1) else - print '(A)', 'File y_cb.dat is missing in '// & - trim(t_step_dir)//'. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('File y_cb.dat is missing in '// & + trim(t_step_dir)//'. Exiting ...') end if ! Computing the cell-width distribution @@ -166,9 +163,8 @@ subroutine s_read_serial_data_files(t_step) ! ----------------------------- read (1) z_cb(-1:p) close (1) else - print '(A)', 'File z_cb.dat is missing in '// & - trim(t_step_dir)//'. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('File z_cb.dat is missing in '// & + trim(t_step_dir)//'. Exiting ...') end if ! Computing the cell-width distribution @@ -200,10 +196,9 @@ subroutine s_read_serial_data_files(t_step) ! ----------------------------- read (1) q_cons_vf(i)%sf(0:m, 0:n, 0:p) close (1) else - print '(A)', 'File q_cons_vf'//trim(file_num)// & + call s_mpi_abort('File q_cons_vf'//trim(file_num)// & '.dat is missing in '//trim(t_step_dir)// & - '. Exiting ...' - call s_mpi_abort() + '. Exiting ...') end if end do @@ -253,8 +248,7 @@ subroutine s_read_parallel_data_files(t_step) ! --------------------------- call MPI_FILE_READ(ifile, x_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else - print '(A)', 'File ', trim(file_loc), ' is missing. Exiting...' - call s_mpi_abort() + call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting...') end if ! Assigning local cell boundary locations @@ -275,8 +269,7 @@ subroutine s_read_parallel_data_files(t_step) ! --------------------------- call MPI_FILE_READ(ifile, y_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else - print '(A)', 'File ', trim(file_loc), ' is missing. Exiting...' - call s_mpi_abort() + call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting...') end if ! Assigning local cell boundary locations @@ -297,8 +290,7 @@ subroutine s_read_parallel_data_files(t_step) ! --------------------------- call MPI_FILE_READ(ifile, z_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else - print '(A)', 'File ', trim(file_loc), ' is missing. Exiting...' - call s_mpi_abort() + call s_mpi_abort( 'File '//trim(file_loc)//' is missing. Exiting...') end if ! Assigning local cell boundary locations @@ -364,8 +356,7 @@ subroutine s_read_parallel_data_files(t_step) ! --------------------------- call MPI_FILE_CLOSE(ifile, ierr) else - print '(A)', 'File ', trim(file_loc), ' is missing. Exiting...' - call s_mpi_abort() + call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting...') end if deallocate (x_cb_glb, y_cb_glb, z_cb_glb) diff --git a/src/post_process/m_data_output.f90 b/src/post_process/m_data_output.f90 index 439a22ad60..e2f2c64c54 100644 --- a/src/post_process/m_data_output.f90 +++ b/src/post_process/m_data_output.f90 @@ -483,10 +483,9 @@ subroutine s_open_formatted_database_file(t_step) ! -------------------- ! database slave file has been performed without errors. If this ! is not the case, the post-process exits. if (dbfile == -1) then - print '(A)', 'Unable to create Silo-HDF5 database '// & + call s_mpi_abort('Unable to create Silo-HDF5 database '// & 'slave file '//trim(file_loc)//'. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') end if ! Next, analogous steps to the ones above are carried out by the @@ -502,10 +501,9 @@ subroutine s_open_formatted_database_file(t_step) ! -------------------- DB_HDF5, dbroot) if (dbroot == -1) then - print '(A)', 'Unable to create Silo-HDF5 database '// & + call s_mpi_abort('Unable to create Silo-HDF5 database '// & 'master file '//trim(file_loc)//'. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') end if end if @@ -529,10 +527,9 @@ subroutine s_open_formatted_database_file(t_step) ! -------------------- ! Verifying that the creation and setup process of the formatted ! database slave file has been performed without errors. If this ! is not the case, the post-process exits. - if (err /= 0) then - print '(A)', 'Unable to create Binary database slave '// & - 'file '//trim(file_loc)//'. Exiting ...' - call s_mpi_abort() + if (err /= 0) then + call s_mpi_abort('Unable to create Binary database slave '// & + 'file '//trim(file_loc)//'. Exiting ...') end if ! Further defining the structure of the formatted database slave @@ -552,11 +549,10 @@ subroutine s_open_formatted_database_file(t_step) ! -------------------- open (dbroot, IOSTAT=err, FILE=trim(file_loc), & FORM='unformatted', STATUS='replace') - if (err /= 0) then - print '(A)', 'Unable to create Binary database '// & - 'master file '//trim(file_loc)// & - '. Exiting ...' - call s_mpi_abort() + if (err /= 0) then + call s_mpi_abort('Unable to create Binary database '// & + 'master file '//trim(file_loc)// & + '. Exiting ...') end if write (dbroot) m_root, 0, 0, dbvars diff --git a/src/post_process/m_derived_variables.fpp b/src/post_process/m_derived_variables.fpp index 8de0259f0a..49b0024c63 100644 --- a/src/post_process/m_derived_variables.fpp +++ b/src/post_process/m_derived_variables.fpp @@ -365,22 +365,6 @@ contains integer :: i, j, k - ! Solve linear system using Intel MKL (Hooke) -! nrhs = 1 -! lda = ndim -! ldb = ndim -! -! CALL DGESV(ndim, nrhs, A, lda, ipiv, b, ldb, info) -! -! DO i = 1, ndim -! sol(i) = b(i) -! END DO -! -! IF (info /= 0) THEN -! PRINT '(A)', 'Trouble solving linear system' -! CALL s_mpi_abort() -! END IF - ! Solve linear system using own linear solver (Thomson/Darter/Comet/Stampede) ! Forward elimination do i = 1, ndim diff --git a/src/post_process/m_start_up.f90 b/src/post_process/m_start_up.f90 index 84cb31bdbf..1638728000 100644 --- a/src/post_process/m_start_up.f90 +++ b/src/post_process/m_start_up.f90 @@ -14,10 +14,14 @@ module m_start_up use m_mpi_proxy !< Message passing interface (MPI) module proxy use m_compile_specific + + use m_helper ! ========================================================================== implicit none + character(len=5) :: iStr + contains !> Reads the configuration file post_process.inp, in order @@ -66,9 +70,8 @@ subroutine s_read_input_file() ! --------------------------------------- read (1, NML=user_inputs, iostat=iostatus) if (iostatus /= 0) then - print '(A)', 'Invalid line in post_process.inp. It is '// & - 'likely due to a datatype mismatch. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Invalid line in post_process.inp. It is '// & + 'likely due to a datatype mismatch. Exiting ...') end if close (1) @@ -77,8 +80,7 @@ subroutine s_read_input_file() ! --------------------------------------- n_glb = n p_glb = p else - print '(A)', 'File post_process.inp is missing. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('File post_process.inp is missing. Exiting ...') end if end subroutine s_read_input_file ! ------------------------------------- @@ -110,123 +112,100 @@ subroutine s_check_input_file() ! -------------------------------------- ! Constraint on the location of the case directory if (dir_check .neqv. .true.) then - print '(A)', 'Unsupported choice for the value of '// & - 'case_dir. Exiting ...' - call s_mpi_abort() - + call s_mpi_abort('Unsupported choice for the value of '// & + 'case_dir. Exiting ...') ! Constraints on dimensionality and the number of cells for the grid elseif (m <= 0) then - print '(A)', 'Unsupported choice for the value of m. '// & - 'Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of m. '// & + 'Exiting ...') elseif (n < 0) then - print '(A)', 'Unsupported choice for the value of n. '// & - 'Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of n. '// & + 'Exiting ...') elseif (p < 0) then - print '(A)', 'Unsupported choice for the value of p. '// & - 'Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of p. '// & + 'Exiting ...') elseif (cyl_coord .and. p > 0 .and. mod(p, 2) /= 1) then - print '(A)', 'Unsupported choice for the value of p. '// & - 'Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of p. '// & + 'Exiting ...') elseif (n == 0 .and. p > 0) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for n and p. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for n and p. Exiting ...') elseif ((m + 1)*(n + 1)*(p + 1) & < & 2**(min(1, m) + min(1, n) + min(1, p))*num_procs) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for num_procs, m, n and p. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') ! Constraints on the time-stepping parameters elseif (t_step_start < 0) then - print '(A)', 'Unsupported choice for the value of '// & - 't_step_start. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 't_step_start. Exiting ...') elseif (t_step_stop < t_step_start) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for t_step_start and t_step_stop. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (t_step_save > t_step_stop - t_step_start) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for t_step_start, t_step_stop and '// & - 't_step_save. Exiting ...' - call s_mpi_abort() + 't_step_save. Exiting ...') ! Constraints on model equations and number of fluids in the flow elseif (all(model_eqns /= (/1, 2, 3, 4/))) then - print '(A)', 'Unsupported value of model_eqns. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of model_eqns. Exiting ...') elseif (num_fluids /= dflt_int & .and. & (num_fluids < 1 .or. num_fluids > num_fluids)) then - print '(A)', 'Unsupported value of num_fluids. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of num_fluids. Exiting ...') elseif ((model_eqns == 1 .and. num_fluids /= dflt_int) & .or. & (model_eqns == 2 .and. num_fluids == dflt_int) & .or. & (model_eqns == 3 .and. num_fluids == dflt_int)) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'model_eqns and num_fluids. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (model_eqns == 1 .and. adv_alphan) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'model_eqns and adv_alphan. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') ! Constraints on the order of the WENO scheme elseif (weno_order /= 1 .and. weno_order /= 3 & .and. & weno_order /= 5) then - print '(A)', 'Unsupported choice for the value of '// & - 'weno_order. Exiting ...' - call s_mpi_abort() - elseif (m + 1 < weno_order) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for m and weno_order. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'weno_order. Exiting ...') + elseif (m + 1 < weno_order) then + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for m and weno_order. Exiting ...') elseif (n > 0 .and. n + 1 < weno_order) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for n and weno_order. Exiting ...' - call s_mpi_abort() - elseif (p > 0 .and. p + 1 < weno_order) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for p and weno_order. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for n and weno_order. Exiting ...') + elseif (p > 0 .and. p + 1 < weno_order) then + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for p and weno_order. Exiting ...') elseif ((m + 1)*(n + 1)*(p + 1) & < & weno_order**(min(1, m) + min(1, n) + min(1, p))*num_procs) & then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for num_procs, m, n, p and '// & - 'weno_order. Exiting ...' - call s_mpi_abort() + 'weno_order. Exiting ...') ! Constraints on the boundary conditions in the x-direction elseif (bc_x%beg < -12 .or. bc_x%beg > -1) then - print '(A)', 'Unsupported choice for the value of '// & - 'bc_x%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'bc_x%beg. Exiting ...') elseif (bc_x%end < -12 .or. bc_x%end > -1) then - print '(A)', 'Unsupported choice for the value of '// & - 'bc_x%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'bc_x%end. Exiting ...') elseif ((bc_x%beg == -1 .and. bc_x%end /= -1) & .or. & (bc_x%end == -1 .and. bc_x%beg /= -1)) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for bc_x%beg and bc_x%end. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') ! Constraints on the boundary conditions in the y-direction elseif (bc_y%beg /= dflt_int & @@ -240,153 +219,134 @@ subroutine s_check_input_file() ! -------------------------------------- (cyl_coord .and. p > 0 & .and. & (bc_y%beg < -13 .or. bc_y%beg > -1)))) then - print '(A)', 'Unsupported choice for the value of '// & - 'bc_y%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'bc_y%beg. Exiting ...') elseif (bc_y%end /= dflt_int & .and. & (bc_y%end < -12 .or. bc_y%end > -1)) then - print '(A)', 'Unsupported choice for the value of '// & - 'bc_y%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'bc_y%end. Exiting ...') elseif ((n == 0 .and. bc_y%beg /= dflt_int) & .or. & (n > 0 .and. bc_y%beg == dflt_int)) then - print '(A)', 'Unsupported choice for the value of n and '// & - 'bc_y%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of n and '// & + 'bc_y%beg. Exiting ...') elseif ((n == 0 .and. bc_y%end /= dflt_int) & .or. & - (n > 0 .and. bc_y%end == dflt_int)) then - print '(A)', 'Unsupported choice for the value of n and '// & - 'bc_y%end. Exiting ...' - call s_mpi_abort() + (n > 0 .and. bc_y%end == dflt_int)) then + call s_mpi_abort('Unsupported choice for the value of n and '// & + 'bc_y%end. Exiting ...') elseif (n > 0 & .and. & ((bc_y%beg == -1 .and. bc_y%end /= -1) & .or. & (bc_y%end == -1 .and. bc_y%beg /= -1))) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for n, bc_y%beg and bc_y%end. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') ! Constraints on the boundary conditions in the z-direction elseif (bc_z%beg /= dflt_int & .and. & (bc_z%beg < -12 .or. bc_z%beg > -1)) then - print '(A)', 'Unsupported choice for the value of '// & - 'bc_z%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'bc_z%beg. Exiting ...') elseif (bc_z%end /= dflt_int & .and. & - (bc_z%end < -12 .or. bc_z%end > -1)) then - print '(A)', 'Unsupported choice for the value of '// & - 'bc_z%end. Exiting ...' - call s_mpi_abort() + (bc_z%end < -12 .or. bc_z%end > -1)) then + call s_mpi_abort('Unsupported choice for the value of '// & + 'bc_z%end. Exiting ...') elseif ((p == 0 .and. bc_z%beg /= dflt_int) & .or. & - (p > 0 .and. bc_z%beg == dflt_int)) then - print '(A)', 'Unsupported choice for the value of p and '// & - 'bc_z%beg. Exiting ...' - call s_mpi_abort() + (p > 0 .and. bc_z%beg == dflt_int)) then + call s_mpi_abort('Unsupported choice for the value of p and '// & + 'bc_z%beg. Exiting ...') elseif ((p == 0 .and. bc_z%end /= dflt_int) & .or. & (p > 0 .and. bc_z%end == dflt_int)) then - print '(A)', 'Unsupported choice for the value of p and '// & - 'bc_z%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of p and '// & + 'bc_z%end. Exiting ...') elseif (p > 0 & .and. & ((bc_z%beg == -1 .and. bc_z%end /= -1) & .or. & - (bc_z%end == -1 .and. bc_z%beg /= -1))) then - print '(A)', 'Unsupported choice of the combination of '// & + (bc_z%end == -1 .and. bc_z%beg /= -1))) then + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for p, bc_z%beg and bc_z%end. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') end if ! Constraints on the stiffened equation of state fluids parameters do i = 1, num_fluids - + call s_int_to_str(i,iStr) if (fluid_pp(i)%gamma /= dflt_real & .and. & fluid_pp(i)%gamma <= 0d0) then - print '(A,I0,A)', 'Unsupported value of '// & - 'fluid_pp(', i, ')%'// & - 'gamma. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of '// & + 'fluid_pp('//trim(iStr)//')%'// & + 'gamma. Exiting ...') elseif (model_eqns == 1 & .and. & fluid_pp(i)%gamma /= dflt_real) then - print '(A,I0,A)', 'Unsupported combination '// & + call s_mpi_abort('Unsupported combination '// & 'of values of model_eqns '// & - 'and fluid_pp(', i, ')%'// & - 'gamma. Exiting ...' - call s_mpi_abort() + 'and fluid_pp('//trim(iStr)//')%'// & + 'gamma. Exiting ...') elseif ((i <= num_fluids + bub_fac .and. fluid_pp(i)%gamma <= 0d0) & .or. & (i > num_fluids + bub_fac .and. fluid_pp(i)%gamma /= dflt_real)) & then - print '(A,I0,A)', 'Unsupported combination '// & + call s_mpi_abort('Unsupported combination '// & 'of values of num_fluids '// & - 'and fluid_pp(', i, ')%'// & - 'gamma. Exiting ...' - call s_mpi_abort() + 'and fluid_pp('//trim(iStr)//')%'// & + 'gamma. Exiting ...') elseif (fluid_pp(i)%pi_inf /= dflt_real & .and. & fluid_pp(i)%pi_inf < 0d0) then - print '(A,I0,A)', 'Unsupported value of '// & - 'fluid_pp(', i, ')%'// & - 'pi_inf. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of '// & + 'fluid_pp('//trim(iStr)//')%'// & + 'pi_inf. Exiting ...') elseif (model_eqns == 1 & .and. & fluid_pp(i)%pi_inf /= dflt_real) then - print '(A,I0,A)', 'Unsupported combination '// & + call s_mpi_abort('Unsupported combination '// & 'of values of model_eqns '// & - 'and fluid_pp(', i, ')%'// & - 'pi_inf. Exiting ...' - call s_mpi_abort() + 'and fluid_pp('//trim(iStr)//')%'// & + 'pi_inf. Exiting ...') elseif ((i <= num_fluids + bub_fac .and. fluid_pp(i)%pi_inf < 0d0) & .or. & (i > num_fluids + bub_fac .and. fluid_pp(i)%pi_inf /= dflt_real)) & then - print '(A,I0,A)', 'Unsupported combination '// & + call s_mpi_abort('Unsupported combination '// & 'of values of num_fluids '// & - 'and fluid_pp(', i, ')%'// & - 'pi_inf. Exiting ...' - call s_mpi_abort() + 'and fluid_pp('//trim(iStr)//')%'// & + 'pi_inf. Exiting ...') end if end do ! Constraints on the format of the formatted database file(s) - if (format /= 1 .and. format /= 2) then - print '(A)', 'Unsupported choice for the value of format. '// & - 'Exiting ...' - call s_mpi_abort() + if (format /= 1 .and. format /= 2) then + call s_mpi_abort('Unsupported choice for the value of format. '// & + 'Exiting ...') ! Constraints on the precision of the formatted database file(s) elseif (precision /= 1 .and. precision /= 2) then - print '(A)', 'Unsupported choice for the value of '// & - 'precision. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'precision. Exiting ...') ! Constraints on the option to coarsen the formatted database files elseif (coarsen_silo .and. format /= 1) then - print '(A)', 'Unsupported combination of values of format '// & - 'and coarsen_silo. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of values of format '// & + 'and coarsen_silo. Exiting ...') elseif (coarsen_silo .and. n == 0) then - print '(A)', 'Unsupported combination of values of n '// & - 'and coarsen_silo. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of values of n '// & + 'and coarsen_silo. Exiting ...') end if ! Constraints on the post-processing of the partial densities do i = 1, num_fluids + call s_int_to_str(i,iStr) if (((i > num_fluids .or. model_eqns == 1) & .and. & alpha_rho_wrt(i)) & @@ -394,63 +354,53 @@ subroutine s_check_input_file() ! -------------------------------------- ((i <= num_fluids .and. model_eqns == 1) & .and. & alpha_rho_wrt(i))) then - print '(A,I0,A)', 'Unsupported choice of the '// & + call s_mpi_abort('Unsupported choice of the '// & 'combination of values for '// & 'model_eqns, num_fluids and '// & - 'alpha_rho_wrt(', i, '). Exiting ...' - call s_mpi_abort() + 'alpha_rho_wrt('//trim(iStr)//'). Exiting ...') end if end do ! Constraints on the post-processing of the momentum if (n == 0 .and. mom_wrt(2)) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for n and mom_wrt(2). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for n and mom_wrt(2). Exiting ...') elseif (n == 0 .and. mom_wrt(3)) then - print '(A)', 'Unsupported cohice of the combination of '// & - 'values for n and mom_wrt(3). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported cohice of the combination of '// & + 'values for n and mom_wrt(3). Exiting ...') elseif (p == 0 .and. mom_wrt(3)) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for p and mom_wrt(3). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for p and mom_wrt(3). Exiting ...') ! Constraints on the post-processing of the velocity elseif (n == 0 .and. vel_wrt(2)) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for n and vel_wrt(2). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for n and vel_wrt(2). Exiting ...') elseif (n == 0 .and. vel_wrt(3)) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for n and vel_wrt(3). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for n and vel_wrt(3). Exiting ...') elseif (p == 0 .and. vel_wrt(3)) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for p and vel_wrt(3). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for p and vel_wrt(3). Exiting ...') end if ! Constraints on the post-processing of the flux limiter function if (n == 0 .and. flux_wrt(2)) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for n and flux_wrt(2). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for n and flux_wrt(2). Exiting ...') elseif (n == 0 .and. flux_wrt(3)) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for n and flux_wrt(3). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for n and flux_wrt(3). Exiting ...') elseif (p == 0 .and. flux_wrt(3)) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for p and flux_wrt(3). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for p and flux_wrt(3). Exiting ...') elseif (all(flux_lim /= (/dflt_int, 1, 2, 3, 4, 5, 6, 7/))) then - print '(A)', 'Unsupported value of flux_lim. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of flux_lim. Exiting ...') end if ! Constraints on the post-processing of the volume fractions do i = 1, num_fluids + call s_int_to_str(i,iStr) if (((i > num_fluids .or. model_eqns == 1) & .and. & alpha_wrt(i)) & @@ -458,41 +408,34 @@ subroutine s_check_input_file() ! -------------------------------------- ((i <= num_fluids .and. model_eqns == 1) & .and. & alpha_wrt(i))) then - print '(A,I0,A)', 'Unsupported choice of the '// & + call s_mpi_abort('Unsupported choice of the '// & 'combination of values for '// & 'model_eqns, num_fluids and '// & - 'alpha_wrt(', i, '). Exiting ...' - call s_mpi_abort() + 'alpha_wrt('//trim(iStr)//'). Exiting ...') end if end do ! Constraints on the post-processing of the vorticity if (n == 0 .and. omega_wrt(1)) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for n and omega_wrt(1). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for n and omega_wrt(1). Exiting ...') elseif (n == 0 .and. omega_wrt(2)) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for n and omega_wrt(2). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for n and omega_wrt(2). Exiting ...') elseif (n == 0 .and. omega_wrt(3)) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for n and omega_wrt(3). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for n and omega_wrt(3). Exiting ...') elseif (p == 0 .and. omega_wrt(1)) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for p and omega_wrt(1). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for p and omega_wrt(1). Exiting ...') elseif (p == 0 .and. omega_wrt(2)) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for p and omega_wrt(2). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for p and omega_wrt(2). Exiting ...') ! Constraints on post-processing of numerical Schlieren function elseif (n == 0 .and. schlieren_wrt) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for n and schlieren_wrt. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for n and schlieren_wrt. Exiting ...') ! Constraints on post-processing combination of flow variables elseif ((any(alpha_rho_wrt) .neqv. .true.) & @@ -513,19 +456,18 @@ subroutine s_check_input_file() ! -------------------------------------- (any(alpha_wrt) .neqv. .true.) & .and. & (any(omega_wrt) .neqv. .true.)) then - print '(A)', 'None of the flow variables have been '// & - 'selected for post-process. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('None of the flow variables have been '// & + 'selected for post-process. Exiting ...') end if ! Constraints on the coefficients of numerical Schlieren function do i = 1, num_fluids + call s_int_to_str(i,iStr) if (schlieren_alpha(i) /= dflt_real & .and. & schlieren_alpha(i) <= 0d0) then - print '(A,I0,A)', 'Unsupported choice for the value of '// & - 'schlieren_alpha(', i, '). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'schlieren_alpha('//trim(iStr)//'). Exiting ...') elseif (((i > num_fluids .or. (schlieren_wrt .neqv. .true.)) & .and. & schlieren_alpha(i) /= dflt_real) & @@ -533,11 +475,10 @@ subroutine s_check_input_file() ! -------------------------------------- ((i <= num_fluids .and. schlieren_wrt) & .and. & schlieren_alpha(i) <= 0d0)) then - print '(A,I0,A)', 'Unsupported choice of the '// & + call s_mpi_abort('Unsupported choice of the '// & 'combination of values for '// & 'num_fluids, schlieren_wrt and '// & - 'schlieren_alpha(', i, '). Exiting ...' - call s_mpi_abort() + 'schlieren_alpha('//trim(iStr)//'). Exiting ...') end if end do @@ -545,29 +486,14 @@ subroutine s_check_input_file() ! -------------------------------------- if (fd_order /= dflt_int & .and. & fd_order /= 1 .and. fd_order /= 2 .and. fd_order /= 4) then - print '(A)', 'Unsupported choice for the value of '// & - 'fd_order. Exiting ...' - call s_mpi_abort() - ! ELSEIF( (omega_wrt(1) .NEQV. .TRUE.) & - ! .AND. & - ! (omega_wrt(2) .NEQV. .TRUE.) & - ! .AND. & - ! (omega_wrt(3) .NEQV. .TRUE.) & - ! .AND. & - ! !(schlieren_wrt .NEQV. .TRUE.) & - ! ! .AND. & - ! fd_order /= dflt_int ) THEN - ! PRINT '(A)', 'AA Unsupported choice of the combination of ' // & - ! 'values for omega_wrt, schlieren_wrt and ' // & - ! 'fd_order. Exiting ...' - ! CALL s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'fd_order. Exiting ...') elseif ((any(omega_wrt) .or. schlieren_wrt) & .and. & fd_order == dflt_int) then - print '(A)', 'BB Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for omega_wrt, schlieren_wrt and '// & - 'fd_order. Exiting ...' - call s_mpi_abort() + 'fd_order. Exiting ...') end if end subroutine s_check_input_file ! ------------------------------------ diff --git a/src/pre_process/m_check_patches.fpp b/src/pre_process/m_check_patches.fpp index 84a29d9d38..7928a1df4f 100644 --- a/src/pre_process/m_check_patches.fpp +++ b/src/pre_process/m_check_patches.fpp @@ -18,12 +18,15 @@ module m_check_patches use m_compile_specific + use m_helper ! ========================================================================== implicit none private; public :: s_check_patches + character(len=10) :: iStr + contains subroutine s_check_patches() @@ -35,7 +38,7 @@ contains do i = 1, num_patches_max if (i <= num_patches) then ! call s_check_patch_geometry(i) - + call s_int_to_str(i, iStr) ! Constraints on the geometric initial condition patch parameters if (patch_icpp(i)%geometry == 1) then call s_check_line_segment_patch_geometry(i) @@ -76,19 +79,17 @@ contains elseif (patch_icpp(i)%geometry == 19) then print *, '3d var circle' else - print '(A,I0,A)', 'Unsupported choice of the '// & - 'geometry of active patch ', i, & - ' detected. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the '// & + 'geometry of active patch '//trim(iStr)//& + ' detected. Exiting ...') end if else if (patch_icpp(i)%geometry == dflt_int) then call s_check_inactive_patch_geometry(i) else - print '(A,I0,A)', 'Unsupported choice of the '// & - 'geometry of inactive patch ', i, & - ' detected. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the '// & + 'geometry of inactive patch '//trim(iStr)//& + ' detected. Exiting ...') end if end if end do @@ -136,6 +137,7 @@ contains subroutine s_check_line_segment_patch_geometry(patch_id) ! ------------- integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the line segment patch if (n > 0 .or. patch_icpp(patch_id)%length_x <= 0d0 & @@ -144,10 +146,9 @@ contains .or. & cyl_coord) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'geometric parameters of line segment '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -160,6 +161,7 @@ contains subroutine s_check_circle_patch_geometry(patch_id) ! ------------------- integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the circle patch if (n == 0 .or. p > 0 .or. patch_icpp(patch_id)%radius <= 0d0 & @@ -167,11 +169,10 @@ contains patch_icpp(patch_id)%x_centroid == dflt_real & .or. & patch_icpp(patch_id)%y_centroid == dflt_real) then - - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + + call s_mpi_abort('Inconsistency(ies) detected in '// & 'geometric parameters of circle '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -184,6 +185,7 @@ contains subroutine s_check_rectangle_patch_geometry(patch_id) ! ---------------- integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the rectangle patch if (n == 0 .or. p > 0 & @@ -196,10 +198,9 @@ contains .or. & patch_icpp(patch_id)%length_y <= 0d0) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'geometric parameters of rectangle '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -212,6 +213,7 @@ contains subroutine s_check_line_sweep_patch_geometry(patch_id) ! --------------- integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the line sweep patch if (n == 0 .or. p > 0 & @@ -226,10 +228,9 @@ contains .or. & patch_icpp(patch_id)%normal(3) /= dflt_real) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'geometric parameters of line sweep '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -242,6 +243,7 @@ contains subroutine s_check_ellipse_patch_geometry(patch_id) ! ------------------ integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the ellipse patch if (n == 0 .or. p > 0 & @@ -256,10 +258,9 @@ contains .or. & patch_icpp(patch_id)%radii(3) /= dflt_real) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'geometric parameters of ellipse '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -272,6 +273,7 @@ contains subroutine s_check_isentropic_vortex_patch_geometry(patch_id) ! -------- integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the isentropic vortex patch geometric parameters if (n == 0 .or. p > 0 .or. model_eqns == 2 & @@ -282,10 +284,9 @@ contains .or. & patch_icpp(patch_id)%beta <= 0d0) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & - 'geometric parameters of isentropic '// & - 'vortex patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Inconsistency(ies) detected in '// & + 'geometric parameters of isentropic '// & + 'vortex patch '//trim(iStr)//'. Exiting ...') end if @@ -298,6 +299,7 @@ contains subroutine s_check_1D_analytical_patch_geometry(patch_id) ! --------------- integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the analytical patch if (n > 0 .or. p > 0 & @@ -308,10 +310,9 @@ contains .or. & patch_icpp(patch_id)%length_x <= 0d0) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'geometric parameters of 1D analytical '// & - 'patch ', patch_id, '. Exiting...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting...') end if end subroutine s_check_1D_analytical_patch_geometry ! --------------------- @@ -322,6 +323,7 @@ contains subroutine s_check_2D_analytical_patch_geometry(patch_id) ! --------------- integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the analytical patch if (n == 0 .or. p > 0 & @@ -333,11 +335,10 @@ contains patch_icpp(patch_id)%length_x <= 0d0 & .or. & patch_icpp(patch_id)%length_y <= 0d0) then - - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + + call s_mpi_abort('Inconsistency(ies) detected in '// & 'geometric parameters of 2D analytical '// & - 'patch ', patch_id, '. Exiting...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting...') end if end subroutine s_check_2D_analytical_patch_geometry ! --------------------- @@ -348,6 +349,7 @@ contains subroutine s_check_3D_analytical_patch_geometry(patch_id) ! --------------- integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the analytical patch if (p == 0 & @@ -364,10 +366,9 @@ contains .or. & patch_icpp(patch_id)%length_z <= 0d0) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'geometric parameters of 3D analytical '// & - 'patch ', patch_id, '. Exiting...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting...') end if end subroutine s_check_3D_analytical_patch_geometry ! --------------------- @@ -378,6 +379,7 @@ contains subroutine s_check_sphere_patch_geometry(patch_id) ! ------------------- integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the sphere patch if (p == 0 & @@ -390,10 +392,9 @@ contains .or. & patch_icpp(patch_id)%z_centroid == dflt_real) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'geometric parameters of sphere '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -406,6 +407,7 @@ contains subroutine s_check_spherical_harmonic_patch_geometry(patch_id) ! ------- integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the spherical harmonic patch if (p == 0 & @@ -424,10 +426,9 @@ contains .or. & patch_icpp(patch_id)%beta > patch_icpp(patch_id)%epsilon) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'geometric parameters of spherical '// & - 'harmonic patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'harmonic patch '//trim(iStr)//'. Exiting ...') end if @@ -441,6 +442,7 @@ contains ! Patch identifier integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the cuboid patch if (p == 0 & @@ -457,10 +459,9 @@ contains .or. & patch_icpp(patch_id)%length_z <= 0d0) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'geometric parameters of cuboid '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -474,6 +475,7 @@ contains ! Patch identifier integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the cylinder patch if (p == 0 & @@ -502,10 +504,9 @@ contains .or. & patch_icpp(patch_id)%radius <= 0d0) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'geometric parameters of cylinder '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -519,6 +520,7 @@ contains ! Patch identifier integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the plane sweep patch if (p == 0 & @@ -535,10 +537,9 @@ contains .or. & patch_icpp(patch_id)%normal(3) == dflt_real) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'geometric parameters of plane sweep '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -551,6 +552,7 @@ contains subroutine s_check_ellipsoid_patch_geometry(patch_id) ! ---------------- integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the ellipsoid patch if (p == 0 & @@ -567,10 +569,9 @@ contains .or. & patch_icpp(patch_id)%radii(3) == dflt_real) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'geometric parameters of ellipsoid '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -582,6 +583,7 @@ contains subroutine s_check_inactive_patch_geometry(patch_id) ! ----------------- integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the geometric parameters of the inactive patch if (patch_icpp(patch_id)%x_centroid /= dflt_real & @@ -614,10 +616,9 @@ contains .or. & patch_icpp(patch_id)%radii(3) /= dflt_real) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'geometric parameters of inactive '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -630,16 +631,16 @@ contains subroutine s_check_active_patch_alteration_rights(patch_id) ! ---------- integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the alteration rights of an active patch if (patch_icpp(patch_id)%alter_patch(0) .eqv. .false. & .or. & any(patch_icpp(patch_id)%alter_patch(patch_id:))) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'alteration rights of active '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -653,16 +654,16 @@ contains ! Patch identifier integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the alteration rights of an inactive patch if (patch_icpp(patch_id)%alter_patch(0) .eqv. .false. & .or. & any(patch_icpp(patch_id)%alter_patch(1:))) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'alteration rights of inactive '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -675,6 +676,7 @@ contains subroutine s_check_supported_patch_smoothing(patch_id) ! --------------- integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the smoothing parameters of a supported patch if ((patch_icpp(patch_id)%smoothen & @@ -691,10 +693,9 @@ contains .or. & patch_icpp(patch_id)%smooth_coeff /= dflt_real))) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'smoothing parameters of supported '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -708,6 +709,7 @@ contains ! Patch identifier integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the smoothing parameters of an unsupported patch if (patch_icpp(patch_id)%smoothen & @@ -716,10 +718,9 @@ contains .or. & patch_icpp(patch_id)%smooth_coeff /= dflt_real) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'smoothing parameters of unsupported '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -732,6 +733,7 @@ contains subroutine s_check_active_patch_primitive_variables(patch_id) ! -------- integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the primitive variables of an active patch if (patch_icpp(patch_id)%vel(1) == dflt_real & @@ -757,19 +759,11 @@ contains .or. & (model_eqns == 2 & .and. & - (any(patch_icpp(patch_id)%alpha_rho(1:num_fluids) < 0d0) & - ! .OR. & - !ANY(patch_icpp(patch_id)%alpha(1: adv_idx%end & - ! - E_idx ) < 0d0) & - ! .OR. & - !SUM(patch_icpp(patch_id)%alpha(1: adv_idx%end & - ! - E_idx ))> 1d0) - ))) then - - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + (any(patch_icpp(patch_id)%alpha_rho(1:num_fluids) < 0d0) ))) then + + call s_mpi_abort('Inconsistency(ies) detected in '// & 'primitive variables of active '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -783,10 +777,9 @@ contains .or. & (patch_icpp(patch_id)%alpha(num_fluids) == dflt_real)) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'primitive variables of active '// & - 'patch ', patch_id, '. Exiting ...' - !CALL s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if @@ -801,6 +794,7 @@ contains subroutine s_check_inactive_patch_primitive_variables(patch_id) ! ------ integer, intent(IN) :: patch_id + call s_int_to_str(patch_id, iStr) ! Constraints on the primitive variables of an inactive patch if (any(patch_icpp(patch_id)%alpha_rho /= dflt_real) & @@ -817,10 +811,9 @@ contains .or. & patch_icpp(patch_id)%pi_inf /= dflt_real) then - print '(A,I0,A)', 'Inconsistency(ies) detected in '// & + call s_mpi_abort('Inconsistency(ies) detected in '// & 'primitive variables of inactive '// & - 'patch ', patch_id, '. Exiting ...' - call s_mpi_abort() + 'patch '//trim(iStr)//'. Exiting ...') end if diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index 1750e81368..792f117ee2 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -23,6 +23,8 @@ module m_start_up use m_compile_specific use m_check_patches + + use m_helper ! ========================================================================== implicit none @@ -67,6 +69,8 @@ module m_start_up !! Possible location of time-step folder containing preexisting grid and/or !! conservative variables data to be used as starting point for pre-process + character(len=5) :: iStr !< for int to string conversion + 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() @@ -116,9 +120,8 @@ contains STATUS='old', ACTION='read') read (1, NML=user_inputs, iostat=iostatus) if (iostatus /= 0) then - print '(A)', 'Invalid line in pre_process.inp. It is '// & - 'likely due to a datatype mismatch. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Invalid line in pre_process.inp. It is '// & + 'likely due to a datatype mismatch. Exiting ...') end if close (1) ! Store m,n,p into global m,n,p @@ -126,8 +129,7 @@ contains n_glb = n p_glb = p else - print '(A)', 'File pre_process.inp is missing. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('File pre_process.inp is missing. Exiting ...') end if end subroutine s_read_input_file ! ------------------------------------- @@ -162,139 +164,114 @@ contains ! Startup checks for bubbles and bubble variables if (bubbles .and. (model_eqns /= 4 .and. model_eqns /= 2)) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'bubbles and model_eqns. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (bubbles .and. nb < 1) then - print '(A)', 'The Ensemble-Averaged Bubble Model requires nb >= 1' - call s_mpi_abort() + call s_mpi_abort('The Ensemble-Averaged Bubble Model requires nb >= 1' // & + 'Exotomg ...') elseif (bubbles .and. polydisperse .and. (nb == 1)) then - print '(A)', 'Polydisperse bubble dynamics requires nb > 1 '// & - 'Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Polydisperse bubble dynamics requires nb > 1 '// & + 'Exiting ...') elseif (bubbles .and. polydisperse .and. (mod(nb, 2) == 0)) then - print '(A)', 'nb must be odd '// & - 'Exiting ...' - call s_mpi_abort() + call s_mpi_abort('nb must be odd '// & + 'Exiting ...') elseif (model_eqns == 4 .and. (rhoref == dflt_real)) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'bubbles and rhoref. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (model_eqns == 4 .and. (pref == dflt_real)) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'bubbles and pref. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (model_eqns == 4 .and. (num_fluids > 1)) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'model_eqns and num_fluids. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (bubbles .and. (R0ref == dflt_real)) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'bubbles and R0ref. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (bubbles .and. (nb == dflt_int)) then - print '(a)', 'unsupported combination of values of '// & + call s_mpi_abort('unsupported combination of values of '// & 'bubbles and nb. '// & - 'exiting ...' - call s_mpi_abort() + 'exiting ...') elseif (bubbles .and. (thermal > 3)) then - print '(a)', 'unsupported combination of values of '// & + call s_mpi_abort('unsupported combination of values of '// & 'bubbles and thermal. '// & - 'exiting ...' - call s_mpi_abort() + 'exiting ...') elseif (hypoelasticity .and. (model_eqns /= 2)) then - print '(a)', 'hypoelasticity requires model_eqns = 2'// & - 'exiting ...' - call s_mpi_abort() + call s_mpi_abort('hypoelasticity requires model_eqns = 2'// & + 'exiting ...') end if ! Constraint on the location of the case directory if (dir_check .neqv. .true.) then - print '(A)', 'Unsupported choice for the value of '// & - 'case_dir.' 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() + call s_mpi_abort('Unsupported choice for the value of case_dir.' // & + 'Exiting ...') ! Constraints on the use of a preexisting grid and initial condition elseif ((old_grid .neqv. .true.) .and. old_ic) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for old_grid and old_ic. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for old_grid and old_ic. Exiting ...') elseif ((old_grid .or. old_ic) .and. t_step_old == dflt_int) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for old_grid and old_ic and t_step_old. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for old_grid and old_ic and t_step_old. Exiting ...') ! Constraints on dimensionality and the number of cells for the grid elseif (m <= 0) then - print '(A)', 'Unsupported choice for the value of m. '// & - 'Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of m. '// & + 'Exiting ...') elseif (n < 0) then - print '(A)', 'Unsupported choice for the value of n. '// & - 'Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of n. '// & + 'Exiting ...') elseif (p < 0) then - print '(A)', 'Unsupported choice for the value of p. '// & - 'Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of p. '// & + 'Exiting ...') elseif (cyl_coord .and. p > 0 .and. mod(p, 2) /= 1) then - print '(A)', 'Unsupported choice for the value of p. '// & + call s_mpi_abort('Unsupported choice for the value of p. '// & 'Total number of cells in azimuthal direction '// & - 'must be an even number. Exiting ...' - call s_mpi_abort() + 'must be an even number. Exiting ...') elseif (n == 0 .and. p > 0) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for n and p. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for n and p. Exiting ...') elseif ((m + 1)*(n + 1)*(p + 1) & < & 2**(min(1, m) + min(1, n) + min(1, p))*num_procs) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for num_procs, m, n and p. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') ! Constraints on domain boundaries locations in the x-direction elseif ((old_grid .and. x_domain%beg /= dflt_real) & .or. & ((old_grid .neqv. .true.) .and. & x_domain%beg == dflt_real)) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for old_grid and x_domain%beg. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif ((old_grid .and. x_domain%end /= dflt_real) & .or. & ((old_grid .neqv. .true.) .and. & x_domain%end == dflt_real)) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for old_grid and x_domain%end. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif ((old_grid .neqv. .true.) & .and. & x_domain%beg >= x_domain%end) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for old_grid, x_domain%beg and '// & - 'x_domain%end. Exiting ...' - call s_mpi_abort() + 'x_domain%end. Exiting ...') else if (qbmm .and. dist_type == dflt_int) then - print '(A)', 'Dist type must be set if using QBMM. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Dist type must be set if using QBMM. Exiting ...') else if (qbmm .and. (dist_type /= 1) .and. rhoRV > 0d0) then - print '(A)', 'rhoRV cannot be used with dist_type \ne 1. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('rhoRV cannot be used with dist_type \ne 1. Exiting ...') else if (polydisperse .and. R0_type == dflt_int) then - print '(A)', 'R0 type must be set if using Polydisperse. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('R0 type must be set if using Polydisperse. Exiting ...') end if if (cyl_coord .neqv. .true.) then ! Cartesian coordinates @@ -308,10 +285,9 @@ contains .or. & ((old_grid .neqv. .true.) .and. & y_domain%beg == dflt_real)))) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for old_grid, n and y_domain%beg. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif ((n == 0 .and. y_domain%end /= dflt_real) & .or. & (n > 0 & @@ -320,19 +296,17 @@ contains .or. & ((old_grid .neqv. .true.) .and. & y_domain%end == dflt_real)))) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for old_grid, n and y_domain%end. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (n > 0 & .and. & (old_grid .neqv. .true.) & .and. & y_domain%beg >= y_domain%end) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for old_grid, n, y_domain%beg and '// & - 'y_domain%end. Exiting ...' - call s_mpi_abort() + 'y_domain%end. Exiting ...') ! Constraints on domain boundaries locations in the z-direction elseif ((p == 0 .and. z_domain%beg /= dflt_real) & @@ -343,10 +317,9 @@ contains .or. & ((old_grid .neqv. .true.) .and. & z_domain%beg == dflt_real)))) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for old_grid, p and z_domain%beg. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif ((p == 0 .and. z_domain%end /= dflt_real) & .or. & (p > 0 & @@ -355,19 +328,17 @@ contains .or. & ((old_grid .neqv. .true.) .and. & z_domain%end == dflt_real)))) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for old_grid, p and z_domain%end. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (p > 0 & .and. & (old_grid .neqv. .true.) & .and. & z_domain%beg >= z_domain%end) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for old_grid, p, z_domain%beg and '// & - 'z_domain%end. Exiting ...' - call s_mpi_abort() + 'z_domain%end. Exiting ...') end if else ! Cylindrical coordinates @@ -382,244 +353,196 @@ contains y_domain%end < 0d0 & .or. & y_domain%beg >= y_domain%end) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'cyl_coord and n, y_domain%beg, or '// & - 'y_domain%end. Exiting ...' - call s_mpi_abort() + 'y_domain%end. Exiting ...') elseif ((p == 0 .and. z_domain%beg /= dflt_real) & .or. & (p == 0 .and. z_domain%end /= dflt_real)) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'cyl_coord and p, z_domain%beg, or '// & - 'z_domain%end. Exiting ...' - call s_mpi_abort() + 'z_domain%end. Exiting ...') elseif (p > 0 .and. (z_domain%beg /= 0d0 & .or. & z_domain%end /= 2d0*pi)) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'cyl_coord and p, z_domain%beg, or '// & - 'z_domain%end. Exiting ...' - call s_mpi_abort() + 'z_domain%end. Exiting ...') end if end if ! Constraints on the grid stretching in the x-direction if (old_grid .and. stretch_x) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for old_grid and stretch_x. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (stretch_x .and. a_x == dflt_real) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for stretch_x and a_x. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for stretch_x and a_x. Exiting ...') elseif (stretch_x .and. x_a == dflt_real) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for stretch_x and x_a. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for stretch_x and x_a. Exiting ...') elseif (stretch_x .and. x_b == dflt_real) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for stretch_x and x_b. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for stretch_x and x_b. Exiting ...') elseif (stretch_x .and. x_a >= x_b) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for stretch_x, x_a and x_b. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (stretch_x & .and. & (a_x + log(cosh(a_x*(x_domain%beg - x_a))) & + log(cosh(a_x*(x_domain%beg - x_b))) & - 2d0*log(cosh(0.5d0*a_x*(x_b - x_a))))/a_x <= 0d0) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for x_domain%beg, stretch_x, a_x, '// & - 'x_a, and x_b. Exiting ...' - call s_mpi_abort() + 'x_a, and x_b. Exiting ...') elseif (stretch_x & .and. & (a_x + log(cosh(a_x*(x_domain%end - x_a))) & + log(cosh(a_x*(x_domain%end - x_b))) & - 2d0*log(cosh(0.5d0*a_x*(x_b - x_a))))/a_x <= 0d0) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for x_domain%end, stretch_x, a_x, '// & - 'x_a, and x_b. Exiting ...' - call s_mpi_abort() - elseif (loops_x < 1) then - print '(A)', 'Unsupported choice for the value of loops_x. '// & - 'Exiting ...' - call s_mpi_abort() + 'x_a, and x_b. Exiting ...') + elseif (loops_z < 1) then + call s_mpi_abort('Unsupported choice for the value of loops_z. '// & + 'Exiting ...') ! Constraints on the grid stretching in the y-direction elseif (old_grid .and. stretch_y) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for old_grid and stretch_y. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (n == 0 .and. stretch_y) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for n and stretch_y. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for n and stretch_y. Exiting ...') elseif (stretch_y .and. a_y == dflt_real) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for stretch_y and a_y. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for stretch_y and a_y. Exiting ...') elseif (stretch_y .and. y_a == dflt_real) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for stretch_y and y_a. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for stretch_y and y_a. Exiting ...') elseif (stretch_y .and. y_b == dflt_real) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for stretch_y and y_b. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for stretch_y and y_b. Exiting ...') elseif (stretch_y .and. y_a >= y_b) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for stretch_y, y_a and y_b. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (stretch_y & .and. & (a_y + log(cosh(a_y*(y_domain%beg - y_a))) & + log(cosh(a_y*(y_domain%beg - y_b))) & - 2d0*log(cosh(0.5d0*a_y*(y_b - y_a))))/a_y <= 0d0) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for y_domain%beg, stretch_y, a_y, '// & - 'y_a, and y_b. Exiting ...' - call s_mpi_abort() + 'y_a, and y_b. Exiting ...') elseif (stretch_y & .and. & (a_y + log(cosh(a_y*(y_domain%end - y_a))) & + log(cosh(a_y*(y_domain%end - y_b))) & - 2d0*log(cosh(0.5d0*a_y*(y_b - y_a))))/a_y <= 0d0) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for y_domain%end, stretch_y, a_y, '// & - 'y_a, and y_b. Exiting ...' - call s_mpi_abort() + 'y_a, and y_b. Exiting ...') elseif (loops_y < 1) then - print '(A)', 'Unsupported choice for the value of loops_y. '// & - 'Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of loops_y. '// & + 'Exiting ...') ! Constraints on the grid stretching in the z-direction elseif (old_grid .and. stretch_z) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for old_grid and stretch_z. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (cyl_coord .and. stretch_z) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for cyl_coord and stretch_z. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (p == 0 .and. stretch_z) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for p and stretch_z. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for p and stretch_z. Exiting ...') elseif (stretch_z .and. a_z == dflt_real) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for stretch_z and a_z. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for stretch_z and a_z. Exiting ...') elseif (stretch_z .and. z_a == dflt_real) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for stretch_z and z_a. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for stretch_z and z_a. Exiting ...') elseif (stretch_z .and. z_b == dflt_real) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for stretch_z and z_b. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for stretch_z and z_b. Exiting ...') elseif (stretch_z .and. z_a >= z_b) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for stretch_z, z_a and z_b. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (stretch_z & .and. & (a_z + log(cosh(a_z*(z_domain%beg - z_a))) & + log(cosh(a_z*(z_domain%beg - z_b))) & - 2d0*log(cosh(0.5d0*a_z*(z_b - z_a))))/a_z <= 0d0) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for z_domain%beg, stretch_z, a_z, '// & - 'z_a, and z_b. Exiting ...' - call s_mpi_abort() + 'z_a, and z_b. Exiting ...') elseif (stretch_z & .and. & (a_z + log(cosh(a_z*(z_domain%end - z_a))) & + log(cosh(a_z*(z_domain%end - z_b))) & - 2d0*log(cosh(0.5d0*a_z*(z_b - z_a))))/a_z <= 0d0) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for z_domain%end, stretch_z, a_z, '// & - 'z_a, and z_b. Exiting ...' - call s_mpi_abort() + 'z_a, and z_b. Exiting ...') elseif (loops_z < 1) then - print '(A)', 'Unsupported choice for the value of loops_z. '// & - 'Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of loops_z. '// & + 'Exiting ...') ! Constraints on model equations and number of fluids in the flow elseif (all(model_eqns /= (/1, 2, 3, 4/))) then - print '(A)', 'Unsupported value of model_eqns. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of model_eqns. Exiting ...') elseif (num_fluids /= dflt_int & .and. & (num_fluids < 1 .or. num_fluids > num_fluids)) then - print '(A)', 'Unsupported value of num_fluids. Exiting ...' - call s_mpi_abort() -! elseif ((model_eqns == 1) & -! .or. & -! (model_eqns == 2)) then -! print '(A)', 'Unsupported combination of values of '// & -! 'model_eqns and num_fluids. '// & -! 'Exiting ...' -! call s_mpi_abort() - elseif (model_eqns == 1 .and. adv_alphan) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported value of num_fluids. Exiting ...') + elseif (model_eqns == 1 .and. adv_alphan) then + call s_mpi_abort('Unsupported combination of values of '// & 'model_eqns and adv_alphan. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') ! Constraints on the order of the WENO scheme elseif (weno_order /= 1 .and. weno_order /= 3 & .and. & weno_order /= 5) then - print '(A)', 'Unsupported choice for the value of '// & - 'weno_order. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'weno_order. Exiting ...') elseif (m + 1 < weno_order) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for m and weno_order. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for m and weno_order. Exiting ...') elseif (n > 0 .and. n + 1 < weno_order) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for n and weno_order. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for n and weno_order. Exiting ...') elseif (p > 0 .and. p + 1 < weno_order) then - print '(A)', 'Unsupported choice of the combination of '// & - 'values for p and weno_order. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice of the combination of '// & + 'values for p and weno_order. Exiting ...') elseif ((m + 1)*(n + 1)*(p + 1) & < & weno_order**(min(1, m) + min(1, n) + min(1, p))*num_procs) & then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for num_procs, m, n, p and '// & - 'weno_order. Exiting ...' - call s_mpi_abort() + 'weno_order. Exiting ...') ! Constraints on the boundary conditions in the x-direction elseif (bc_x%beg < -12 .or. bc_x%beg > -1) then - print '(A)', 'Unsupported choice for the value of '// & - 'bc_x%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'bc_x%beg. Exiting ...') elseif (bc_x%end < -12 .or. bc_x%end > -1) then - print '(A)', 'Unsupported choice for the value of '// & - 'bc_x%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'bc_x%end. Exiting ...') elseif ((bc_x%beg == -1 .and. bc_x%end /= -1) & .or. & (bc_x%end == -1 .and. bc_x%beg /= -1)) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for bc_x%beg and bc_x%end. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') end if if (cyl_coord .neqv. .true.) then ! Cartesian coordinates @@ -628,71 +551,61 @@ contains if (bc_y%beg /= dflt_int & .and. & (bc_y%beg < -12 .or. bc_y%beg > -1)) then - print '(A)', 'Unsupported choice for the value of '// & - 'bc_y%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'bc_y%beg. Exiting ...') elseif (bc_y%end /= dflt_int & .and. & (bc_y%end < -12 .or. bc_y%end > -1)) then - print '(A)', 'Unsupported choice for the value of '// & - 'bc_y%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'bc_y%end. Exiting ...') elseif ((n == 0 .and. bc_y%beg /= dflt_int) & .or. & (n > 0 .and. bc_y%beg == dflt_int)) then - print '(A)', 'Unsupported choice for the value of n and '// & - 'bc_y%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of n and '// & + 'bc_y%beg. Exiting ...') elseif ((n == 0 .and. bc_y%end /= dflt_int) & .or. & (n > 0 .and. bc_y%end == dflt_int)) then - print '(A)', 'Unsupported choice for the value of n and '// & - 'bc_y%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of n and '// & + 'bc_y%end. Exiting ...') elseif (n > 0 & .and. & ((bc_y%beg == -1 .and. bc_y%end /= -1) & .or. & - (bc_y%end == -1 .and. bc_y%beg /= -1))) then - print '(A)', 'Unsupported choice of the combination of '// & + (bc_y%end == -1 .and. bc_y%beg /= -1))) then + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for n, bc_y%beg and bc_y%end. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') ! Constraints on the boundary conditions in the z-direction elseif (bc_z%beg /= dflt_int & .and. & (bc_z%beg < -12 .or. bc_z%beg > -1)) then - print '(A)', 'Unsupported choice for the value of '// & - 'bc_z%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'bc_z%beg. Exiting ...') elseif (bc_z%end /= dflt_int & .and. & (bc_z%end < -12 .or. bc_z%end > -1)) then - print '(A)', 'Unsupported choice for the value of '// & - 'bc_z%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'bc_z%end. Exiting ...') elseif ((p == 0 .and. bc_z%beg /= dflt_int) & .or. & (p > 0 .and. bc_z%beg == dflt_int)) then - print '(A)', 'Unsupported choice for the value of p and '// & - 'bc_z%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of p and '// & + 'bc_z%beg. Exiting ...') elseif ((p == 0 .and. bc_z%end /= dflt_int) & .or. & (p > 0 .and. bc_z%end == dflt_int)) then - print '(A)', 'Unsupported choice for the value of p and '// & - 'bc_z%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of p and '// & + 'bc_z%end. Exiting ...') elseif (p > 0 & .and. & ((bc_z%beg == -1 .and. bc_z%end /= -1) & .or. & (bc_z%end == -1 .and. bc_z%beg /= -1))) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for p, bc_z%beg and bc_z%end. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') end if else ! Cylindrical coordinates @@ -703,58 +616,49 @@ contains ((p > 0 .and. bc_y%beg /= -13) & .or. & (p == 0 .and. bc_y%beg /= -2))) then - print '(A)', 'Unsupported choice for the value of '// & - 'bc_y%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'bc_y%beg. Exiting ...') elseif (bc_y%end /= dflt_int & .and. & (bc_y%end < -12 .or. bc_y%end > -1)) then - print '(A)', 'Unsupported choice for the value of '// & - 'bc_y%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'bc_y%end. Exiting ...') elseif ((n > 0 .and. bc_y%beg == dflt_int)) then - print '(A)', 'Unsupported choice for the value of n and '// & - 'bc_y%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of n and '// & + 'bc_y%beg. Exiting ...') elseif ((n > 0 .and. bc_y%end == dflt_int)) then - print '(A)', 'Unsupported choice for the value of n and '// & - 'bc_y%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of n and '// & + 'bc_y%end. Exiting ...') ! Constraints on the boundary conditions in the theta-direction elseif (bc_z%beg /= dflt_int & .and. & (bc_z%beg /= -1 .and. bc_z%beg /= -2)) then - print '(A)', 'Unsupported choice for the value of '// & - 'bc_z%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'bc_z%beg. Exiting ...') elseif (bc_z%end /= dflt_int & .and. & (bc_z%end /= -1 .and. bc_z%end /= -2)) then - print '(A)', 'Unsupported choice for the value of '// & - 'bc_z%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'bc_z%end. Exiting ...') elseif ((p == 0 .and. bc_z%beg /= dflt_int) & .or. & (p > 0 .and. bc_z%beg == dflt_int)) then - print '(A)', 'Unsupported choice for the value of p and '// & - 'bc_z%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of p and '// & + 'bc_z%beg. Exiting ...') elseif ((p == 0 .and. bc_z%end /= dflt_int) & .or. & (p > 0 .and. bc_z%end == dflt_int)) then - print '(A)', 'Unsupported choice for the value of p and '// & - 'bc_z%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of p and '// & + 'bc_z%end. Exiting ...') elseif (p > 0 & .and. & ((bc_z%beg == -1 .and. bc_z%end /= -1) & .or. & (bc_z%end == -1 .and. bc_z%beg /= -1))) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for p, bc_z%beg and bc_z%end. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') end if end if @@ -762,48 +666,42 @@ contains ! Constraints on number of patches making up the initial condition if (num_patches < 0 .or. num_patches > num_patches .or. & (num_patches == 0 .and. t_step_old == dflt_int)) then - print '(A)', 'Unsupported choice for the value of '// & - 'num_patches. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'num_patches. Exiting ...') ! Constraints on perturbing the initial condition elseif ((perturb_flow .and. perturb_flow_fluid == dflt_int) & .or. & ((perturb_flow .neqv. .true.) .and. (perturb_flow_fluid /= dflt_int))) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for perturb_flow and perturb_flow_fluid. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif ((perturb_flow_fluid > num_fluids) & .or. & (perturb_flow_fluid < 0 .and. perturb_flow_fluid /= dflt_int)) then - print '(A)', 'Unsupported choice for the value of '// & - 'perturb_flow_fluid. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'perturb_flow_fluid. Exiting ...') elseif ((perturb_sph .and. perturb_sph_fluid == dflt_int) & .or. & ((perturb_sph .neqv. .true.) .and. (perturb_sph_fluid /= dflt_int))) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for perturb_sph and perturb_sph_fluid. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif ((perturb_sph_fluid > num_fluids) & .or. & (perturb_sph_fluid < 0 .and. perturb_sph_fluid /= dflt_int)) then - print '(A)', 'Unsupported choice for the value of '// & - 'perturb_sph_fluid. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'perturb_sph_fluid. Exiting ...') elseif ((any(fluid_rho /= dflt_real)) .and. (perturb_sph .neqv. .true.)) then - print '(A)', 'Unsupported choices for values of perturb_sph '// & - 'and fluid_rho. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choices for values of perturb_sph '// & + 'and fluid_rho. Exiting ...') end if if (perturb_sph) then do i = 1, num_fluids + call s_int_to_str(i,iStr) if (fluid_rho(i) == dflt_real) then - print '(A,I0,A)', 'Unsupported choice for value of fluid_rho(', & - i, '). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for value of fluid_rho('//& + trim(iStr)//'). Exiting ...') end if end do end if @@ -813,55 +711,49 @@ contains ! Constraints on the stiffened equation of state fluids parameters do i = 1, num_fluids - + call s_int_to_str(i, iStr) if (fluid_pp(i)%gamma /= dflt_real & .and. & fluid_pp(i)%gamma <= 0d0) then - print '(A,I0,A)', 'Unsupported value of '// & - 'fluid_pp(', i, ')%'// & - 'gamma. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of '// & + 'fluid_pp('//trim(iStr)//')%'// & + 'gamma. Exiting ...') elseif (model_eqns == 1 & .and. & - fluid_pp(i)%gamma /= dflt_real) then - print '(A,I0,A)', 'Unsupported combination '// & + fluid_pp(i)%gamma /= dflt_real) then + call s_mpi_abort('Unsupported combination '// & 'of values of model_eqns '// & - 'and fluid_pp(', i, ')%'// & - 'gamma. Exiting ...' - call s_mpi_abort() + 'and fluid_pp('//trim(iStr)//')%'// & + 'gamma. Exiting ...') elseif ((i <= num_fluids + bub_fac .and. fluid_pp(i)%gamma <= 0d0) & .or. & (i > num_fluids + bub_fac .and. fluid_pp(i)%gamma /= dflt_real)) & then - print '(A,I0,A)', 'Unsupported combination '// & + call s_mpi_abort( 'Unsupported combination '// & 'of values of num_fluids '// & - 'and fluid_pp(', i, ')%'// & - 'gamma. Exiting ...' - call s_mpi_abort() + 'and fluid_pp('//trim(iStr)//')%'// & + 'gamma. Exiting ...') elseif (fluid_pp(i)%pi_inf /= dflt_real & .and. & fluid_pp(i)%pi_inf < 0d0) then - print '(A,I0,A)', 'Unsupported value of '// & - 'fluid_pp(', i, ')%'// & - 'pi_inf. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of '// & + 'fluid_pp('//trim(iStr)//')%'// & + 'pi_inf. Exiting ...') elseif (model_eqns == 1 & .and. & - fluid_pp(i)%pi_inf /= dflt_real) then - print '(A,I0,A)', 'Unsupported combination '// & + fluid_pp(i)%pi_inf /= dflt_real) then + call s_mpi_abort('Unsupported combination '// & 'of values of model_eqns '// & - 'and fluid_pp(', i, ')%'// & - 'pi_inf. Exiting ...' - call s_mpi_abort() + 'and fluid_pp('//trim(iStr)//')%'// & + 'pi_inf. Exiting ...') elseif ((i <= num_fluids + bub_fac .and. fluid_pp(i)%pi_inf < 0d0) & .or. & (i > num_fluids + bub_fac .and. fluid_pp(i)%pi_inf /= dflt_real)) & then - print '(A,I0,A)', 'Unsupported combination '// & + call s_mpi_abort('Unsupported combination '// & 'of values of num_fluids '// & - 'and fluid_pp(', i, ')%'// & - 'pi_inf. Exiting ...' - call s_mpi_abort() + 'and fluid_pp('//trim(iStr)//')%'// & + 'pi_inf. Exiting ...') end if end do @@ -899,9 +791,8 @@ contains ! If the time-step directory is missing, the pre-process exits if (dir_check .neqv. .true.) then - print '(A)', 'Time-step folder '//trim(t_step_dir)// & - ' is missing. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Time-step folder '//trim(t_step_dir)// & + ' is missing. Exiting ...') end if ! Reading the Grid Data File for the x-direction =================== @@ -916,10 +807,9 @@ contains STATUS='old', ACTION='read') read (1) x_cb(-1:m) close (1) - else - print '(A)', 'File x_cb.dat is missing in '// & - trim(t_step_dir)//'. Exiting ...' - call s_mpi_abort() + else + call s_mpi_abort('File x_cb.dat is missing in '// & + trim(t_step_dir)//'. Exiting ...') end if ! Computing cell-center locations @@ -950,9 +840,8 @@ contains read (1) y_cb(-1:n) close (1) else - print '(A)', 'File y_cb.dat is missing in '// & - trim(t_step_dir)//'. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('File y_cb.dat is missing in '// & + trim(t_step_dir)//'. Exiting ...') end if ! Computing cell-center locations @@ -983,9 +872,8 @@ contains read (1) z_cb(-1:p) close (1) else - print '(A)', 'File z_cb.dat is missing in '// & - trim(t_step_dir)//'. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('File z_cb.dat is missing in '// & + trim(t_step_dir)//'. Exiting ...') end if ! Computing cell-center locations @@ -1027,9 +915,8 @@ contains ! Cell-boundary Data Consistency Check in x-direction ============== if (any(x_cb(0:m) - x_cb(-1:m - 1) <= 0d0)) then - print '(A)', 'x_cb.dat in '//trim(t_step_dir)// & - ' contains non-positive cell-spacings. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('x_cb.dat in '//trim(t_step_dir)// & + ' contains non-positive cell-spacings. Exiting ...') end if ! ================================================================== @@ -1039,10 +926,9 @@ contains if (n > 0) then if (any(y_cb(0:n) - y_cb(-1:n - 1) <= 0d0)) then - print '(A)', 'y_cb.dat in '//trim(t_step_dir)// & + call s_mpi_abort('y_cb.dat in '//trim(t_step_dir)// & ' contains non-positive cell-spacings. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') end if ! ================================================================== @@ -1052,10 +938,9 @@ contains if (p > 0) then if (any(z_cb(0:p) - z_cb(-1:p - 1) <= 0d0)) then - print '(A)', 'z_cb.dat in '//trim(t_step_dir)// & + call s_mpi_abort('z_cb.dat in '//trim(t_step_dir)// & ' contains non-positive cell-spacings'// & - ' .Exiting ...' - call s_mpi_abort() + ' .Exiting ...') end if end if @@ -1108,10 +993,9 @@ contains read (1) q_cons_vf(i)%sf close (1) else - print '(A)', 'File q_cons_vf'//trim(file_num)// & + call s_mpi_abort( 'File q_cons_vf'//trim(file_num)// & '.dat is missing in '//trim(t_step_dir)// & - '. Exiting ...' - call s_mpi_abort() + '. Exiting ...') end if end do @@ -1161,8 +1045,7 @@ contains call MPI_FILE_READ_ALL(ifile, x_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else - print '(A)', 'File ', trim(file_loc), ' is missing. Exiting... ' - call s_mpi_abort() + call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting... ') end if ! Assigning local cell boundary locations @@ -1187,8 +1070,7 @@ contains call MPI_FILE_READ_ALL(ifile, y_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else - print '(A)', 'File ', trim(file_loc), ' is missing. Exiting... ' - call s_mpi_abort() + call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting... ') end if ! Assigning local cell boundary locations @@ -1213,8 +1095,7 @@ contains call MPI_FILE_READ_ALL(ifile, z_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else - print '(A)', 'File ', trim(file_loc), ' is missing. Exiting... ' - call s_mpi_abort() + call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting... ') end if ! Assigning local cell boundary locations @@ -1304,8 +1185,7 @@ contains call MPI_FILE_CLOSE(ifile, ierr) else - print '(A)', 'File ', trim(file_loc), ' is missing. Exiting... ' - call s_mpi_abort() + call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting... ') end if call s_mpi_barrier() diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 51dd7276c7..47eeb93170 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -415,14 +415,10 @@ contains end if if (icfl_max_glb /= icfl_max_glb) then - print '(A)', 'ICFL is NaN. Exiting ...' - ! print*, (dt/dx(:)),ABS(vel(1)),c - - call s_mpi_abort() + call s_mpi_abort('ICFL is NaN. Exiting ...') elseif (icfl_max_glb > 1d0) then - print '(A)', 'ICFL is greater than 1.0. Exiting ...' + call s_mpi_abort('ICFL is greater than 1.0. Exiting ...') print *, 'icfl', icfl_max_glb - call s_mpi_abort() end if end if @@ -1255,8 +1251,7 @@ contains end do elseif (p == 0) then if (num_integrals /= 3) then - print '(A)', 'Incorrect number of integrals' - call s_mpi_abort() + call s_mpi_abort('Incorrect number of integrals') end if rad = integral(1)%xmax diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp index 78e59cf67a..de87df46e1 100644 --- a/src/simulation/m_mpi_proxy.fpp +++ b/src/simulation/m_mpi_proxy.fpp @@ -310,10 +310,9 @@ contains ! Verifying that a valid decomposition of the computational ! domain has been established. If not, the simulation exits. if (proc_rank == 0 .and. ierr == -1) then - print '(A)', 'Unsupported combination of values '// & + call s_mpi_abort('Unsupported combination of values '// & 'of num_procs, m, n, p and '// & - 'weno_order. Exiting ...' - call s_mpi_abort() + 'weno_order. Exiting ...') end if ! Creating new communicator using the Cartesian topology @@ -413,10 +412,9 @@ contains ! Verifying that a valid decomposition of the computational ! domain has been established. If not, the simulation exits. if (proc_rank == 0 .and. ierr == -1) then - print '(A)', 'Unsupported combination of values '// & + call s_mpi_abort('Unsupported combination of values '// & 'of num_procs, m, n and '// & - 'weno_order. Exiting ...' - call s_mpi_abort() + 'weno_order. Exiting ...') end if ! Creating new communicator using the Cartesian topology diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index 8d67408ef7..a5381c10cc 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -26,6 +26,8 @@ module m_start_up use m_variables_conversion !< State variables type conversion procedures use m_compile_specific + + use m_helper ! ========================================================================== implicit none @@ -59,6 +61,9 @@ module m_start_up procedure(s_read_abstract_data_files), pointer :: s_read_data_files => null() + character(len=5) :: iStr + character(len=5) :: jStr + contains !> The purpose of this procedure is to first verify that an @@ -113,9 +118,8 @@ contains read (1, NML=user_inputs, iostat=iostatus) if (iostatus /= 0) then - print '(A)', 'Invalid line in simulation.inp. It is '// & - 'likely due to a datatype mismatch. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Invalid line in simulation.inp. It is '// & + 'likely due to a datatype mismatch. Exiting ...') end if close (1) @@ -134,8 +138,7 @@ contains p_glb = p else - print '(A)', trim(file_path)//' is missing. Exiting ...' - call s_mpi_abort() + call s_mpi_abort(trim(file_path)//' is missing. Exiting ...') end if end subroutine s_read_input_file ! ------------------------------------- @@ -165,229 +168,175 @@ contains call my_inquire(file_path, file_exist) if (file_exist .neqv. .true.) then - print '(A)', trim(file_path)//' is missing. Exiting ...' - call s_mpi_abort() + call s_mpi_abort(trim(file_path)//' is missing. Exiting ...') end if ! ================================================================== #if !(defined(_OPENACC) && defined(__PGI)) if (cu_mpi) then - print '(A)', 'Unsupported value of cu_mpi. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of cu_mpi. Exiting ...') end if #endif #ifndef MFC_cuTENSOR if (cu_tensor) then - print '(A)', 'Unsupported value of cu_tensor. MFC was not built '// & - 'with the NVIDIA cuTENSOR library. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of cu_tensor. MFC was not built '// & + 'with the NVIDIA cuTENSOR library. Exiting ...') end if #endif ! Computational Domain Parameters ================================== if (m <= 0) then - print '(A)', 'Unsupported value of m. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of m. Exiting ...') elseif (n < 0) then - print '(A)', 'Unsupported value of n. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of n. Exiting ...') elseif (p < 0) then - print '(A)', 'Unsupported value of p. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of p. Exiting ...') elseif (cyl_coord .and. p > 0 .and. mod(p, 2) /= 1) then - print '(A)', 'Unsupported value of p. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of p. Exiting ...') elseif (n == 0 .and. p > 0) then - print '(A)', 'Unsupported combination of values of '// & - 'n and p. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of values of '// & + 'n and p. Exiting ...') elseif (dt <= 0) then - print '(A)', 'Unsupported value of dt. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of dt. Exiting ...') elseif (t_step_start < 0) then - print '(A)', 'Unsupported value of t_step_start. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of t_step_start. Exiting ...') elseif (t_step_stop <= t_step_start) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 't_step_start and t_step_stop. '// & - 'Exiting ...' - call s_mpi_abort() - elseif (t_step_save > t_step_stop - t_step_start) then - print '(A)', 'Unsupported combination of values of '// & + 'Exiting ...') + elseif (t_step_save > t_step_stop - t_step_start) then + call s_mpi_abort('Unsupported combination of values of '// & 't_step_start, t_step_stop and '// & - 't_step_save. Exiting ...' - call s_mpi_abort() + 't_step_save. Exiting ...') end if ! ================================================================== ! Simulation Algorithm Parameters ================================== if (all(model_eqns /= (/1, 2, 3, 4/))) then - print '(A)', 'Unsupported value of model_eqns. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of model_eqns. Exiting ...') elseif (model_eqns == 2 .and. bubbles .and. bubble_model == 1) then - print '(A)', 'The 5-equation bubbly flow model requires bubble_model = 2 (Keller--Miksis)' - call s_mpi_abort() + call s_mpi_abort('The 5-equation bubbly flow model requires bubble_model = 2 (Keller--Miksis)') elseif (bubbles .and. nb < 1) then - print '(A)', 'The Ensemble-Averaged Bubble Model requires nb >= 1' - call s_mpi_abort() + call s_mpi_abort('The Ensemble-Averaged Bubble Model requires nb >= 1') elseif (bubbles .and. bubble_model == 3 .and. (polytropic .neqv. .true.)) then - print '(A)', 'RP bubbles require polytropic compression' - call s_mpi_abort() - elseif (cyl_coord .and. bubbles) then - print '(A)', 'Bubble models untested in cylindrical coordinates' - call s_mpi_abort() + call s_mpi_abort('RP bubbles require polytropic compression') + elseif (cyl_coord .and. bubbles) then + call s_mpi_abort('Bubble models untested in cylindrical coordinates') elseif (model_eqns == 3 .and. bubbles) then - print '(A)', 'Bubble models untested with 6-equation model' - call s_mpi_abort() + call s_mpi_abort('Bubble models untested with 6-equation model') elseif (model_eqns == 1 .and. bubbles) then - print '(A)', 'Bubble models untested with pi-gamma model' - call s_mpi_abort() + call s_mpi_abort('Bubble models untested with pi-gamma model') elseif (model_eqns == 4 .and. num_fluids /= 1) then - print '(A)', 'The 4-equation model implementation is not a multi-component and requires num_fluids = 1' - call s_mpi_abort() + call s_mpi_abort('The 4-equation model implementation is not a multi-component and requires num_fluids = 1') elseif (bubbles .and. weno_vars /= 2) then - print '(A)', 'Bubble modeling requires weno_vars = 2' - call s_mpi_abort() + call s_mpi_abort('Bubble modeling requires weno_vars = 2') !TODO: Comment this out when testing riemann with hll elseif (bubbles .and. riemann_solver /= 2) then - print '(A)', 'Bubble modeling requires riemann_solver = 2' - call s_mpi_abort() + call s_mpi_abort('Bubble modeling requires riemann_solver = 2') elseif ((bubbles .neqv. .true.) .and. polydisperse) then - print '(A)', 'Polydisperse bubble modeling requires the bubble switch to be activated' - call s_mpi_abort() + call s_mpi_abort('Polydisperse bubble modeling requires the bubble switch to be activated') elseif (polydisperse .and. (poly_sigma == dflt_real)) then - print '(A)', 'Polydisperse bubble modeling requires poly_sigma > 0' - call s_mpi_abort() - elseif (qbmm .and. (bubbles .neqv. .true.)) then - print '(A)', 'QBMM requires bubbles' - call s_mpi_abort() + call s_mpi_abort('Polydisperse bubble modeling requires poly_sigma > 0') + elseif (qbmm .and. (bubbles .neqv. .true.)) then + call s_mpi_abort('QBMM requires bubbles') elseif (qbmm .and. (nnode /= 4)) then - print '(A)', 'nnode not supported' - call s_mpi_abort() + call s_mpi_abort('nnode not supported') elseif (model_eqns == 3 .and. riemann_solver /= 2) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'model_eqns (6-eq) and riemann_solver (please use riemann_solver = 2). '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (model_eqns == 3 .and. alt_soundspeed) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'model_eqns (6-eq) and alt_soundspeed. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (model_eqns == 3 .and. avg_state == 1) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'model_eqns (6-eq) and Roe average (please use avg_state = 2). '// & - 'Exiting ...' - call s_mpi_abort() - elseif (bubbles .and. avg_state == 1) then - print '(A)', 'Unsupported combination of values of '// & + 'Exiting ...') + elseif (bubbles .and. avg_state == 1) then + call s_mpi_abort('Unsupported combination of values of '// & 'bubbles and Roe average (please use avg_state = 2). '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (model_eqns == 3 .and. wave_speeds == 2) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'model_eqns (6-eq) and wave_speeds (please use wave_speeds = 1). '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (model_eqns == 3 .and. (cyl_coord .and. p /= 0)) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'model_eqns (6-eq) and cylindrical coordinates. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (num_fluids /= dflt_int & .and. & (num_fluids < 1 .or. num_fluids > num_fluids)) then - print '(A)', 'Unsupported value of num_fluids. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of num_fluids. Exiting ...') elseif ((model_eqns == 1 .and. num_fluids /= dflt_int) & .or. & (model_eqns == 2 .and. num_fluids == dflt_int)) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'model_eqns and num_fluids. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (model_eqns == 1 .and. adv_alphan) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'model_eqns and adv_alphan. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (model_eqns == 1 .and. mpp_lim) then - print '(A)', 'Unsupported combination of values of '// & - 'model_eqns and mpp_lim. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of values of '// & + 'model_eqns and mpp_lim. Exiting ...') elseif (num_fluids == 1 .and. mpp_lim) then - print '(A)', 'Unsupported combination of values of '// & - 'num_fluids and mpp_lim. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of values of '// & + 'num_fluids and mpp_lim. Exiting ...') elseif (time_stepper < 1 .or. time_stepper > 5) then - if (time_stepper /= 23) then - print '(A)', 'Unsupported value of time_stepper. Exiting ...' - call s_mpi_abort() + if (time_stepper /= 23) then + call s_mpi_abort('Unsupported value of time_stepper. Exiting ...') end if elseif (all(weno_vars /= (/1, 2/))) then - print '(A)', 'Unsupported value of weno_vars. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of weno_vars. Exiting ...') elseif (all(weno_order /= (/1, 3, 5/))) then - print '(A)', 'Unsupported value of weno_order. Exiting ...' - call s_mpi_abort() - elseif (m + 1 < num_stcls_min*weno_order) then - print '(A)', 'Unsupported combination of values of '// & - 'm and weno_order. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of weno_order. Exiting ...') + elseif (m + 1 < num_stcls_min*weno_order) then + call s_mpi_abort('Unsupported combination of values of '// & + 'm and weno_order. Exiting ...') elseif (n + 1 < min(1, n)*num_stcls_min*weno_order) then - print '(A)', 'Unsupported combination of values of '// & - 'n and weno_order. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of values of '// & + 'n and weno_order. Exiting ...') elseif (p + 1 < min(1, p)*num_stcls_min*weno_order) then - print '(A)', 'Unsupported combination of values of '// & - 'p and weno_order. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of values of '// & + 'p and weno_order. Exiting ...') elseif (weno_eps <= 0d0 .or. weno_eps > 1d-6) then - print '(A)', 'Unsupported value of weno_eps. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of weno_eps. Exiting ...') elseif (weno_order == 1 .and. mapped_weno) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'weno_order and mapped_weno. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (weno_order /= 5 .and. mp_weno) then - print '(A)', 'Unsupported combination of values of '// & - 'weno_order and mp_weno. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of values of '// & + 'weno_order and mp_weno. Exiting ...') elseif (riemann_solver < 1 .or. riemann_solver > 3) then - print '(A)', 'Unsupported value of riemann_solver. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of riemann_solver. Exiting ...') elseif (all(wave_speeds /= (/dflt_int, 1, 2/))) then - print '(A)', 'Unsupported value of wave_speeds. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of wave_speeds. Exiting ...') elseif ((riemann_solver /= 3 .and. wave_speeds == dflt_int) & .or. & (riemann_solver == 3 .and. wave_speeds /= dflt_int)) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'riemann_solver and wave_speeds. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (all(avg_state /= (/dflt_int, 1, 2/))) then - print '(A)', 'Unsupported value of avg_state. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of avg_state. Exiting ...') elseif (riemann_solver /= 3 .and. avg_state == dflt_int) then - print '(A)', 'Unsupported combination of values of '// & + call s_mpi_abort('Unsupported combination of values of '// & 'riemann_solver and avg_state. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (bc_x%beg < -12 .or. bc_x%beg > -1) then - print '(A)', 'Unsupported value of bc_x%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of bc_x%beg. Exiting ...') elseif (bc_x%end < -12 .or. bc_x%end > -1) then - print '(A)', 'Unsupported value of bc_x%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of bc_x%end. Exiting ...') elseif ((bc_x%beg == -1 .and. bc_x%end /= -1) & .or. & (bc_x%end == -1 .and. bc_x%beg /= -1)) then - print '(A)', 'Unsupported combination of values of '// & - 'bc_x%beg and bc_x%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of values of '// & + 'bc_x%beg and bc_x%end. Exiting ...') elseif (bc_y%beg /= dflt_int & .and. & (((cyl_coord .neqv. .true.) .and. (bc_y%beg < -12 .or. bc_y%beg > -1)) & @@ -395,79 +344,64 @@ contains (cyl_coord .and. p == 0 .and. bc_y%beg /= -2) & .or. & (cyl_coord .and. p > 0 .and. bc_y%beg /= -13))) then - print '(A)', 'Unsupported value of bc_y%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of bc_y%beg. Exiting ...') elseif (bc_y%end /= dflt_int & .and. & - (bc_y%end < -12 .or. bc_y%end > -1)) then - print '(A)', 'Unsupported value of bc_y%end. Exiting ...' - call s_mpi_abort() + (bc_y%end < -12 .or. bc_y%end > -1)) then + call s_mpi_abort('Unsupported value of bc_y%end. Exiting ...') elseif ((n == 0 .and. bc_y%beg /= dflt_int) & .or. & (n > 0 .and. bc_y%beg == dflt_int)) then - print '(A)', 'Unsupported combination of values of '// & - 'n and bc_y%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of values of '// & + 'n and bc_y%beg. Exiting ...') elseif ((n == 0 .and. bc_y%end /= dflt_int) & .or. & - (n > 0 .and. bc_y%end == dflt_int)) then - print '(A)', 'Unsupported combination of values of '// & - 'n and bc_y%end. Exiting ...' - call s_mpi_abort() + (n > 0 .and. bc_y%end == dflt_int)) then + call s_mpi_abort('Unsupported combination of values of '// & + 'n and bc_y%end. Exiting ...') elseif ((bc_y%beg == -1 .and. bc_y%end /= -1) & .or. & (bc_y%end == -1 .and. bc_y%beg /= -1)) then - print '(A)', 'Unsupported combination of values of '// & - 'bc_y%beg and bc_y%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of values of '// & + 'bc_y%beg and bc_y%end. Exiting ...') elseif (bc_z%beg /= dflt_int & .and. & (bc_z%beg < -12 .or. bc_z%beg > -1)) then - print '(A)', 'Unsupported value of bc_z%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of bc_z%beg. Exiting ...') elseif (bc_z%end /= dflt_int & .and. & (bc_z%end < -12 .or. bc_z%end > -1)) then - print '(A)', 'Unsupported value of bc_z%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of bc_z%end. Exiting ...') elseif ((p == 0 .and. bc_z%beg /= dflt_int) & .or. & (p > 0 .and. bc_z%beg == dflt_int)) then - print '(A)', 'Unsupported combination of values of '// & - 'p and bc_z%beg. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of values of '// & + 'p and bc_z%beg. Exiting ...') elseif ((p == 0 .and. bc_z%end /= dflt_int) & .or. & (p > 0 .and. bc_z%end == dflt_int)) then - print '(A)', 'Unsupported combination of values of '// & - 'p and bc_z%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of values of '// & + 'p and bc_z%end. Exiting ...') elseif ((bc_z%beg == -1 .and. bc_z%end /= -1) & .or. & (bc_z%end == -1 .and. bc_z%beg /= -1)) then - print '(A)', 'Unsupported combination of values of '// & - 'bc_z%beg and bc_z%end. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of values of '// & + 'bc_z%beg and bc_z%end. Exiting ...') elseif (model_eqns == 1 .and. alt_soundspeed) then - print '(A)', 'Unsupported combination of model_eqns '// & - 'and alt_soundspeed. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of model_eqns '// & + 'and alt_soundspeed. Exiting ...') elseif (model_eqns == 4 .and. alt_soundspeed) then - print '(A)', 'Unsupported combination of model_eqns '// & - 'and alt_soundspeed. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of model_eqns '// & + 'and alt_soundspeed. Exiting ...') elseif ((num_fluids /= 2 .and. num_fluids /= 3) .and. alt_soundspeed) then - print '(A)', 'Unsupported combination of num_fluids '// & - 'and alt_soundspeed. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported combination of num_fluids '// & + 'and alt_soundspeed. Exiting ...') elseif (riemann_solver /= 2 .and. alt_soundspeed) then - print '(A)', 'Unsupported combination of riemann_solver '// & - 'and alt_soundspeed. Exiting ...' - call s_mpi_abort() + call s_mpi_abort( 'Unsupported combination of riemann_solver '// & + 'and alt_soundspeed. Exiting ...') elseif (hypoelasticity .and. (riemann_solver /= 1)) then - print '(A)', 'hypoelasticity requires riemann_solver = 1'// & - 'Exiting ...' - call s_mpi_abort() + call s_mpi_abort( 'hypoelasticity requires riemann_solver = 1'// & + 'Exiting ...') end if ! END: Simulation Algorithm Parameters ============================= @@ -475,104 +409,92 @@ contains if (fd_order /= dflt_int & .and. & fd_order /= 1 .and. fd_order /= 2 .and. fd_order /= 4) then - print '(A)', 'Unsupported choice for the value of '// & - 'fd_order. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported choice for the value of '// & + 'fd_order. Exiting ...') elseif (probe_wrt .and. fd_order == dflt_int) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for probe_wrt, and fd_order. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') elseif (integral_wrt .and. (bubbles .neqv. .true.)) then - print '(A)', 'Unsupported choice of the combination of '// & + call s_mpi_abort('Unsupported choice of the combination of '// & 'values for integral_wrt, and bubbles. '// & - 'Exiting ...' - call s_mpi_abort() + 'Exiting ...') end if ! END: Finite Difference Parameters ================================ ! Fluids Physical Parameters ======================================= do i = 1, num_fluids - + call s_int_to_str(i,iStr) if (fluid_pp(i)%gamma /= dflt_real & .and. & fluid_pp(i)%gamma <= 0d0) then - print '(A,I0,A)', 'Unsupported value of '// & - 'fluid_pp(', i, ')%'// & - 'gamma. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of '// & + 'fluid_pp('//trim(iStr)//')%'// & + 'gamma. Exiting ...') elseif (model_eqns == 1 & .and. & fluid_pp(i)%gamma /= dflt_real) then - print '(A,I0,A)', 'Unsupported combination '// & + call s_mpi_abort('Unsupported combination '// & 'of values of model_eqns '// & - 'and fluid_pp(', i, ')%'// & - 'gamma. Exiting ...' - call s_mpi_abort() + 'and fluid_pp('//trim(iStr)//')%'// & + 'gamma. Exiting ...') elseif ((i <= num_fluids + bub_fac .and. fluid_pp(i)%gamma <= 0d0) & .or. & (i > num_fluids + bub_fac .and. fluid_pp(i)%gamma /= dflt_real)) & then - print '(A,I0,A)', 'Unsupported combination '// & + call s_mpi_abort('Unsupported combination '// & 'of values of num_fluids '// & - 'and fluid_pp(', i, ')%'// & - 'gamma. Exiting ...' - call s_mpi_abort() + 'and fluid_pp('//trim(iStr)//')%'// & + 'gamma. Exiting ...') elseif (fluid_pp(i)%pi_inf /= dflt_real & .and. & fluid_pp(i)%pi_inf < 0d0) then - print '(A,I0,A)', 'Unsupported value of '// & - 'fluid_pp(', i, ')%'// & - 'pi_inf. Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of '// & + 'fluid_pp('//trim(iStr)//')%'// & + 'pi_inf. Exiting ...') elseif (model_eqns == 1 & .and. & fluid_pp(i)%pi_inf /= dflt_real) then - print '(A,I0,A)', 'Unsupported combination '// & + call s_mpi_abort('Unsupported combination '// & 'of values of model_eqns '// & - 'and fluid_pp(', i, ')%'// & - 'pi_inf. Exiting ...' - call s_mpi_abort() + 'and fluid_pp('//trim(iStr)//')%'// & + 'pi_inf. Exiting ...') elseif ((i <= num_fluids + bub_fac .and. fluid_pp(i)%pi_inf < 0d0) & .or. & (i > num_fluids + bub_fac .and. fluid_pp(i)%pi_inf /= dflt_real)) & then - print '(A,I0,A)', 'Unsupported combination '// & + call s_mpi_abort('Unsupported combination '// & 'of values of num_fluids '// & - 'and fluid_pp(', i, ')%'// & - 'pi_inf. Exiting ...' - call s_mpi_abort() + 'and fluid_pp('//trim(iStr)//')%'// & + 'pi_inf. Exiting ...') end if do j = 1, 2 - + call s_int_to_str(j,jStr) if (fluid_pp(i)%Re(j) /= dflt_real & .and. & fluid_pp(i)%Re(j) <= 0d0) then - print '(A,I0,A,I0,A)', 'Unsupported value of '// & - 'fluid_pp(', i, ')%'// & - 'Re(', j, '). Exiting ...' - call s_mpi_abort() + call s_mpi_abort('Unsupported value of '// & + 'fluid_pp('//trim(iStr)//')%'// & + 'Re('//trim(jStr)//'). Exiting ...') end if if (model_eqns == 1 & .and. & fluid_pp(i)%Re(j) /= dflt_real) then - print '(A,I0,A,I0,A)', 'Unsupported combination '// & + call s_mpi_abort('Unsupported combination '// & 'of values of model_eqns '// & - 'and fluid_pp(', i, ')%'// & - 'Re(', j, '). Exiting ...' - call s_mpi_abort() + 'and fluid_pp('//trim(iStr)//')%'// & + 'Re('//trim(jStr)//'). Exiting ...') end if if (i > num_fluids & .and. & fluid_pp(i)%Re(j) /= dflt_real) then - print '(A,I0,A,I0,A)', 'Unsupported combination '// & + call s_mpi_abort('Unsupported combination '// & 'of values of num_fluids '// & - 'and fluid_pp(', i, ')%'// & - 'Re(', j, '). Exiting ...' - call s_mpi_abort() + 'and fluid_pp('//trim(iStr)//')%'// & + 'Re('//trim(jStr)//'). Exiting ...') end if end do @@ -611,9 +533,8 @@ contains file_path = trim(t_step_dir)//'/.' call my_inquire(file_path, file_exist) - if (file_exist .neqv. .true.) then - print '(A)', trim(file_path)//' is missing. Exiting ...' - call s_mpi_abort() + if (file_exist .neqv. .true.) then + call s_mpi_abort(trim(file_path)//' is missing. Exiting ...') end if ! Cell-boundary Locations in x-direction =========================== @@ -628,8 +549,7 @@ contains STATUS='old') read (2) x_cb(-1:m); close (2) else - print '(A)', trim(file_path)//' is missing. Exiting ...' - call s_mpi_abort() + call s_mpi_abort(trim(file_path)//' is missing. Exiting ...') end if dx(0:m) = x_cb(0:m) - x_cb(-1:m - 1) @@ -650,8 +570,7 @@ contains STATUS='old') read (2) y_cb(-1:n); close (2) else - print '(A)', trim(file_path)//' is missing. Exiting ...' - call s_mpi_abort() + call s_mpi_abort(trim(file_path)//' is missing. Exiting ...') end if dy(0:n) = y_cb(0:n) - y_cb(-1:n - 1) @@ -674,8 +593,7 @@ contains STATUS='old') read (2) z_cb(-1:p); close (2) else - print '(A)', trim(file_path)//' is missing. Exiting ...' - call s_mpi_abort() + call s_mpi_abort(trim(file_path)//' is missing. Exiting ...') end if dz(0:p) = z_cb(0:p) - z_cb(-1:p - 1) @@ -697,8 +615,7 @@ contains STATUS='old') read (2) q_cons_vf(i)%sf(0:m, 0:n, 0:p); close (2) else - print '(A)', trim(file_path)//' is missing. Exiting ...' - call s_mpi_abort() + call s_mpi_abort(trim(file_path)//' is missing. Exiting ...') end if end do else @@ -714,8 +631,7 @@ contains STATUS='old') read (2) q_cons_vf(i)%sf(0:m, 0:n, 0:p); close (2) else - print '(A)', trim(file_path)//' is missing. Exiting ...' - call s_mpi_abort() + call s_mpi_abort(trim(file_path)//' is missing. Exiting ...') end if end do end if @@ -761,8 +677,7 @@ contains call MPI_FILE_READ(ifile, x_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else - print '(A)', 'File ', trim(file_loc), ' is missing. Exiting...' - call s_mpi_abort() + call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting...') end if ! Assigning local cell boundary locations @@ -783,8 +698,7 @@ contains call MPI_FILE_READ(ifile, y_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else - print '(A)', 'File ', trim(file_loc), ' is missing. Exiting...' - call s_mpi_abort() + call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting...') end if ! Assigning local cell boundary locations @@ -805,8 +719,7 @@ contains call MPI_FILE_READ(ifile, z_cb_glb, data_size, MPI_DOUBLE_PRECISION, status, ierr) call MPI_FILE_CLOSE(ifile, ierr) else - print '(A)', 'File ', trim(file_loc), ' is missing. Exiting...' - call s_mpi_abort() + call s_mpi_abort( 'File '//trim(file_loc)//'is missing. Exiting...') end if ! Assigning local cell boundary locations @@ -873,8 +786,7 @@ contains call MPI_FILE_CLOSE(ifile, ierr) else - print '(A)', 'File ', trim(file_loc), ' is missing. Exiting...' - call s_mpi_abort() + call s_mpi_abort('File '//trim(file_loc)//' is missing. Exiting...') end if deallocate (x_cb_glb, y_cb_glb, z_cb_glb)