add_karplus_strong_drum_stretched Subroutine

public subroutine add_karplus_strong_drum_stretched(tape, track, t1, t2, P, Amp)

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
integer, intent(in) :: P
real(kind=wp), intent(in) :: Amp

Called by

proc~~add_karplus_strong_drum_stretched~~CalledByGraph proc~add_karplus_strong_drum_stretched add_karplus_strong_drum_stretched program~drum_machine drum_machine program~drum_machine->proc~add_karplus_strong_drum_stretched

Source Code

    subroutine add_karplus_strong_drum_stretched(tape, track, t1, t2, P, Amp)
        type(tape_recorder), intent(inout) :: tape
        integer,  intent(in) :: track, P
        real(wp), intent(in) :: t1, t2, Amp
        integer  :: i1, i2

        real(wp) :: r
        integer  :: i
        ! 0 <= b <= 1 but b = 0.5 is the best value for good drums:
        real(wp), parameter :: b = 0.5_wp
        ! Stretch factor S > 1:
        real(wp), parameter :: S = 4._wp

        i1 = nint(t1*RATE)
        i2 = nint(t2*RATE) - 1

        ! Track 0 is used as an auxiliary track.

        ! Attack:
        tape%left( 0, i1:i1+P) = Amp
        tape%right(0, i1:i1+P) = Amp

        ! Evolution and decay:
        do i = i1 + P + 1, i2
            ! The sign of the sample is random:
            call random_number(r)
            if (r < b) then
                call random_number(r)
                if (r < 1/S) then
                    tape%left(0, i) = +0.5_wp * (tape%left(0, i-P) + tape%left(0, i-P-1))
                else
                    tape%left(0, i) = +tape%left(0, i-P)
                end if
            else
                call random_number(r)
                if (r < 1/S) then
                    tape%left(0, i) = -0.5_wp * (tape%left(0, i-P) + tape%left(0, i-P-1))
                else
                    tape%left(0, i) = -tape%left(0, i-P)
                end if
            end if

            tape%right(0, i) = tape%left(0, i)
        end do

        ! Transfer (add) on the good track:
        tape%left( track, i1:i2) = tape%left( track, i1:i2) + tape%left( 0, i1:i2)
        tape%right(track, i1:i2) = tape%right(track, i1:i2) + tape%right(0, i1:i2)
    end subroutine add_karplus_strong_drum_stretched