doppler_effect Program

program doppler_effect
    use forsynth, only: wp, dt, RATE, PI
    use wav_file_class, only: WAV_file

    implicit none
    type(WAV_file) :: demo
    real(wp) :: panL, panR
    ! Pulsation (radians/second):
    real(wp) :: omega
    real(wp) :: t, tobs
    real(wp) :: Amp
    integer  :: i, j
    real(wp) :: x0, x, y
    real(wp), parameter :: duration = 7._wp   ! Duration in seconds
    real(wp), parameter :: y0 = 10            ! m
    real(wp), parameter :: v = 130000._wp / 3600  ! 130 km/h (car velocity)
    ! https://en.wikipedia.org/wiki/Speed_of_sound
    real(wp), parameter :: c = 343   ! m/s at 20°C in air
    real(wp), parameter :: f = 50    ! Hz

    print *, "**** Creating doppler_effect.wav ****"
    ! We create a new WAV file, and define the number of tracks and its duration:
    call demo%create_WAV_file('doppler_effect.wav', tracks=1, duration=duration)

    associate(tape => demo%tape_recorder)

!> The Observer is static at the origin,
!> the car is Moving along x at a constant velocity v
!>                        ^ y
!>                        |
!>      ****M*************y0**************>
!>                        |
!> ----x0-----------------O-------------------> x
!>                        |

    omega = 2*PI*f
    x0 = -v * duration/2
    ! y is constant:
    y  = y0

    print '(3A8, A10, 2A8)', "tobs", "t", "x", "Amp", "panL", "panR"

    tobs = 0
    do i = 0, nint(duration*RATE) - 1
        !> The frequency perceived by the observer (Doppler effect)
        !> is fobs = f / (1 - vr/c) but we don't need to compute it.
        !> The signal heard by the observer at tobs was emitted earlier by the
        !> car at t, from a distance r(t):
        !> tobs = t + r(t) / c
        !> By developing r(t) we can finally obtain a quadratic equation:
        !> (c**2-v**2) * t**2 - (2*tobs*c**2 + 2*x0*v) *t + (tobs**2 * c**2 - x0**2 - y**2) = 0
        !> The time t is the unique physical solution of that equation:
        t = the_solution(a=c**2-v**2, b=-(2*tobs*c**2 + 2*x0*v), c=(tobs**2 * c**2 - x0**2 - y**2), tobs=tobs)
        ! The position of the car at t was:
        x = x0 + v * t
        !> The amplitude of the observed signal is decreasing in r**2:
        Amp = 1 / (x**2 + y**2)

        ! We simulate a stereo effect by using this arbitrary law:
        ! (note that x0<0 and at tobs=0 x<x0)
        panR = abs((max(x, x0) - x0) / (2*x0))
        panL = 1 - panR

        tape%left( 1, i) = panL * Amp * sin(omega*t)
        tape%right(1, i) = panR * Amp * sin(omega*t)
        ! A signal with only even harmonics, to sound like a motor:
        do j = 2, 40, +2
            tape%left( 1, i) = tape%left( 1, i) + panL * Amp/j**1.3_wp * sin(j*omega*t)
            tape%right(1, i) = tape%right(1, i) + panR * Amp/j**1.3_wp * sin(j*omega*t)
        end do

        if (mod(i, RATE/4) == 0) print '(3F8.2, ES10.2, 2F8.3)', tobs, t, x, Amp, panL, panR

        tobs = tobs + dt
    end do

    end associate

    ! All tracks will be mixed on track 0.
    ! Needed even if there is only one track!
    call demo%mix_tracks()
    call demo%close_WAV_file()

    print *,"You can now play the file ", demo%get_name()

contains

    !> We solve the Quadratic equation,
    !> but physically one and only one solution can exist:
    !> we know the sound was emitted before we hear it!>
    real(wp) function the_solution(a, b, c, tobs)
        real(wp), intent(in) :: a, b, c, tobs
        real(wp) :: delta, t1, t2

        delta = b**2 - 4*a*c

        if (delta >= 0) then
            t1 = (-b + sqrt(delta)) / (2*a)
            t2 = (-b - sqrt(delta)) / (2*a)

            if (t1 <= tobs) then
                if (t2 <= tobs) then
                    error stop "ERROR: two solutions, physically impossible"
                else
                    the_solution = t1
                end if
            else if (t2 <= tobs) then
                the_solution = t2
            else
                error stop "ERROR: no solution (1)"
            end if
        else
            error stop "ERROR: no solution, delta<0 (2)"
        end if
    end function

end program doppler_effect