subroutine traveling_wave_exact ( x, t, u, ut, utt, ux, uxx ) !*****************************************************************************80 ! !! traveling_wave_exact() evaluates an exact solution of the 1D wave equation. ! ! Discussion: ! ! d^2u/dt^2 = c^2 d^2u/dx^2 ! u[x,t] = a * sin ( k * x + w * t + phi ) ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 11 April 2025 ! ! Author: ! ! John Burkardt ! ! Input: ! ! real x, t: the position and time. ! ! Output: ! ! real u, ut, utt, ux, uxx: the values of the exact solution, its time ! derivative, and its first and second spatial derivatives at (x,t). ! implicit none interface subroutine traveling_wave_parameters ( a_in, k_in, w_in, phi_in, xmin_in, & xmax_in, t0_in, tstop_in, a_out, k_out, w_out, phi_out, xmin_out, xmax_out, & t0_out, tstop_out ) integer, parameter :: rk8 = kind ( 1.0D+00 ) real ( kind = rk8 ), optional :: a_in real ( kind = rk8 ), optional :: a_out real ( kind = rk8 ), optional :: k_in real ( kind = rk8 ), optional :: k_out real ( kind = rk8 ), optional :: phi_in real ( kind = rk8 ), optional :: phi_out real ( kind = rk8 ), optional :: t0_in real ( kind = rk8 ), optional :: t0_out real ( kind = rk8 ), optional :: tstop_in real ( kind = rk8 ), optional :: tstop_out real ( kind = rk8 ), optional :: w_in real ( kind = rk8 ), optional :: w_out real ( kind = rk8 ), optional :: xmax_in real ( kind = rk8 ), optional :: xmax_out real ( kind = rk8 ), optional :: xmin_in real ( kind = rk8 ), optional :: xmin_out end subroutine end interface integer, parameter :: rk8 = kind ( 1.0D+00 ) real ( kind = rk8 ) a real ( kind = rk8 ) k real ( kind = rk8 ) phi real ( kind = rk8 ) t real ( kind = rk8 ) t0 real ( kind = rk8 ) tstop real ( kind = rk8 ) u real ( kind = rk8 ) ut real ( kind = rk8 ) utt real ( kind = rk8 ) ux real ( kind = rk8 ) uxx real ( kind = rk8 ) w real ( kind = rk8 ) x real ( kind = rk8 ) xmax real ( kind = rk8 ) xmin call traveling_wave_parameters ( a_out = a, k_out = k, w_out = w, & phi_out = phi, xmin_out = xmin, xmax_out = xmax, t0_out = t0, & tstop_out = tstop) u = a * sin ( k * x + w * t + phi ) ut = a * w * cos ( k * x + w * t + phi ) utt = - a * w**2 * sin ( k * x + w * t + phi ) ux = a * k * cos ( k * x + w * t + phi ) uxx = - a * k**2 * sin ( k * x + w * t + phi ) return end subroutine traveling_wave_parameters ( a_in, k_in, w_in, phi_in, xmin_in, & xmax_in, t0_in, tstop_in, a_out, k_out, w_out, phi_out, xmin_out, xmax_out, & t0_out, tstop_out ) !*****************************************************************************80 ! !! traveling_wave_parameters() returns parameters for the traveling wave equation. ! ! Discussion: ! ! d^2u/dt^2 = c^2 d^2u/dx^2 ! ! If input values are specified, this resets the default parameters. ! Otherwise, the output will be the current defaults. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 09 April 2025 ! ! Author: ! ! John Burkardt ! ! Input: ! ! real a_in: the amplitude. ! ! real k_in: the wave number. ! ! real w_in: angular frequency. ! ! real phi_in: the phase angle. ! ! real xmin_in, xmax_in: the left and right interval endpoints. ! ! real t0_in: the initial time. ! ! real tstop_in: the final time. ! ! Output: ! ! real a_out: the amplitude. ! ! real k_out: the wave number. ! ! real w_out: angular frequency. ! ! real phi_out: the phase angle. ! ! real xmin_out, xmax_out: the left and right interval endpoints. ! ! real t0_out: the initial time. ! ! real tstop_out: the final time. ! implicit none integer, parameter :: rk8 = kind ( 1.0D+00 ) real ( kind = rk8 ), parameter :: r8_pi = 3.141592653589793D+00 real ( kind = rk8 ), save :: a_default = 2.0D+00 real ( kind = rk8 ), optional :: a_in real ( kind = rk8 ), optional :: a_out real ( kind = rk8 ), save :: k_default = 6.0D+00 real ( kind = rk8 ), optional :: k_in real ( kind = rk8 ), optional :: k_out real ( kind = rk8 ), save :: phi_default = r8_pi / 4.0D+00 real ( kind = rk8 ), optional :: phi_in real ( kind = rk8 ), optional :: phi_out real ( kind = rk8 ), save :: t0_default = 0.0D+00 real ( kind = rk8 ), optional :: t0_in real ( kind = rk8 ), optional :: t0_out real ( kind = rk8 ), save :: tstop_default = 5.0D+00 real ( kind = rk8 ), optional :: tstop_in real ( kind = rk8 ), optional :: tstop_out real ( kind = rk8 ), save :: w_default = 1.0D+00 real ( kind = rk8 ), optional :: w_in real ( kind = rk8 ), optional :: w_out real ( kind = rk8 ), save :: xmax_default = 1.0D+00 real ( kind = rk8 ), optional :: xmax_in real ( kind = rk8 ), optional :: xmax_out real ( kind = rk8 ), save :: xmin_default = -1.0D+00 real ( kind = rk8 ), optional :: xmin_in real ( kind = rk8 ), optional :: xmin_out ! ! Update defaults if input was supplied. ! if ( present ( a_in ) ) then a_default = a_in end if if ( present ( k_in ) ) then k_default = k_in end if if ( present ( w_in ) ) then w_default = w_in end if if ( present ( phi_in ) ) then phi_default = phi_in end if if ( present ( xmin_in ) ) then xmin_default = xmin_in end if if ( present ( xmax_in ) ) then xmax_default = xmax_in end if if ( present ( t0_in ) ) then t0_default = t0_in end if if ( present ( tstop_in ) ) then tstop_default = tstop_in end if ! ! Return values. ! a_out = a_default k_out = k_default w_out = w_default phi_out = phi_default xmin_out = xmin_default xmax_out = xmax_default t0_out = t0_default tstop_out = tstop_default return end subroutine traveling_wave_residual ( t, x, r ) !*****************************************************************************80 ! !! traveling_wave_residual() computes the residual of the traveling wave equation. ! ! Discussion: ! ! d^2u/dt^2 = c^2 d^2u/dx^2 ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 11 April 2025 ! ! Author: ! ! John Burkardt ! ! Input: ! ! real T, X: the time and position where the solution is evaluated. ! ! Output: ! ! real R: the residual at that time and position. ! implicit none interface subroutine traveling_wave_parameters ( a_in, k_in, w_in, phi_in, xmin_in, & xmax_in, t0_in, tstop_in, a_out, k_out, w_out, phi_out, xmin_out, xmax_out, & t0_out, tstop_out ) integer, parameter :: rk8 = kind ( 1.0D+00 ) real ( kind = rk8 ), optional :: a_in real ( kind = rk8 ), optional :: a_out real ( kind = rk8 ), optional :: k_in real ( kind = rk8 ), optional :: k_out real ( kind = rk8 ), optional :: phi_in real ( kind = rk8 ), optional :: phi_out real ( kind = rk8 ), optional :: t0_in real ( kind = rk8 ), optional :: t0_out real ( kind = rk8 ), optional :: tstop_in real ( kind = rk8 ), optional :: tstop_out real ( kind = rk8 ), optional :: w_in real ( kind = rk8 ), optional :: w_out real ( kind = rk8 ), optional :: xmax_in real ( kind = rk8 ), optional :: xmax_out real ( kind = rk8 ), optional :: xmin_in real ( kind = rk8 ), optional :: xmin_out end subroutine end interface integer, parameter :: rk8 = kind ( 1.0D+00 ) real ( kind = rk8 ) a real ( kind = rk8 ) c real ( kind = rk8 ) k real ( kind = rk8 ) phi real ( kind = rk8 ) r real ( kind = rk8 ) t real ( kind = rk8 ) t0 real ( kind = rk8 ) tstop real ( kind = rk8 ) u real ( kind = rk8 ) ut real ( kind = rk8 ) utt real ( kind = rk8 ) ux real ( kind = rk8 ) uxx real ( kind = rk8 ) w real ( kind = rk8 ) x real ( kind = rk8 ) xmax real ( kind = rk8 ) xmin call traveling_wave_parameters ( a_out = a, k_out = k, w_out = w, & phi_out = phi, xmin_out = xmin, xmax_out = xmax, t0_out = t0, & tstop_out = tstop ) call traveling_wave_exact ( t, x, u, ut, utt, ux, uxx ) c = w / k r = utt - c**2 * uxx return end