add_weierstrass Subroutine

public subroutine add_weierstrass(tape, track, t1, t2, f, Amp, envelope)

Add a fractal signal on the track with an envelope:

Arguments

Type IntentOptional Attributes Name
type(tape_recorder), intent(inout) :: tape
integer, intent(in) :: track
real(kind=wp), intent(in) :: t1
real(kind=wp), intent(in) :: t2
real(kind=wp), intent(in) :: f
real(kind=wp), intent(in) :: Amp
type(ADSR_envelope), intent(in), optional :: envelope

Calls

proc~~add_weierstrass~~CallsGraph proc~add_weierstrass add_weierstrass proc~adsr_level ADSR_envelope%ADSR_level proc~add_weierstrass->proc~adsr_level proc~weierstrass weierstrass proc~add_weierstrass->proc~weierstrass

Called by

proc~~add_weierstrass~~CalledByGraph proc~add_weierstrass add_weierstrass program~all_signals all_signals program~all_signals->proc~add_weierstrass

Source Code

    subroutine add_weierstrass(tape, track, t1, t2, f, Amp, envelope)
        type(tape_recorder), intent(inout) :: tape
        integer, intent(in)  :: track
        real(wp), intent(in) :: t1, t2, f, Amp
        type(ADSR_envelope), optional, intent(in) :: envelope
        ! Pulsation (radians/second):
        real(wp) :: omega
        ! Time in seconds:
        real(wp) :: t
        ! ADSR Envelope value:
        real(wp) :: env
        real(wp) :: signal
        ! 0 < a < 1.
        real(wp), parameter :: a = 0.975_wp
        ! If a.b > 1 the function is fractal:
        real(wp), parameter :: b = 1._wp/.975_wp + 0.005_wp
        integer  :: i

        env = 1._wp     ! Default value if no envelope is passed
        omega = 2.0_wp * PI * f

        do concurrent(i = nint(t1*RATE) : min(nint(t2*RATE), tape%last))
            t = (i - nint(t1*RATE)) * dt

            if (present(envelope)) env = envelope%get_level(t1+t, t1, t2)
            signal = Amp * weierstrass(a, b, omega*t) * env
            ! It is addd to the already present signal:
            tape%left(track, i)  = tape%left(track, i)  + signal
            tape%right(track, i) = tape%right(track, i) + signal
        end do
    end subroutine add_weierstrass