#!../src/tops  -s ../sys  -u ../usr
#!/usr/local/bin/tops

# File dynamics

# Testing words for dynamics analysis and signal processing
# Assumes FFT functions are in the program

{
Example results from this file:

[dale@clacker] /opt/tops/tops/test > dynamics
 steady freqency response balance max error (%): 0.0000E+00
 using FFTW functions
 window wfft and FFT max error (%): 0.0000E+00
 window wPSD and PSD from FFT, max error (%): 0.0000E+00
 continuous vs. discrete FFT (expect some error):
    PSD Frms max error (%): 1.0895E-01

Note: the .11% error between continuous and discrete ffts is acceptable.
}
\-----------------------------------------------------------------------

xbase push
0based \ Using 0-based indexing to uproot 1-based assumptions to fix

no catmsg

\-----------------------------------------------------------------------

\  Word steady.  

      "crate" missing IF mmath.v source THEN

\     Single degree-of-freedom oscillator.  Equation of motion:

\        qdd + 2*zeta*omega*qd + omega^2*q = Q*sin(Omega*t)

      0.05 "zeta" book \ critical damping ratio (5%)
      1.0 "omega" book \ natural frequency, rad/sec

      list: 0.01 0.1 1 10 100 ; "Omega" book \ driving freqs, rad/sec
      1.0 1 Omega rows fill "Q" book \ unity input at each Omega

\     Steady state frequency response solution:
      zeta omega Q Omega steady complex "q" book

\     Each column of q corresponds to a driving frequency Omega.

\     Velocity and acceleration:
      q real-imag Omega crate  complex "qd" book
      q real-imag Omega caccel complex "qdd" book

\     Equation LHS: qdd + 2*zeta*omega*qd + omega^2*q
      qdd
      qd 2 zeta * *f plus
      q omega 2 ^ *f plus real-imag cmag (hLHS)

\     Equation RHS: Q*sin(Omega*t)
      Q (hRHS)

      " steady freqency response balance max error (%):" .
      (hLHS hRHS) 100 (%) 0 compareRef (hC) 
      abs maxfetch 2drop . nl

\-----------------------------------------------------------------------

"fft" exists?
IF
   "signal.v" source 
   "FFT" "MSG" yank . nl

{  Words wfft and FFT compared.
 
      Word wfft (windowed fft) and word FFT (ordinary fft) should 
      agree if one window and no Hanning tapering are used in wfft, 
      and detrended data goes into FFT:
}
      "load_demo" missing IF "mat.v" source THEN

    \ Select some time histories for A:
      load_demo (hC) list: 7 6 3 4 1 ; ndx catch into A

      1 into S \ sample rate
      one S slash, A rows uniform makes t \ vector of uniform times

    \ FFT from wfft:
      "wfft" "HAN" yank push \ save Hanning flag

      no "wfft" "HAN" bank \ no Hanning
      A t 0 A rows wfft cmag (hWFFT)

      pull "wfft" "HAN" bank \ put back Hanning flag

    \ FFT:
      A its trend detrend (hA) \ detrend A for FFT
      (hA) S A rows FFT cmag (hFFT)

      (hWFFT hFFT) 100 (%) 0 compareRef (hC) 

      " window wfft and FFT max error (%):" . 
      (hC) abs maxfetch 2drop . nl

\-----------------------------------------------------------------------

{  wPSD and PSD from FFT compared.
 
      Word wPSD (windowed PSD), and a PSD made using an FFT from word 
      FFT (ordinary fft) should agree if just one window and no Hanning
      tapering is used in wPSD, and detrended data goes into FFT.
}
      "load_demo" missing IF "mat.v" source THEN

    \ Select some time histories for A:
      load_demo (hC) list: 7 6 3 4 1 ; ndx catch into A

      1 into S \ sample rate

      one S slash, A rows uniform makes t \ vector of uniform times
      t rows, t 2nd pry star makes T \ period of samples for PSD

    \ PSD using wPSD:
      "wfft" "HAN" yank push 

      no "wfft" "HAN" bank \ no wfft Hanning
      A S t rows wPSD into F into Wpsd 

      pull "wfft" "HAN" bank
    
    \ PSD using FFT: 
      A its trend detrend (hA) \ detrend A
      (hA) S t rows FFT (hFr hFi) 
      (hFr Fi) *conj 2 T slash *f (hPSD) \ making a psd from an fft
      (hPSD) into Cpsd 

    \ Compare the PSDs and take the max:
      Cpsd Wpsd 100 (%) 0 compareRef (hC) 
      " window wPSD and PSD from FFT, max error (%):" . 
      (hC) abs maxfetch 2drop . nl

\-----------------------------------------------------------------------

\  Words lamp and FFT compared.

      "load_demo" missing IF "mat.v" source THEN

    \ Select some time histories for A:
      load_demo (hC) list: 7 6 3 4 1 ; ndx catch into A

      1 into S \ sample rate
      one S slash, A rows uniform makes t \ vector of uniform times
      t rows, t 2nd pry star makes T \ period of samples for PSD

    \ A detrended and Hanning-tapered:
      A its trend detrend (hA)
      (hA) t hanning those cols clone *by into A

    \ PSD of A using FFT:
      A S t rows FFT (hFr hFi) 
      (hFr Fi) *conj 2 T slash *f (hPSD) \ making a psd from an fft
      (hPSD) into Cpsd 
      S Cpsd rows Sfreqs into F

    \ For lamp, which is slower than FFT, reduce the problem to the
    \ N lowest frequencies; and don't do 0 Hz frequency (1st) to 
    \ avoid NANQ in the comparison:
      F rows 4 slash into N
      Cpsd 2nd N items reach into Cpsd
      F 2nd N items reach into F

    \ PSD of A using lamp:
      A t F lamp (hFr hFi)
      (hFr Fi) *conj 2 T slash *f (hPSD) \ making a psd from an fft
      (hPSD) into Lpsd 

    \ Compare the RMS of the PSDs and take the max:
      Cpsd F Frms Lpsd F Frms 100 (%) 0 compareRef (hC) 
      " continuous vs. discrete FFT (expect some error):" . nl
      "    PSD Frms max error (%):" . 
      (hC) abs maxfetch 2drop . nl

ELSE " No FFT words; skipping FFT tests" . nl
THEN \ end of FFT words

\-----------------------------------------------------------------------

   pull indexbase
   end
