Karplus and Strong stretched algorithm (1983), for plucked-string.
Type | Intent | Optional | 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 |
subroutine add_karplus_strong_stretched(tape, track, t1, t2, f, Amp) type(tape_recorder), intent(inout) :: tape integer, intent(in) :: track real(wp), intent(in) :: t1, t2, f, Amp integer :: i1, i2 real(wp) :: r integer :: i integer :: P ! Stretch factor S > 1: real(wp), parameter :: S = 4._wp i1 = nint(t1*RATE) i2 = min(nint(t2*RATE), tape%last) P = nint(RATE / f) - 2 ! Initial noise: do i = i1, i1 + P ! 0 <= r < 1 call random_number(r) ! Track 0 is used as an auxiliary track: tape%left( 0, i) = Amp * (2.0_wp*r - 1.0_wp) tape%right(0, i) = tape%left(0, i) end do ! Delay and decay: do i = i1 + P + 1, i2 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 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_stretched